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 write (iout,*) "shield_mode",shield_mode
145 if (shield_mode.gt.0) then
148 c print *,"Processor",myrank," left VEC_AND_DERIV"
151 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
152 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
153 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
154 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
156 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
157 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
158 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
159 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
161 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
170 write (iout,*) "Soft-spheer ELEC potential"
171 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
174 c print *,"Processor",myrank," computed UELEC"
176 C Calculate excluded-volume interaction energy between peptide groups
181 call escp(evdw2,evdw2_14)
187 c write (iout,*) "Soft-sphere SCP potential"
188 call escp_soft_sphere(evdw2,evdw2_14)
191 c Calculate the bond-stretching energy
195 C Calculate the disulfide-bridge and other energy and the contributions
196 C from other distance constraints.
197 cd print *,'Calling EHPB'
199 cd print *,'EHPB exitted succesfully.'
201 C Calculate the virtual-bond-angle energy.
203 if (wang.gt.0d0) then
204 call ebend(ebe,ethetacnstr)
209 c print *,"Processor",myrank," computed UB"
211 C Calculate the SC local energy.
213 C print *,"TU DOCHODZE?"
215 c print *,"Processor",myrank," computed USC"
217 C Calculate the virtual-bond torsional energy.
219 cd print *,'nterm=',nterm
221 call etor(etors,edihcnstr)
226 c print *,"Processor",myrank," computed Utor"
228 C 6/23/01 Calculate double-torsional energy
230 if (wtor_d.gt.0) then
235 c print *,"Processor",myrank," computed Utord"
237 C 21/5/07 Calculate local sicdechain correlation energy
239 if (wsccor.gt.0.0d0) then
240 call eback_sc_corr(esccor)
244 C print *,"PRZED MULIt"
245 c print *,"Processor",myrank," computed Usccorr"
247 C 12/1/95 Multi-body terms
251 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
252 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
253 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
254 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
255 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
262 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
263 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
264 cd write (iout,*) "multibody_hb ecorr",ecorr
266 c print *,"Processor",myrank," computed Ucorr"
268 C If performing constraint dynamics, call the constraint energy
269 C after the equilibration time
270 if(usampl.and.totT.gt.eq_time) then
277 C 01/27/2015 added by adasko
278 C the energy component below is energy transfer into lipid environment
279 C based on partition function
280 C print *,"przed lipidami"
281 if (wliptran.gt.0) then
282 call Eliptransfer(eliptran)
284 C print *,"za lipidami"
285 if (AFMlog.gt.0) then
286 call AFMforce(Eafmforce)
287 else if (selfguide.gt.0) then
288 call AFMvel(Eafmforce)
291 time_enecalc=time_enecalc+MPI_Wtime()-time00
293 c print *,"Processor",myrank," computed Uconstr"
302 energia(2)=evdw2-evdw2_14
319 energia(8)=eello_turn3
320 energia(9)=eello_turn4
327 energia(19)=edihcnstr
329 energia(20)=Uconst+Uconst_back
332 energia(23)=Eafmforce
333 energia(24)=ethetacnstr
334 c Here are the energies showed per procesor if the are more processors
335 c per molecule then we sum it up in sum_energy subroutine
336 c print *," Processor",myrank," calls SUM_ENERGY"
337 call sum_energy(energia,.true.)
338 if (dyn_ss) call dyn_set_nss
339 c print *," Processor",myrank," left SUM_ENERGY"
341 time_sumene=time_sumene+MPI_Wtime()-time00
345 c-------------------------------------------------------------------------------
346 subroutine sum_energy(energia,reduce)
347 implicit real*8 (a-h,o-z)
352 cMS$ATTRIBUTES C :: proc_proc
358 include 'COMMON.SETUP'
359 include 'COMMON.IOUNITS'
360 double precision energia(0:n_ene),enebuff(0:n_ene+1)
361 include 'COMMON.FFIELD'
362 include 'COMMON.DERIV'
363 include 'COMMON.INTERACT'
364 include 'COMMON.SBRIDGE'
365 include 'COMMON.CHAIN'
367 include 'COMMON.CONTROL'
368 include 'COMMON.TIME1'
371 if (nfgtasks.gt.1 .and. reduce) then
373 write (iout,*) "energies before REDUCE"
374 call enerprint(energia)
378 enebuff(i)=energia(i)
381 call MPI_Barrier(FG_COMM,IERR)
382 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
384 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
385 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
387 write (iout,*) "energies after REDUCE"
388 call enerprint(energia)
391 time_Reduce=time_Reduce+MPI_Wtime()-time00
393 if (fg_rank.eq.0) then
397 evdw2=energia(2)+energia(18)
413 eello_turn3=energia(8)
414 eello_turn4=energia(9)
421 edihcnstr=energia(19)
426 Eafmforce=energia(23)
427 ethetacnstr=energia(24)
429 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
430 & +wang*ebe+wtor*etors+wscloc*escloc
431 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
432 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
433 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
434 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+Eafmforce
437 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
438 & +wang*ebe+wtor*etors+wscloc*escloc
439 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
440 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
441 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
442 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
450 if (isnan(etot).ne.0) energia(0)=1.0d+99
452 if (isnan(etot)) energia(0)=1.0d+99
457 idumm=proc_proc(etot,i)
459 call proc_proc(etot,i)
461 if(i.eq.1)energia(0)=1.0d+99
468 c-------------------------------------------------------------------------------
469 subroutine sum_gradient
470 implicit real*8 (a-h,o-z)
475 cMS$ATTRIBUTES C :: proc_proc
481 double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
482 & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
483 & ,gloc_scbuf(3,-1:maxres)
484 include 'COMMON.SETUP'
485 include 'COMMON.IOUNITS'
486 include 'COMMON.FFIELD'
487 include 'COMMON.DERIV'
488 include 'COMMON.INTERACT'
489 include 'COMMON.SBRIDGE'
490 include 'COMMON.CHAIN'
492 include 'COMMON.CONTROL'
493 include 'COMMON.TIME1'
494 include 'COMMON.MAXGRAD'
495 include 'COMMON.SCCOR'
500 write (iout,*) "sum_gradient gvdwc, gvdwx"
502 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
503 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
508 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
509 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
510 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
513 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
514 C in virtual-bond-vector coordinates
517 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
519 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
520 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
522 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
524 c write (iout,'(i5,3f10.5,2x,f10.5)')
525 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
527 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
529 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
530 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
538 gradbufc(j,i)=wsc*gvdwc(j,i)+
539 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
540 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
541 & wel_loc*gel_loc_long(j,i)+
542 & wcorr*gradcorr_long(j,i)+
543 & wcorr5*gradcorr5_long(j,i)+
544 & wcorr6*gradcorr6_long(j,i)+
545 & wturn6*gcorr6_turn_long(j,i)+
547 & +wliptran*gliptranc(j,i)
555 gradbufc(j,i)=wsc*gvdwc(j,i)+
556 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
557 & welec*gelc_long(j,i)+
559 & wel_loc*gel_loc_long(j,i)+
560 & wcorr*gradcorr_long(j,i)+
561 & wcorr5*gradcorr5_long(j,i)+
562 & wcorr6*gradcorr6_long(j,i)+
563 & wturn6*gcorr6_turn_long(j,i)+
565 & +wliptran*gliptranc(j,i)
572 if (nfgtasks.gt.1) then
575 write (iout,*) "gradbufc before allreduce"
577 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
583 gradbufc_sum(j,i)=gradbufc(j,i)
586 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
587 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
588 c time_reduce=time_reduce+MPI_Wtime()-time00
590 c write (iout,*) "gradbufc_sum after allreduce"
592 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
597 c time_allreduce=time_allreduce+MPI_Wtime()-time00
605 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
606 write (iout,*) (i," jgrad_start",jgrad_start(i),
607 & " jgrad_end ",jgrad_end(i),
608 & i=igrad_start,igrad_end)
611 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
612 c do not parallelize this part.
614 c do i=igrad_start,igrad_end
615 c do j=jgrad_start(i),jgrad_end(i)
617 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
622 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
626 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
630 write (iout,*) "gradbufc after summing"
632 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
639 write (iout,*) "gradbufc"
641 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
647 gradbufc_sum(j,i)=gradbufc(j,i)
652 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
656 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
661 c gradbufc(k,i)=0.0d0
665 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
670 write (iout,*) "gradbufc after summing"
672 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
680 gradbufc(k,nres)=0.0d0
685 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
686 & wel_loc*gel_loc(j,i)+
687 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
688 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
689 & wel_loc*gel_loc_long(j,i)+
690 & wcorr*gradcorr_long(j,i)+
691 & wcorr5*gradcorr5_long(j,i)+
692 & wcorr6*gradcorr6_long(j,i)+
693 & wturn6*gcorr6_turn_long(j,i))+
695 & wcorr*gradcorr(j,i)+
696 & wturn3*gcorr3_turn(j,i)+
697 & wturn4*gcorr4_turn(j,i)+
698 & wcorr5*gradcorr5(j,i)+
699 & wcorr6*gradcorr6(j,i)+
700 & wturn6*gcorr6_turn(j,i)+
701 & wsccor*gsccorc(j,i)
702 & +wscloc*gscloc(j,i)
703 & +wliptran*gliptranc(j,i)
706 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
707 & wel_loc*gel_loc(j,i)+
708 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
709 & welec*gelc_long(j,i)
710 & wel_loc*gel_loc_long(j,i)+
711 & wcorr*gcorr_long(j,i)+
712 & wcorr5*gradcorr5_long(j,i)+
713 & wcorr6*gradcorr6_long(j,i)+
714 & wturn6*gcorr6_turn_long(j,i))+
716 & wcorr*gradcorr(j,i)+
717 & wturn3*gcorr3_turn(j,i)+
718 & wturn4*gcorr4_turn(j,i)+
719 & wcorr5*gradcorr5(j,i)+
720 & wcorr6*gradcorr6(j,i)+
721 & wturn6*gcorr6_turn(j,i)+
722 & wsccor*gsccorc(j,i)
723 & +wscloc*gscloc(j,i)
724 & +wliptran*gliptranc(j,i)
728 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
730 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
731 & wsccor*gsccorx(j,i)
732 & +wscloc*gsclocx(j,i)
733 & +wliptran*gliptranx(j,i)
737 write (iout,*) "gloc before adding corr"
739 write (iout,*) i,gloc(i,icg)
743 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
744 & +wcorr5*g_corr5_loc(i)
745 & +wcorr6*g_corr6_loc(i)
746 & +wturn4*gel_loc_turn4(i)
747 & +wturn3*gel_loc_turn3(i)
748 & +wturn6*gel_loc_turn6(i)
749 & +wel_loc*gel_loc_loc(i)
752 write (iout,*) "gloc after adding corr"
754 write (iout,*) i,gloc(i,icg)
758 if (nfgtasks.gt.1) then
761 gradbufc(j,i)=gradc(j,i,icg)
762 gradbufx(j,i)=gradx(j,i,icg)
766 glocbuf(i)=gloc(i,icg)
770 write (iout,*) "gloc_sc before reduce"
773 write (iout,*) i,j,gloc_sc(j,i,icg)
780 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
784 call MPI_Barrier(FG_COMM,IERR)
785 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
787 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
788 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
789 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
790 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
791 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
792 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
793 time_reduce=time_reduce+MPI_Wtime()-time00
794 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
795 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
796 time_reduce=time_reduce+MPI_Wtime()-time00
799 write (iout,*) "gloc_sc after reduce"
802 write (iout,*) i,j,gloc_sc(j,i,icg)
808 write (iout,*) "gloc after reduce"
810 write (iout,*) i,gloc(i,icg)
815 if (gnorm_check) then
817 c Compute the maximum elements of the gradient
827 gcorr3_turn_max=0.0d0
828 gcorr4_turn_max=0.0d0
831 gcorr6_turn_max=0.0d0
841 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
842 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
843 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
844 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
845 & gvdwc_scp_max=gvdwc_scp_norm
846 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
847 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
848 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
849 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
850 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
851 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
852 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
853 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
854 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
855 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
856 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
857 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
858 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
860 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
861 & gcorr3_turn_max=gcorr3_turn_norm
862 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
864 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
865 & gcorr4_turn_max=gcorr4_turn_norm
866 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
867 if (gradcorr5_norm.gt.gradcorr5_max)
868 & gradcorr5_max=gradcorr5_norm
869 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
870 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
871 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
873 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
874 & gcorr6_turn_max=gcorr6_turn_norm
875 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
876 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
877 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
878 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
879 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
880 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
881 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
882 if (gradx_scp_norm.gt.gradx_scp_max)
883 & gradx_scp_max=gradx_scp_norm
884 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
885 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
886 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
887 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
888 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
889 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
890 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
891 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
895 open(istat,file=statname,position="append")
897 open(istat,file=statname,access="append")
899 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
900 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
901 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
902 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
903 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
904 & gsccorx_max,gsclocx_max
906 if (gvdwc_max.gt.1.0d4) then
907 write (iout,*) "gvdwc gvdwx gradb gradbx"
909 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
910 & gradb(j,i),gradbx(j,i),j=1,3)
912 call pdbout(0.0d0,'cipiszcze',iout)
918 write (iout,*) "gradc gradx gloc"
920 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
921 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
925 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
929 c-------------------------------------------------------------------------------
930 subroutine rescale_weights(t_bath)
931 implicit real*8 (a-h,o-z)
933 include 'COMMON.IOUNITS'
934 include 'COMMON.FFIELD'
935 include 'COMMON.SBRIDGE'
936 double precision kfac /2.4d0/
937 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
939 c facT=2*temp0/(t_bath+temp0)
940 if (rescale_mode.eq.0) then
946 else if (rescale_mode.eq.1) then
947 facT=kfac/(kfac-1.0d0+t_bath/temp0)
948 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
949 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
950 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
951 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
952 else if (rescale_mode.eq.2) then
958 facT=licznik/dlog(dexp(x)+dexp(-x))
959 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
960 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
961 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
962 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
964 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
965 write (*,*) "Wrong RESCALE_MODE",rescale_mode
967 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
971 welec=weights(3)*fact
972 wcorr=weights(4)*fact3
973 wcorr5=weights(5)*fact4
974 wcorr6=weights(6)*fact5
975 wel_loc=weights(7)*fact2
976 wturn3=weights(8)*fact2
977 wturn4=weights(9)*fact3
978 wturn6=weights(10)*fact5
979 wtor=weights(13)*fact
980 wtor_d=weights(14)*fact2
981 wsccor=weights(21)*fact
985 C------------------------------------------------------------------------
986 subroutine enerprint(energia)
987 implicit real*8 (a-h,o-z)
989 include 'COMMON.IOUNITS'
990 include 'COMMON.FFIELD'
991 include 'COMMON.SBRIDGE'
993 double precision energia(0:n_ene)
998 evdw2=energia(2)+energia(18)
1010 eello_turn3=energia(8)
1011 eello_turn4=energia(9)
1012 eello_turn6=energia(10)
1018 edihcnstr=energia(19)
1022 eliptran=energia(22)
1023 Eafmforce=energia(23)
1024 ethetacnstr=energia(24)
1026 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1027 & estr,wbond,ebe,wang,
1028 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1030 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1031 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1032 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1034 10 format (/'Virtual-chain energies:'//
1035 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1036 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1037 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1038 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1039 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1040 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1041 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1042 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1043 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1044 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1045 & ' (SS bridges & dist. cnstr.)'/
1046 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1047 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1048 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1049 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1050 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1051 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1052 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1053 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1054 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1055 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1056 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1057 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1058 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1059 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1060 & 'ETOT= ',1pE16.6,' (total)')
1063 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1064 & estr,wbond,ebe,wang,
1065 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1067 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1068 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1069 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1071 10 format (/'Virtual-chain energies:'//
1072 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1073 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1074 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1075 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1076 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1077 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1078 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1079 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1080 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1081 & ' (SS bridges & dist. cnstr.)'/
1082 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1083 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1084 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1085 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1086 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1087 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1088 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1089 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1090 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1091 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1092 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1093 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1094 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1095 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1096 & 'ETOT= ',1pE16.6,' (total)')
1100 C-----------------------------------------------------------------------
1101 subroutine elj(evdw)
1103 C This subroutine calculates the interaction energy of nonbonded side chains
1104 C assuming the LJ potential of interaction.
1106 implicit real*8 (a-h,o-z)
1107 include 'DIMENSIONS'
1108 parameter (accur=1.0d-10)
1109 include 'COMMON.GEO'
1110 include 'COMMON.VAR'
1111 include 'COMMON.LOCAL'
1112 include 'COMMON.CHAIN'
1113 include 'COMMON.DERIV'
1114 include 'COMMON.INTERACT'
1115 include 'COMMON.TORSION'
1116 include 'COMMON.SBRIDGE'
1117 include 'COMMON.NAMES'
1118 include 'COMMON.IOUNITS'
1119 include 'COMMON.CONTACTS'
1121 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1123 do i=iatsc_s,iatsc_e
1124 itypi=iabs(itype(i))
1125 if (itypi.eq.ntyp1) cycle
1126 itypi1=iabs(itype(i+1))
1133 C Calculate SC interaction energy.
1135 do iint=1,nint_gr(i)
1136 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1137 cd & 'iend=',iend(i,iint)
1138 do j=istart(i,iint),iend(i,iint)
1139 itypj=iabs(itype(j))
1140 if (itypj.eq.ntyp1) cycle
1144 C Change 12/1/95 to calculate four-body interactions
1145 rij=xj*xj+yj*yj+zj*zj
1147 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1148 eps0ij=eps(itypi,itypj)
1150 C have you changed here?
1154 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1155 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1156 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1157 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1158 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1159 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1162 C Calculate the components of the gradient in DC and X
1164 fac=-rrij*(e1+evdwij)
1169 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1170 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1171 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1172 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1176 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1180 C 12/1/95, revised on 5/20/97
1182 C Calculate the contact function. The ith column of the array JCONT will
1183 C contain the numbers of atoms that make contacts with the atom I (of numbers
1184 C greater than I). The arrays FACONT and GACONT will contain the values of
1185 C the contact function and its derivative.
1187 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1188 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1189 C Uncomment next line, if the correlation interactions are contact function only
1190 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1192 sigij=sigma(itypi,itypj)
1193 r0ij=rs0(itypi,itypj)
1195 C Check whether the SC's are not too far to make a contact.
1198 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1199 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1201 if (fcont.gt.0.0D0) then
1202 C If the SC-SC distance if close to sigma, apply spline.
1203 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1204 cAdam & fcont1,fprimcont1)
1205 cAdam fcont1=1.0d0-fcont1
1206 cAdam if (fcont1.gt.0.0d0) then
1207 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1208 cAdam fcont=fcont*fcont1
1210 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1211 cga eps0ij=1.0d0/dsqrt(eps0ij)
1213 cga gg(k)=gg(k)*eps0ij
1215 cga eps0ij=-evdwij*eps0ij
1216 C Uncomment for AL's type of SC correlation interactions.
1217 cadam eps0ij=-evdwij
1218 num_conti=num_conti+1
1219 jcont(num_conti,i)=j
1220 facont(num_conti,i)=fcont*eps0ij
1221 fprimcont=eps0ij*fprimcont/rij
1223 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1224 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1225 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1226 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1227 gacont(1,num_conti,i)=-fprimcont*xj
1228 gacont(2,num_conti,i)=-fprimcont*yj
1229 gacont(3,num_conti,i)=-fprimcont*zj
1230 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1231 cd write (iout,'(2i3,3f10.5)')
1232 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1238 num_cont(i)=num_conti
1242 gvdwc(j,i)=expon*gvdwc(j,i)
1243 gvdwx(j,i)=expon*gvdwx(j,i)
1246 C******************************************************************************
1250 C To save time, the factor of EXPON has been extracted from ALL components
1251 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1254 C******************************************************************************
1257 C-----------------------------------------------------------------------------
1258 subroutine eljk(evdw)
1260 C This subroutine calculates the interaction energy of nonbonded side chains
1261 C assuming the LJK potential of interaction.
1263 implicit real*8 (a-h,o-z)
1264 include 'DIMENSIONS'
1265 include 'COMMON.GEO'
1266 include 'COMMON.VAR'
1267 include 'COMMON.LOCAL'
1268 include 'COMMON.CHAIN'
1269 include 'COMMON.DERIV'
1270 include 'COMMON.INTERACT'
1271 include 'COMMON.IOUNITS'
1272 include 'COMMON.NAMES'
1275 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1277 do i=iatsc_s,iatsc_e
1278 itypi=iabs(itype(i))
1279 if (itypi.eq.ntyp1) cycle
1280 itypi1=iabs(itype(i+1))
1285 C Calculate SC interaction energy.
1287 do iint=1,nint_gr(i)
1288 do j=istart(i,iint),iend(i,iint)
1289 itypj=iabs(itype(j))
1290 if (itypj.eq.ntyp1) cycle
1294 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1295 fac_augm=rrij**expon
1296 e_augm=augm(itypi,itypj)*fac_augm
1297 r_inv_ij=dsqrt(rrij)
1299 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1300 fac=r_shift_inv**expon
1301 C have you changed here?
1305 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1306 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1307 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1308 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1309 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1310 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1311 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1314 C Calculate the components of the gradient in DC and X
1316 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1321 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1322 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1323 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1324 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1328 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1336 gvdwc(j,i)=expon*gvdwc(j,i)
1337 gvdwx(j,i)=expon*gvdwx(j,i)
1342 C-----------------------------------------------------------------------------
1343 subroutine ebp(evdw)
1345 C This subroutine calculates the interaction energy of nonbonded side chains
1346 C assuming the Berne-Pechukas potential of interaction.
1348 implicit real*8 (a-h,o-z)
1349 include 'DIMENSIONS'
1350 include 'COMMON.GEO'
1351 include 'COMMON.VAR'
1352 include 'COMMON.LOCAL'
1353 include 'COMMON.CHAIN'
1354 include 'COMMON.DERIV'
1355 include 'COMMON.NAMES'
1356 include 'COMMON.INTERACT'
1357 include 'COMMON.IOUNITS'
1358 include 'COMMON.CALC'
1359 common /srutu/ icall
1360 c double precision rrsave(maxdim)
1363 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1365 c if (icall.eq.0) then
1371 do i=iatsc_s,iatsc_e
1372 itypi=iabs(itype(i))
1373 if (itypi.eq.ntyp1) cycle
1374 itypi1=iabs(itype(i+1))
1378 dxi=dc_norm(1,nres+i)
1379 dyi=dc_norm(2,nres+i)
1380 dzi=dc_norm(3,nres+i)
1381 c dsci_inv=dsc_inv(itypi)
1382 dsci_inv=vbld_inv(i+nres)
1384 C Calculate SC interaction energy.
1386 do iint=1,nint_gr(i)
1387 do j=istart(i,iint),iend(i,iint)
1389 itypj=iabs(itype(j))
1390 if (itypj.eq.ntyp1) cycle
1391 c dscj_inv=dsc_inv(itypj)
1392 dscj_inv=vbld_inv(j+nres)
1393 chi1=chi(itypi,itypj)
1394 chi2=chi(itypj,itypi)
1401 alf12=0.5D0*(alf1+alf2)
1402 C For diagnostics only!!!
1415 dxj=dc_norm(1,nres+j)
1416 dyj=dc_norm(2,nres+j)
1417 dzj=dc_norm(3,nres+j)
1418 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1419 cd if (icall.eq.0) then
1425 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1427 C Calculate whole angle-dependent part of epsilon and contributions
1428 C to its derivatives
1429 C have you changed here?
1430 fac=(rrij*sigsq)**expon2
1433 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1434 eps2der=evdwij*eps3rt
1435 eps3der=evdwij*eps2rt
1436 evdwij=evdwij*eps2rt*eps3rt
1439 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1441 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1442 cd & restyp(itypi),i,restyp(itypj),j,
1443 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1444 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1445 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1448 C Calculate gradient components.
1449 e1=e1*eps1*eps2rt**2*eps3rt**2
1450 fac=-expon*(e1+evdwij)
1453 C Calculate radial part of the gradient
1457 C Calculate the angular part of the gradient and sum add the contributions
1458 C to the appropriate components of the Cartesian gradient.
1466 C-----------------------------------------------------------------------------
1467 subroutine egb(evdw)
1469 C This subroutine calculates the interaction energy of nonbonded side chains
1470 C assuming the Gay-Berne potential of interaction.
1472 implicit real*8 (a-h,o-z)
1473 include 'DIMENSIONS'
1474 include 'COMMON.GEO'
1475 include 'COMMON.VAR'
1476 include 'COMMON.LOCAL'
1477 include 'COMMON.CHAIN'
1478 include 'COMMON.DERIV'
1479 include 'COMMON.NAMES'
1480 include 'COMMON.INTERACT'
1481 include 'COMMON.IOUNITS'
1482 include 'COMMON.CALC'
1483 include 'COMMON.CONTROL'
1484 include 'COMMON.SPLITELE'
1485 include 'COMMON.SBRIDGE'
1487 integer xshift,yshift,zshift
1490 ccccc energy_dec=.false.
1491 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1494 c if (icall.eq.0) lprn=.false.
1496 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1497 C we have the original box)
1501 do i=iatsc_s,iatsc_e
1502 itypi=iabs(itype(i))
1503 if (itypi.eq.ntyp1) cycle
1504 itypi1=iabs(itype(i+1))
1508 C Return atom into box, boxxsize is size of box in x dimension
1510 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1511 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1512 C Condition for being inside the proper box
1513 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1514 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1518 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1519 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1520 C Condition for being inside the proper box
1521 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1522 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1526 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1527 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1528 C Condition for being inside the proper box
1529 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1530 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1534 if (xi.lt.0) xi=xi+boxxsize
1536 if (yi.lt.0) yi=yi+boxysize
1538 if (zi.lt.0) zi=zi+boxzsize
1539 C define scaling factor for lipids
1541 C if (positi.le.0) positi=positi+boxzsize
1543 C first for peptide groups
1544 c for each residue check if it is in lipid or lipid water border area
1545 if ((zi.gt.bordlipbot)
1546 &.and.(zi.lt.bordliptop)) then
1547 C the energy transfer exist
1548 if (zi.lt.buflipbot) then
1549 C what fraction I am in
1551 & ((zi-bordlipbot)/lipbufthick)
1552 C lipbufthick is thickenes of lipid buffore
1553 sslipi=sscalelip(fracinbuf)
1554 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1555 elseif (zi.gt.bufliptop) then
1556 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1557 sslipi=sscalelip(fracinbuf)
1558 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1568 C xi=xi+xshift*boxxsize
1569 C yi=yi+yshift*boxysize
1570 C zi=zi+zshift*boxzsize
1572 dxi=dc_norm(1,nres+i)
1573 dyi=dc_norm(2,nres+i)
1574 dzi=dc_norm(3,nres+i)
1575 c dsci_inv=dsc_inv(itypi)
1576 dsci_inv=vbld_inv(i+nres)
1577 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1578 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1580 C Calculate SC interaction energy.
1582 do iint=1,nint_gr(i)
1583 do j=istart(i,iint),iend(i,iint)
1584 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1586 c write(iout,*) "PRZED ZWYKLE", evdwij
1587 call dyn_ssbond_ene(i,j,evdwij)
1588 c write(iout,*) "PO ZWYKLE", evdwij
1591 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1592 & 'evdw',i,j,evdwij,' ss'
1593 C triple bond artifac removal
1594 do k=j+1,iend(i,iint)
1595 C search over all next residues
1596 if (dyn_ss_mask(k)) then
1597 C check if they are cysteins
1598 C write(iout,*) 'k=',k
1600 c write(iout,*) "PRZED TRI", evdwij
1601 evdwij_przed_tri=evdwij
1602 call triple_ssbond_ene(i,j,k,evdwij)
1603 c if(evdwij_przed_tri.ne.evdwij) then
1604 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1607 c write(iout,*) "PO TRI", evdwij
1608 C call the energy function that removes the artifical triple disulfide
1609 C bond the soubroutine is located in ssMD.F
1611 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1612 & 'evdw',i,j,evdwij,'tss'
1613 endif!dyn_ss_mask(k)
1617 itypj=iabs(itype(j))
1618 if (itypj.eq.ntyp1) cycle
1619 c dscj_inv=dsc_inv(itypj)
1620 dscj_inv=vbld_inv(j+nres)
1621 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1622 c & 1.0d0/vbld(j+nres)
1623 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1624 sig0ij=sigma(itypi,itypj)
1625 chi1=chi(itypi,itypj)
1626 chi2=chi(itypj,itypi)
1633 alf12=0.5D0*(alf1+alf2)
1634 C For diagnostics only!!!
1647 C Return atom J into box the original box
1649 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1650 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1651 C Condition for being inside the proper box
1652 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1653 c & (xj.lt.((-0.5d0)*boxxsize))) then
1657 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1658 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1659 C Condition for being inside the proper box
1660 c if ((yj.gt.((0.5d0)*boxysize)).or.
1661 c & (yj.lt.((-0.5d0)*boxysize))) then
1665 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1666 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1667 C Condition for being inside the proper box
1668 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1669 c & (zj.lt.((-0.5d0)*boxzsize))) then
1673 if (xj.lt.0) xj=xj+boxxsize
1675 if (yj.lt.0) yj=yj+boxysize
1677 if (zj.lt.0) zj=zj+boxzsize
1678 if ((zj.gt.bordlipbot)
1679 &.and.(zj.lt.bordliptop)) then
1680 C the energy transfer exist
1681 if (zj.lt.buflipbot) then
1682 C what fraction I am in
1684 & ((zj-bordlipbot)/lipbufthick)
1685 C lipbufthick is thickenes of lipid buffore
1686 sslipj=sscalelip(fracinbuf)
1687 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1688 elseif (zj.gt.bufliptop) then
1689 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1690 sslipj=sscalelip(fracinbuf)
1691 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1700 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1701 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1702 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1703 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1704 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1705 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1706 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1707 C print *,sslipi,sslipj,bordlipbot,zi,zj
1708 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1716 xj=xj_safe+xshift*boxxsize
1717 yj=yj_safe+yshift*boxysize
1718 zj=zj_safe+zshift*boxzsize
1719 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1720 if(dist_temp.lt.dist_init) then
1730 if (subchap.eq.1) then
1739 dxj=dc_norm(1,nres+j)
1740 dyj=dc_norm(2,nres+j)
1741 dzj=dc_norm(3,nres+j)
1745 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1746 c write (iout,*) "j",j," dc_norm",
1747 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1748 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1750 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1751 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1753 c write (iout,'(a7,4f8.3)')
1754 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1755 if (sss.gt.0.0d0) then
1756 C Calculate angle-dependent terms of energy and contributions to their
1760 sig=sig0ij*dsqrt(sigsq)
1761 rij_shift=1.0D0/rij-sig+sig0ij
1762 c for diagnostics; uncomment
1763 c rij_shift=1.2*sig0ij
1764 C I hate to put IF's in the loops, but here don't have another choice!!!!
1765 if (rij_shift.le.0.0D0) then
1767 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1768 cd & restyp(itypi),i,restyp(itypj),j,
1769 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1773 c---------------------------------------------------------------
1774 rij_shift=1.0D0/rij_shift
1775 fac=rij_shift**expon
1776 C here to start with
1781 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1782 eps2der=evdwij*eps3rt
1783 eps3der=evdwij*eps2rt
1784 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1785 C &((sslipi+sslipj)/2.0d0+
1786 C &(2.0d0-sslipi-sslipj)/2.0d0)
1787 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1788 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1789 evdwij=evdwij*eps2rt*eps3rt
1790 evdw=evdw+evdwij*sss
1792 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1794 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1795 & restyp(itypi),i,restyp(itypj),j,
1796 & epsi,sigm,chi1,chi2,chip1,chip2,
1797 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1798 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1802 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1805 C Calculate gradient components.
1806 e1=e1*eps1*eps2rt**2*eps3rt**2
1807 fac=-expon*(e1+evdwij)*rij_shift
1810 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1811 c & evdwij,fac,sigma(itypi,itypj),expon
1812 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1814 C Calculate the radial part of the gradient
1815 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1816 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1817 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1818 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1819 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1820 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1826 C Calculate angular part of the gradient.
1836 c write (iout,*) "Number of loop steps in EGB:",ind
1837 cccc energy_dec=.false.
1840 C-----------------------------------------------------------------------------
1841 subroutine egbv(evdw)
1843 C This subroutine calculates the interaction energy of nonbonded side chains
1844 C assuming the Gay-Berne-Vorobjev potential of interaction.
1846 implicit real*8 (a-h,o-z)
1847 include 'DIMENSIONS'
1848 include 'COMMON.GEO'
1849 include 'COMMON.VAR'
1850 include 'COMMON.LOCAL'
1851 include 'COMMON.CHAIN'
1852 include 'COMMON.DERIV'
1853 include 'COMMON.NAMES'
1854 include 'COMMON.INTERACT'
1855 include 'COMMON.IOUNITS'
1856 include 'COMMON.CALC'
1857 common /srutu/ icall
1860 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1863 c if (icall.eq.0) lprn=.true.
1865 do i=iatsc_s,iatsc_e
1866 itypi=iabs(itype(i))
1867 if (itypi.eq.ntyp1) cycle
1868 itypi1=iabs(itype(i+1))
1873 if (xi.lt.0) xi=xi+boxxsize
1875 if (yi.lt.0) yi=yi+boxysize
1877 if (zi.lt.0) zi=zi+boxzsize
1878 C define scaling factor for lipids
1880 C if (positi.le.0) positi=positi+boxzsize
1882 C first for peptide groups
1883 c for each residue check if it is in lipid or lipid water border area
1884 if ((zi.gt.bordlipbot)
1885 &.and.(zi.lt.bordliptop)) then
1886 C the energy transfer exist
1887 if (zi.lt.buflipbot) then
1888 C what fraction I am in
1890 & ((zi-bordlipbot)/lipbufthick)
1891 C lipbufthick is thickenes of lipid buffore
1892 sslipi=sscalelip(fracinbuf)
1893 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1894 elseif (zi.gt.bufliptop) then
1895 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1896 sslipi=sscalelip(fracinbuf)
1897 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1907 dxi=dc_norm(1,nres+i)
1908 dyi=dc_norm(2,nres+i)
1909 dzi=dc_norm(3,nres+i)
1910 c dsci_inv=dsc_inv(itypi)
1911 dsci_inv=vbld_inv(i+nres)
1913 C Calculate SC interaction energy.
1915 do iint=1,nint_gr(i)
1916 do j=istart(i,iint),iend(i,iint)
1918 itypj=iabs(itype(j))
1919 if (itypj.eq.ntyp1) cycle
1920 c dscj_inv=dsc_inv(itypj)
1921 dscj_inv=vbld_inv(j+nres)
1922 sig0ij=sigma(itypi,itypj)
1923 r0ij=r0(itypi,itypj)
1924 chi1=chi(itypi,itypj)
1925 chi2=chi(itypj,itypi)
1932 alf12=0.5D0*(alf1+alf2)
1933 C For diagnostics only!!!
1947 if (xj.lt.0) xj=xj+boxxsize
1949 if (yj.lt.0) yj=yj+boxysize
1951 if (zj.lt.0) zj=zj+boxzsize
1952 if ((zj.gt.bordlipbot)
1953 &.and.(zj.lt.bordliptop)) then
1954 C the energy transfer exist
1955 if (zj.lt.buflipbot) then
1956 C what fraction I am in
1958 & ((zj-bordlipbot)/lipbufthick)
1959 C lipbufthick is thickenes of lipid buffore
1960 sslipj=sscalelip(fracinbuf)
1961 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1962 elseif (zj.gt.bufliptop) then
1963 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1964 sslipj=sscalelip(fracinbuf)
1965 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1974 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1975 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1976 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1977 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1978 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
1979 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1980 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1988 xj=xj_safe+xshift*boxxsize
1989 yj=yj_safe+yshift*boxysize
1990 zj=zj_safe+zshift*boxzsize
1991 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1992 if(dist_temp.lt.dist_init) then
2002 if (subchap.eq.1) then
2011 dxj=dc_norm(1,nres+j)
2012 dyj=dc_norm(2,nres+j)
2013 dzj=dc_norm(3,nres+j)
2014 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2016 C Calculate angle-dependent terms of energy and contributions to their
2020 sig=sig0ij*dsqrt(sigsq)
2021 rij_shift=1.0D0/rij-sig+r0ij
2022 C I hate to put IF's in the loops, but here don't have another choice!!!!
2023 if (rij_shift.le.0.0D0) then
2028 c---------------------------------------------------------------
2029 rij_shift=1.0D0/rij_shift
2030 fac=rij_shift**expon
2033 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2034 eps2der=evdwij*eps3rt
2035 eps3der=evdwij*eps2rt
2036 fac_augm=rrij**expon
2037 e_augm=augm(itypi,itypj)*fac_augm
2038 evdwij=evdwij*eps2rt*eps3rt
2039 evdw=evdw+evdwij+e_augm
2041 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2043 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2044 & restyp(itypi),i,restyp(itypj),j,
2045 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2046 & chi1,chi2,chip1,chip2,
2047 & eps1,eps2rt**2,eps3rt**2,
2048 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2051 C Calculate gradient components.
2052 e1=e1*eps1*eps2rt**2*eps3rt**2
2053 fac=-expon*(e1+evdwij)*rij_shift
2055 fac=rij*fac-2*expon*rrij*e_augm
2056 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2057 C Calculate the radial part of the gradient
2061 C Calculate angular part of the gradient.
2067 C-----------------------------------------------------------------------------
2068 subroutine sc_angular
2069 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2070 C om12. Called by ebp, egb, and egbv.
2072 include 'COMMON.CALC'
2073 include 'COMMON.IOUNITS'
2077 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2078 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2079 om12=dxi*dxj+dyi*dyj+dzi*dzj
2081 C Calculate eps1(om12) and its derivative in om12
2082 faceps1=1.0D0-om12*chiom12
2083 faceps1_inv=1.0D0/faceps1
2084 eps1=dsqrt(faceps1_inv)
2085 C Following variable is eps1*deps1/dom12
2086 eps1_om12=faceps1_inv*chiom12
2091 c write (iout,*) "om12",om12," eps1",eps1
2092 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2097 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2098 sigsq=1.0D0-facsig*faceps1_inv
2099 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2100 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2101 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2107 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2108 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2110 C Calculate eps2 and its derivatives in om1, om2, and om12.
2113 chipom12=chip12*om12
2114 facp=1.0D0-om12*chipom12
2116 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2117 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2118 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2119 C Following variable is the square root of eps2
2120 eps2rt=1.0D0-facp1*facp_inv
2121 C Following three variables are the derivatives of the square root of eps
2122 C in om1, om2, and om12.
2123 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2124 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2125 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2126 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2127 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2128 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2129 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2130 c & " eps2rt_om12",eps2rt_om12
2131 C Calculate whole angle-dependent part of epsilon and contributions
2132 C to its derivatives
2135 C----------------------------------------------------------------------------
2137 implicit real*8 (a-h,o-z)
2138 include 'DIMENSIONS'
2139 include 'COMMON.CHAIN'
2140 include 'COMMON.DERIV'
2141 include 'COMMON.CALC'
2142 include 'COMMON.IOUNITS'
2143 double precision dcosom1(3),dcosom2(3)
2144 cc print *,'sss=',sss
2145 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2146 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2147 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2148 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2152 c eom12=evdwij*eps1_om12
2154 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2155 c & " sigder",sigder
2156 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2157 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2159 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2160 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2163 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2165 c write (iout,*) "gg",(gg(k),k=1,3)
2167 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2168 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2169 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2170 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2171 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2172 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2173 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2174 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2175 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2176 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2179 C Calculate the components of the gradient in DC and X
2183 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2187 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2188 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2192 C-----------------------------------------------------------------------
2193 subroutine e_softsphere(evdw)
2195 C This subroutine calculates the interaction energy of nonbonded side chains
2196 C assuming the LJ potential of interaction.
2198 implicit real*8 (a-h,o-z)
2199 include 'DIMENSIONS'
2200 parameter (accur=1.0d-10)
2201 include 'COMMON.GEO'
2202 include 'COMMON.VAR'
2203 include 'COMMON.LOCAL'
2204 include 'COMMON.CHAIN'
2205 include 'COMMON.DERIV'
2206 include 'COMMON.INTERACT'
2207 include 'COMMON.TORSION'
2208 include 'COMMON.SBRIDGE'
2209 include 'COMMON.NAMES'
2210 include 'COMMON.IOUNITS'
2211 include 'COMMON.CONTACTS'
2213 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2215 do i=iatsc_s,iatsc_e
2216 itypi=iabs(itype(i))
2217 if (itypi.eq.ntyp1) cycle
2218 itypi1=iabs(itype(i+1))
2223 C Calculate SC interaction energy.
2225 do iint=1,nint_gr(i)
2226 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2227 cd & 'iend=',iend(i,iint)
2228 do j=istart(i,iint),iend(i,iint)
2229 itypj=iabs(itype(j))
2230 if (itypj.eq.ntyp1) cycle
2234 rij=xj*xj+yj*yj+zj*zj
2235 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2236 r0ij=r0(itypi,itypj)
2238 c print *,i,j,r0ij,dsqrt(rij)
2239 if (rij.lt.r0ijsq) then
2240 evdwij=0.25d0*(rij-r0ijsq)**2
2248 C Calculate the components of the gradient in DC and X
2254 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2255 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2256 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2257 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2261 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2269 C--------------------------------------------------------------------------
2270 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2273 C Soft-sphere potential of p-p interaction
2275 implicit real*8 (a-h,o-z)
2276 include 'DIMENSIONS'
2277 include 'COMMON.CONTROL'
2278 include 'COMMON.IOUNITS'
2279 include 'COMMON.GEO'
2280 include 'COMMON.VAR'
2281 include 'COMMON.LOCAL'
2282 include 'COMMON.CHAIN'
2283 include 'COMMON.DERIV'
2284 include 'COMMON.INTERACT'
2285 include 'COMMON.CONTACTS'
2286 include 'COMMON.TORSION'
2287 include 'COMMON.VECTORS'
2288 include 'COMMON.FFIELD'
2290 C write(iout,*) 'In EELEC_soft_sphere'
2297 do i=iatel_s,iatel_e
2298 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2302 xmedi=c(1,i)+0.5d0*dxi
2303 ymedi=c(2,i)+0.5d0*dyi
2304 zmedi=c(3,i)+0.5d0*dzi
2305 xmedi=mod(xmedi,boxxsize)
2306 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2307 ymedi=mod(ymedi,boxysize)
2308 if (ymedi.lt.0) ymedi=ymedi+boxysize
2309 zmedi=mod(zmedi,boxzsize)
2310 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2312 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2313 do j=ielstart(i),ielend(i)
2314 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2318 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2319 r0ij=rpp(iteli,itelj)
2328 if (xj.lt.0) xj=xj+boxxsize
2330 if (yj.lt.0) yj=yj+boxysize
2332 if (zj.lt.0) zj=zj+boxzsize
2333 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2341 xj=xj_safe+xshift*boxxsize
2342 yj=yj_safe+yshift*boxysize
2343 zj=zj_safe+zshift*boxzsize
2344 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2345 if(dist_temp.lt.dist_init) then
2355 if (isubchap.eq.1) then
2364 rij=xj*xj+yj*yj+zj*zj
2365 sss=sscale(sqrt(rij))
2366 sssgrad=sscagrad(sqrt(rij))
2367 if (rij.lt.r0ijsq) then
2368 evdw1ij=0.25d0*(rij-r0ijsq)**2
2374 evdw1=evdw1+evdw1ij*sss
2376 C Calculate contributions to the Cartesian gradient.
2378 ggg(1)=fac*xj*sssgrad
2379 ggg(2)=fac*yj*sssgrad
2380 ggg(3)=fac*zj*sssgrad
2382 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2383 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2386 * Loop over residues i+1 thru j-1.
2390 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2395 cgrad do i=nnt,nct-1
2397 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2399 cgrad do j=i+1,nct-1
2401 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2407 c------------------------------------------------------------------------------
2408 subroutine vec_and_deriv
2409 implicit real*8 (a-h,o-z)
2410 include 'DIMENSIONS'
2414 include 'COMMON.IOUNITS'
2415 include 'COMMON.GEO'
2416 include 'COMMON.VAR'
2417 include 'COMMON.LOCAL'
2418 include 'COMMON.CHAIN'
2419 include 'COMMON.VECTORS'
2420 include 'COMMON.SETUP'
2421 include 'COMMON.TIME1'
2422 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2423 C Compute the local reference systems. For reference system (i), the
2424 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2425 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2427 do i=ivec_start,ivec_end
2431 if (i.eq.nres-1) then
2432 C Case of the last full residue
2433 C Compute the Z-axis
2434 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2435 costh=dcos(pi-theta(nres))
2436 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2440 C Compute the derivatives of uz
2442 uzder(2,1,1)=-dc_norm(3,i-1)
2443 uzder(3,1,1)= dc_norm(2,i-1)
2444 uzder(1,2,1)= dc_norm(3,i-1)
2446 uzder(3,2,1)=-dc_norm(1,i-1)
2447 uzder(1,3,1)=-dc_norm(2,i-1)
2448 uzder(2,3,1)= dc_norm(1,i-1)
2451 uzder(2,1,2)= dc_norm(3,i)
2452 uzder(3,1,2)=-dc_norm(2,i)
2453 uzder(1,2,2)=-dc_norm(3,i)
2455 uzder(3,2,2)= dc_norm(1,i)
2456 uzder(1,3,2)= dc_norm(2,i)
2457 uzder(2,3,2)=-dc_norm(1,i)
2459 C Compute the Y-axis
2462 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2464 C Compute the derivatives of uy
2467 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2468 & -dc_norm(k,i)*dc_norm(j,i-1)
2469 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2471 uyder(j,j,1)=uyder(j,j,1)-costh
2472 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2477 uygrad(l,k,j,i)=uyder(l,k,j)
2478 uzgrad(l,k,j,i)=uzder(l,k,j)
2482 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2483 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2484 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2485 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2488 C Compute the Z-axis
2489 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2490 costh=dcos(pi-theta(i+2))
2491 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2495 C Compute the derivatives of uz
2497 uzder(2,1,1)=-dc_norm(3,i+1)
2498 uzder(3,1,1)= dc_norm(2,i+1)
2499 uzder(1,2,1)= dc_norm(3,i+1)
2501 uzder(3,2,1)=-dc_norm(1,i+1)
2502 uzder(1,3,1)=-dc_norm(2,i+1)
2503 uzder(2,3,1)= dc_norm(1,i+1)
2506 uzder(2,1,2)= dc_norm(3,i)
2507 uzder(3,1,2)=-dc_norm(2,i)
2508 uzder(1,2,2)=-dc_norm(3,i)
2510 uzder(3,2,2)= dc_norm(1,i)
2511 uzder(1,3,2)= dc_norm(2,i)
2512 uzder(2,3,2)=-dc_norm(1,i)
2514 C Compute the Y-axis
2517 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2519 C Compute the derivatives of uy
2522 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2523 & -dc_norm(k,i)*dc_norm(j,i+1)
2524 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2526 uyder(j,j,1)=uyder(j,j,1)-costh
2527 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2532 uygrad(l,k,j,i)=uyder(l,k,j)
2533 uzgrad(l,k,j,i)=uzder(l,k,j)
2537 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2538 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2539 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2540 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2544 vbld_inv_temp(1)=vbld_inv(i+1)
2545 if (i.lt.nres-1) then
2546 vbld_inv_temp(2)=vbld_inv(i+2)
2548 vbld_inv_temp(2)=vbld_inv(i)
2553 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2554 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2559 #if defined(PARVEC) && defined(MPI)
2560 if (nfgtasks1.gt.1) then
2562 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2563 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2564 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2565 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2566 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2568 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2569 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2571 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2572 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2573 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2574 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2575 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2576 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2577 time_gather=time_gather+MPI_Wtime()-time00
2579 c if (fg_rank.eq.0) then
2580 c write (iout,*) "Arrays UY and UZ"
2582 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2589 C-----------------------------------------------------------------------------
2590 subroutine check_vecgrad
2591 implicit real*8 (a-h,o-z)
2592 include 'DIMENSIONS'
2593 include 'COMMON.IOUNITS'
2594 include 'COMMON.GEO'
2595 include 'COMMON.VAR'
2596 include 'COMMON.LOCAL'
2597 include 'COMMON.CHAIN'
2598 include 'COMMON.VECTORS'
2599 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2600 dimension uyt(3,maxres),uzt(3,maxres)
2601 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2602 double precision delta /1.0d-7/
2605 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2606 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2607 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2608 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2609 cd & (dc_norm(if90,i),if90=1,3)
2610 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2611 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2612 cd write(iout,'(a)')
2618 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2619 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2632 cd write (iout,*) 'i=',i
2634 erij(k)=dc_norm(k,i)
2638 dc_norm(k,i)=erij(k)
2640 dc_norm(j,i)=dc_norm(j,i)+delta
2641 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2643 c dc_norm(k,i)=dc_norm(k,i)/fac
2645 c write (iout,*) (dc_norm(k,i),k=1,3)
2646 c write (iout,*) (erij(k),k=1,3)
2649 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2650 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2651 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2652 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2654 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2655 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2656 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2659 dc_norm(k,i)=erij(k)
2662 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2663 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2664 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2665 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2666 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2667 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2668 cd write (iout,'(a)')
2673 C--------------------------------------------------------------------------
2674 subroutine set_matrices
2675 implicit real*8 (a-h,o-z)
2676 include 'DIMENSIONS'
2679 include "COMMON.SETUP"
2681 integer status(MPI_STATUS_SIZE)
2683 include 'COMMON.IOUNITS'
2684 include 'COMMON.GEO'
2685 include 'COMMON.VAR'
2686 include 'COMMON.LOCAL'
2687 include 'COMMON.CHAIN'
2688 include 'COMMON.DERIV'
2689 include 'COMMON.INTERACT'
2690 include 'COMMON.CONTACTS'
2691 include 'COMMON.TORSION'
2692 include 'COMMON.VECTORS'
2693 include 'COMMON.FFIELD'
2694 double precision auxvec(2),auxmat(2,2)
2696 C Compute the virtual-bond-torsional-angle dependent quantities needed
2697 C to calculate the el-loc multibody terms of various order.
2699 c write(iout,*) 'nphi=',nphi,nres
2701 do i=ivec_start+2,ivec_end+2
2706 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2707 iti = itortyp(itype(i-2))
2711 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2712 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2713 iti1 = itortyp(itype(i-1))
2718 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2719 & +bnew1(2,1,iti)*dsin(theta(i-1))
2720 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2721 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2722 & +bnew1(2,1,iti)*dcos(theta(i-1))
2723 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2724 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2725 c &*(cos(theta(i)/2.0)
2726 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2727 & +bnew2(2,1,iti)*dsin(theta(i-1))
2728 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2729 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2730 c &*(cos(theta(i)/2.0)
2731 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2732 & +bnew2(2,1,iti)*dcos(theta(i-1))
2733 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2734 c if (ggb1(1,i).eq.0.0d0) then
2735 c write(iout,*) 'i=',i,ggb1(1,i),
2736 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2737 c &bnew1(2,1,iti)*cos(theta(i)),
2738 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2740 b1(2,i-2)=bnew1(1,2,iti)
2742 b2(2,i-2)=bnew2(1,2,iti)
2744 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2745 EE(1,2,i-2)=eeold(1,2,iti)
2746 EE(2,1,i-2)=eeold(2,1,iti)
2747 EE(2,2,i-2)=eeold(2,2,iti)
2748 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2753 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2754 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2755 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2756 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2757 b1tilde(1,i-2)=b1(1,i-2)
2758 b1tilde(2,i-2)=-b1(2,i-2)
2759 b2tilde(1,i-2)=b2(1,i-2)
2760 b2tilde(2,i-2)=-b2(2,i-2)
2761 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2762 c write(iout,*) 'b1=',b1(1,i-2)
2763 c write (iout,*) 'theta=', theta(i-1)
2770 b1tilde(1,i-2)=b1(1,i-2)
2771 b1tilde(2,i-2)=-b1(2,i-2)
2772 b2tilde(1,i-2)=b2(1,i-2)
2773 b2tilde(2,i-2)=-b2(2,i-2)
2774 EE(1,2,i-2)=eeold(1,2,iti)
2775 EE(2,1,i-2)=eeold(2,1,iti)
2776 EE(2,2,i-2)=eeold(2,2,iti)
2777 EE(1,1,i-2)=eeold(1,1,iti)
2781 do i=ivec_start+2,ivec_end+2
2785 if (i .lt. nres+1) then
2822 if (i .gt. 3 .and. i .lt. nres+1) then
2823 obrot_der(1,i-2)=-sin1
2824 obrot_der(2,i-2)= cos1
2825 Ugder(1,1,i-2)= sin1
2826 Ugder(1,2,i-2)=-cos1
2827 Ugder(2,1,i-2)=-cos1
2828 Ugder(2,2,i-2)=-sin1
2831 obrot2_der(1,i-2)=-dwasin2
2832 obrot2_der(2,i-2)= dwacos2
2833 Ug2der(1,1,i-2)= dwasin2
2834 Ug2der(1,2,i-2)=-dwacos2
2835 Ug2der(2,1,i-2)=-dwacos2
2836 Ug2der(2,2,i-2)=-dwasin2
2838 obrot_der(1,i-2)=0.0d0
2839 obrot_der(2,i-2)=0.0d0
2840 Ugder(1,1,i-2)=0.0d0
2841 Ugder(1,2,i-2)=0.0d0
2842 Ugder(2,1,i-2)=0.0d0
2843 Ugder(2,2,i-2)=0.0d0
2844 obrot2_der(1,i-2)=0.0d0
2845 obrot2_der(2,i-2)=0.0d0
2846 Ug2der(1,1,i-2)=0.0d0
2847 Ug2der(1,2,i-2)=0.0d0
2848 Ug2der(2,1,i-2)=0.0d0
2849 Ug2der(2,2,i-2)=0.0d0
2851 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2852 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2853 iti = itortyp(itype(i-2))
2857 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2858 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2859 iti1 = itortyp(itype(i-1))
2863 cd write (iout,*) '*******i',i,' iti1',iti
2864 cd write (iout,*) 'b1',b1(:,iti)
2865 cd write (iout,*) 'b2',b2(:,iti)
2866 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2867 c if (i .gt. iatel_s+2) then
2868 if (i .gt. nnt+2) then
2869 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2871 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2872 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2874 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2875 c & EE(1,2,iti),EE(2,2,iti)
2876 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2877 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2878 c write(iout,*) "Macierz EUG",
2879 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2881 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2883 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2884 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2885 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2886 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2887 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2898 DtUg2(l,k,i-2)=0.0d0
2902 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2903 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2905 muder(k,i-2)=Ub2der(k,i-2)
2907 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2908 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2909 if (itype(i-1).le.ntyp) then
2910 iti1 = itortyp(itype(i-1))
2918 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2920 c write (iout,*) 'mu ',mu(:,i-2),i-2
2921 cd write (iout,*) 'mu1',mu1(:,i-2)
2922 cd write (iout,*) 'mu2',mu2(:,i-2)
2923 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2925 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2926 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2927 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2928 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2929 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2930 C Vectors and matrices dependent on a single virtual-bond dihedral.
2931 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2932 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2933 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2934 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2935 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2936 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2937 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2938 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2939 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2942 C Matrices dependent on two consecutive virtual-bond dihedrals.
2943 C The order of matrices is from left to right.
2944 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2946 c do i=max0(ivec_start,2),ivec_end
2948 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2949 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2950 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2951 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2952 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2953 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2954 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2955 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2958 #if defined(MPI) && defined(PARMAT)
2960 c if (fg_rank.eq.0) then
2961 write (iout,*) "Arrays UG and UGDER before GATHER"
2963 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2964 & ((ug(l,k,i),l=1,2),k=1,2),
2965 & ((ugder(l,k,i),l=1,2),k=1,2)
2967 write (iout,*) "Arrays UG2 and UG2DER"
2969 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2970 & ((ug2(l,k,i),l=1,2),k=1,2),
2971 & ((ug2der(l,k,i),l=1,2),k=1,2)
2973 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2975 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2976 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2977 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2979 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2981 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2982 & costab(i),sintab(i),costab2(i),sintab2(i)
2984 write (iout,*) "Array MUDER"
2986 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2990 if (nfgtasks.gt.1) then
2992 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2993 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2994 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2996 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2997 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2999 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
3000 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3002 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
3003 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3005 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
3006 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3008 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
3009 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3011 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
3012 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3014 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
3015 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
3016 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3017 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
3018 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
3019 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3020 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
3021 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
3022 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3023 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
3024 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
3025 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3026 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3028 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
3029 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3031 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
3032 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3034 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
3035 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3037 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3038 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3040 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3041 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3043 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3044 & ivec_count(fg_rank1),
3045 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3047 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3048 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3050 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3051 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3053 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3054 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3056 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3057 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3059 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3060 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3062 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3063 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3065 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3066 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3068 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3069 & ivec_count(fg_rank1),
3070 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3072 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3073 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3075 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3076 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3078 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3079 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3081 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3082 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3084 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3085 & ivec_count(fg_rank1),
3086 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3088 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3089 & ivec_count(fg_rank1),
3090 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3092 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3093 & ivec_count(fg_rank1),
3094 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3095 & MPI_MAT2,FG_COMM1,IERR)
3096 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3097 & ivec_count(fg_rank1),
3098 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3099 & MPI_MAT2,FG_COMM1,IERR)
3102 c Passes matrix info through the ring
3105 if (irecv.lt.0) irecv=nfgtasks1-1
3108 if (inext.ge.nfgtasks1) inext=0
3110 c write (iout,*) "isend",isend," irecv",irecv
3112 lensend=lentyp(isend)
3113 lenrecv=lentyp(irecv)
3114 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3115 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3116 c & MPI_ROTAT1(lensend),inext,2200+isend,
3117 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3118 c & iprev,2200+irecv,FG_COMM,status,IERR)
3119 c write (iout,*) "Gather ROTAT1"
3121 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3122 c & MPI_ROTAT2(lensend),inext,3300+isend,
3123 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3124 c & iprev,3300+irecv,FG_COMM,status,IERR)
3125 c write (iout,*) "Gather ROTAT2"
3127 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3128 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3129 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3130 & iprev,4400+irecv,FG_COMM,status,IERR)
3131 c write (iout,*) "Gather ROTAT_OLD"
3133 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3134 & MPI_PRECOMP11(lensend),inext,5500+isend,
3135 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3136 & iprev,5500+irecv,FG_COMM,status,IERR)
3137 c write (iout,*) "Gather PRECOMP11"
3139 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3140 & MPI_PRECOMP12(lensend),inext,6600+isend,
3141 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3142 & iprev,6600+irecv,FG_COMM,status,IERR)
3143 c write (iout,*) "Gather PRECOMP12"
3145 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3147 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3148 & MPI_ROTAT2(lensend),inext,7700+isend,
3149 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3150 & iprev,7700+irecv,FG_COMM,status,IERR)
3151 c write (iout,*) "Gather PRECOMP21"
3153 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3154 & MPI_PRECOMP22(lensend),inext,8800+isend,
3155 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3156 & iprev,8800+irecv,FG_COMM,status,IERR)
3157 c write (iout,*) "Gather PRECOMP22"
3159 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3160 & MPI_PRECOMP23(lensend),inext,9900+isend,
3161 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3162 & MPI_PRECOMP23(lenrecv),
3163 & iprev,9900+irecv,FG_COMM,status,IERR)
3164 c write (iout,*) "Gather PRECOMP23"
3169 if (irecv.lt.0) irecv=nfgtasks1-1
3172 time_gather=time_gather+MPI_Wtime()-time00
3175 c if (fg_rank.eq.0) then
3176 write (iout,*) "Arrays UG and UGDER"
3178 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3179 & ((ug(l,k,i),l=1,2),k=1,2),
3180 & ((ugder(l,k,i),l=1,2),k=1,2)
3182 write (iout,*) "Arrays UG2 and UG2DER"
3184 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3185 & ((ug2(l,k,i),l=1,2),k=1,2),
3186 & ((ug2der(l,k,i),l=1,2),k=1,2)
3188 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3190 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3191 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3192 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3194 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3196 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3197 & costab(i),sintab(i),costab2(i),sintab2(i)
3199 write (iout,*) "Array MUDER"
3201 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3207 cd iti = itortyp(itype(i))
3210 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3211 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3216 C--------------------------------------------------------------------------
3217 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3219 C This subroutine calculates the average interaction energy and its gradient
3220 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3221 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3222 C The potential depends both on the distance of peptide-group centers and on
3223 C the orientation of the CA-CA virtual bonds.
3225 implicit real*8 (a-h,o-z)
3229 include 'DIMENSIONS'
3230 include 'COMMON.CONTROL'
3231 include 'COMMON.SETUP'
3232 include 'COMMON.IOUNITS'
3233 include 'COMMON.GEO'
3234 include 'COMMON.VAR'
3235 include 'COMMON.LOCAL'
3236 include 'COMMON.CHAIN'
3237 include 'COMMON.DERIV'
3238 include 'COMMON.INTERACT'
3239 include 'COMMON.CONTACTS'
3240 include 'COMMON.TORSION'
3241 include 'COMMON.VECTORS'
3242 include 'COMMON.FFIELD'
3243 include 'COMMON.TIME1'
3244 include 'COMMON.SPLITELE'
3245 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3246 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3247 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3248 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3249 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3250 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3252 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3254 double precision scal_el /1.0d0/
3256 double precision scal_el /0.5d0/
3259 C 13-go grudnia roku pamietnego...
3260 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3261 & 0.0d0,1.0d0,0.0d0,
3262 & 0.0d0,0.0d0,1.0d0/
3263 cd write(iout,*) 'In EELEC'
3265 cd write(iout,*) 'Type',i
3266 cd write(iout,*) 'B1',B1(:,i)
3267 cd write(iout,*) 'B2',B2(:,i)
3268 cd write(iout,*) 'CC',CC(:,:,i)
3269 cd write(iout,*) 'DD',DD(:,:,i)
3270 cd write(iout,*) 'EE',EE(:,:,i)
3272 cd call check_vecgrad
3274 if (icheckgrad.eq.1) then
3276 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3278 dc_norm(k,i)=dc(k,i)*fac
3280 c write (iout,*) 'i',i,' fac',fac
3283 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3284 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3285 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3286 c call vec_and_deriv
3292 time_mat=time_mat+MPI_Wtime()-time01
3296 cd write (iout,*) 'i=',i
3298 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3301 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3302 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3315 cd print '(a)','Enter EELEC'
3316 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3318 gel_loc_loc(i)=0.0d0
3323 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3325 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3327 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3328 do i=iturn3_start,iturn3_end
3330 C write(iout,*) "tu jest i",i
3331 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3332 C changes suggested by Ana to avoid out of bounds
3333 & .or.((i+4).gt.nres)
3335 C end of changes by Ana
3336 & .or. itype(i+2).eq.ntyp1
3337 & .or. itype(i+3).eq.ntyp1) cycle
3339 if(itype(i-1).eq.ntyp1)cycle
3342 if (itype(i+4).eq.ntyp1) cycle
3347 dx_normi=dc_norm(1,i)
3348 dy_normi=dc_norm(2,i)
3349 dz_normi=dc_norm(3,i)
3350 xmedi=c(1,i)+0.5d0*dxi
3351 ymedi=c(2,i)+0.5d0*dyi
3352 zmedi=c(3,i)+0.5d0*dzi
3353 xmedi=mod(xmedi,boxxsize)
3354 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3355 ymedi=mod(ymedi,boxysize)
3356 if (ymedi.lt.0) ymedi=ymedi+boxysize
3357 zmedi=mod(zmedi,boxzsize)
3358 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3360 call eelecij(i,i+2,ees,evdw1,eel_loc)
3361 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3362 num_cont_hb(i)=num_conti
3364 do i=iturn4_start,iturn4_end
3366 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3367 C changes suggested by Ana to avoid out of bounds
3368 & .or.((i+5).gt.nres)
3370 C end of changes suggested by Ana
3371 & .or. itype(i+3).eq.ntyp1
3372 & .or. itype(i+4).eq.ntyp1
3373 & .or. itype(i+5).eq.ntyp1
3374 & .or. itype(i).eq.ntyp1
3375 & .or. itype(i-1).eq.ntyp1
3380 dx_normi=dc_norm(1,i)
3381 dy_normi=dc_norm(2,i)
3382 dz_normi=dc_norm(3,i)
3383 xmedi=c(1,i)+0.5d0*dxi
3384 ymedi=c(2,i)+0.5d0*dyi
3385 zmedi=c(3,i)+0.5d0*dzi
3386 C Return atom into box, boxxsize is size of box in x dimension
3388 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3389 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3390 C Condition for being inside the proper box
3391 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3392 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3396 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3397 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3398 C Condition for being inside the proper box
3399 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3400 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3404 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3405 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3406 C Condition for being inside the proper box
3407 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3408 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3411 xmedi=mod(xmedi,boxxsize)
3412 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3413 ymedi=mod(ymedi,boxysize)
3414 if (ymedi.lt.0) ymedi=ymedi+boxysize
3415 zmedi=mod(zmedi,boxzsize)
3416 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3418 num_conti=num_cont_hb(i)
3419 c write(iout,*) "JESTEM W PETLI"
3420 call eelecij(i,i+3,ees,evdw1,eel_loc)
3421 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3422 & call eturn4(i,eello_turn4)
3423 num_cont_hb(i)=num_conti
3425 C Loop over all neighbouring boxes
3430 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3432 do i=iatel_s,iatel_e
3434 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3435 C changes suggested by Ana to avoid out of bounds
3436 & .or.((i+2).gt.nres)
3438 C end of changes by Ana
3439 & .or. itype(i+2).eq.ntyp1
3440 & .or. itype(i-1).eq.ntyp1
3445 dx_normi=dc_norm(1,i)
3446 dy_normi=dc_norm(2,i)
3447 dz_normi=dc_norm(3,i)
3448 xmedi=c(1,i)+0.5d0*dxi
3449 ymedi=c(2,i)+0.5d0*dyi
3450 zmedi=c(3,i)+0.5d0*dzi
3451 xmedi=mod(xmedi,boxxsize)
3452 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3453 ymedi=mod(ymedi,boxysize)
3454 if (ymedi.lt.0) ymedi=ymedi+boxysize
3455 zmedi=mod(zmedi,boxzsize)
3456 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3457 C xmedi=xmedi+xshift*boxxsize
3458 C ymedi=ymedi+yshift*boxysize
3459 C zmedi=zmedi+zshift*boxzsize
3461 C Return tom into box, boxxsize is size of box in x dimension
3463 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3464 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3465 C Condition for being inside the proper box
3466 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3467 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3471 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3472 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3473 C Condition for being inside the proper box
3474 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3475 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3479 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3480 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3481 cC Condition for being inside the proper box
3482 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3483 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3487 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3488 num_conti=num_cont_hb(i)
3489 do j=ielstart(i),ielend(i)
3490 C write (iout,*) i,j
3492 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3493 C changes suggested by Ana to avoid out of bounds
3494 & .or.((j+2).gt.nres)
3496 C end of changes by Ana
3497 & .or.itype(j+2).eq.ntyp1
3498 & .or.itype(j-1).eq.ntyp1
3500 call eelecij(i,j,ees,evdw1,eel_loc)
3502 num_cont_hb(i)=num_conti
3508 c write (iout,*) "Number of loop steps in EELEC:",ind
3510 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3511 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3513 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3514 ccc eel_loc=eel_loc+eello_turn3
3515 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3518 C-------------------------------------------------------------------------------
3519 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3520 implicit real*8 (a-h,o-z)
3521 include 'DIMENSIONS'
3525 include 'COMMON.CONTROL'
3526 include 'COMMON.IOUNITS'
3527 include 'COMMON.GEO'
3528 include 'COMMON.VAR'
3529 include 'COMMON.LOCAL'
3530 include 'COMMON.CHAIN'
3531 include 'COMMON.DERIV'
3532 include 'COMMON.INTERACT'
3533 include 'COMMON.CONTACTS'
3534 include 'COMMON.TORSION'
3535 include 'COMMON.VECTORS'
3536 include 'COMMON.FFIELD'
3537 include 'COMMON.TIME1'
3538 include 'COMMON.SPLITELE'
3539 include 'COMMON.SHIELD'
3540 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3541 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3542 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3543 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3544 & gmuij2(4),gmuji2(4)
3545 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3546 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3548 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3550 double precision scal_el /1.0d0/
3552 double precision scal_el /0.5d0/
3555 C 13-go grudnia roku pamietnego...
3556 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3557 & 0.0d0,1.0d0,0.0d0,
3558 & 0.0d0,0.0d0,1.0d0/
3559 c time00=MPI_Wtime()
3560 cd write (iout,*) "eelecij",i,j
3564 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3565 aaa=app(iteli,itelj)
3566 bbb=bpp(iteli,itelj)
3567 ael6i=ael6(iteli,itelj)
3568 ael3i=ael3(iteli,itelj)
3572 dx_normj=dc_norm(1,j)
3573 dy_normj=dc_norm(2,j)
3574 dz_normj=dc_norm(3,j)
3575 C xj=c(1,j)+0.5D0*dxj-xmedi
3576 C yj=c(2,j)+0.5D0*dyj-ymedi
3577 C zj=c(3,j)+0.5D0*dzj-zmedi
3582 if (xj.lt.0) xj=xj+boxxsize
3584 if (yj.lt.0) yj=yj+boxysize
3586 if (zj.lt.0) zj=zj+boxzsize
3587 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3588 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3596 xj=xj_safe+xshift*boxxsize
3597 yj=yj_safe+yshift*boxysize
3598 zj=zj_safe+zshift*boxzsize
3599 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3600 if(dist_temp.lt.dist_init) then
3610 if (isubchap.eq.1) then
3619 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3621 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3622 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3623 C Condition for being inside the proper box
3624 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3625 c & (xj.lt.((-0.5d0)*boxxsize))) then
3629 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3630 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3631 C Condition for being inside the proper box
3632 c if ((yj.gt.((0.5d0)*boxysize)).or.
3633 c & (yj.lt.((-0.5d0)*boxysize))) then
3637 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3638 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3639 C Condition for being inside the proper box
3640 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3641 c & (zj.lt.((-0.5d0)*boxzsize))) then
3644 C endif !endPBC condintion
3648 rij=xj*xj+yj*yj+zj*zj
3650 sss=sscale(sqrt(rij))
3651 sssgrad=sscagrad(sqrt(rij))
3652 c if (sss.gt.0.0d0) then
3658 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3659 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3660 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3661 fac=cosa-3.0D0*cosb*cosg
3663 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3664 if (j.eq.i+2) ev1=scal_el*ev1
3669 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3673 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3674 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3675 if (shield_mode.gt.0) then
3676 ees=ees+eesij*fac_shield(i)*fac_shield(j)
3680 evdw1=evdw1+evdwij*sss
3681 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3682 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3683 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3684 cd & xmedi,ymedi,zmedi,xj,yj,zj
3686 if (energy_dec) then
3687 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3689 &,iteli,itelj,aaa,evdw1
3690 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3694 C Calculate contributions to the Cartesian gradient.
3697 facvdw=-6*rrmij*(ev1+evdwij)*sss
3698 facel=-3*rrmij*(el1+eesij)
3704 * Radial derivatives. First process both termini of the fragment (i,j)
3710 c ghalf=0.5D0*ggg(k)
3711 c gelc(k,i)=gelc(k,i)+ghalf
3712 c gelc(k,j)=gelc(k,j)+ghalf
3714 c 9/28/08 AL Gradient compotents will be summed only at the end
3716 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3717 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3720 * Loop over residues i+1 thru j-1.
3724 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3727 if (sss.gt.0.0) then
3728 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3729 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3730 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3737 c ghalf=0.5D0*ggg(k)
3738 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3739 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3741 c 9/28/08 AL Gradient compotents will be summed only at the end
3743 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3744 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3747 * Loop over residues i+1 thru j-1.
3751 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3756 facvdw=(ev1+evdwij)*sss
3759 fac=-3*rrmij*(facvdw+facvdw+facel)
3764 * Radial derivatives. First process both termini of the fragment (i,j)
3770 c ghalf=0.5D0*ggg(k)
3771 c gelc(k,i)=gelc(k,i)+ghalf
3772 c gelc(k,j)=gelc(k,j)+ghalf
3774 c 9/28/08 AL Gradient compotents will be summed only at the end
3776 gelc_long(k,j)=gelc(k,j)+ggg(k)
3777 gelc_long(k,i)=gelc(k,i)-ggg(k)
3780 * Loop over residues i+1 thru j-1.
3784 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3787 c 9/28/08 AL Gradient compotents will be summed only at the end
3788 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3789 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3790 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3792 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3793 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3799 ecosa=2.0D0*fac3*fac1+fac4
3802 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3803 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3805 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3806 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3808 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3809 cd & (dcosg(k),k=1,3)
3811 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3814 c ghalf=0.5D0*ggg(k)
3815 c gelc(k,i)=gelc(k,i)+ghalf
3816 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3817 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3818 c gelc(k,j)=gelc(k,j)+ghalf
3819 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3820 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3824 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3829 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3830 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3832 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3833 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3834 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3835 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3839 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3840 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3841 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3843 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3844 C energy of a peptide unit is assumed in the form of a second-order
3845 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3846 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3847 C are computed for EVERY pair of non-contiguous peptide groups.
3850 if (j.lt.nres-1) then
3862 muij(kkk)=mu(k,i)*mu(l,j)
3863 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3865 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3866 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3867 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3868 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3869 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3870 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3874 cd write (iout,*) 'EELEC: i',i,' j',j
3875 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3876 cd write(iout,*) 'muij',muij
3877 ury=scalar(uy(1,i),erij)
3878 urz=scalar(uz(1,i),erij)
3879 vry=scalar(uy(1,j),erij)
3880 vrz=scalar(uz(1,j),erij)
3881 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3882 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3883 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3884 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3885 fac=dsqrt(-ael6i)*r3ij
3890 cd write (iout,'(4i5,4f10.5)')
3891 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3892 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3893 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3894 cd & uy(:,j),uz(:,j)
3895 cd write (iout,'(4f10.5)')
3896 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3897 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3898 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3899 cd write (iout,'(9f10.5/)')
3900 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3901 C Derivatives of the elements of A in virtual-bond vectors
3902 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3904 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3905 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3906 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3907 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3908 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3909 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3910 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3911 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3912 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3913 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3914 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3915 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3917 C Compute radial contributions to the gradient
3935 C Add the contributions coming from er
3938 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3939 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3940 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3941 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3944 C Derivatives in DC(i)
3945 cgrad ghalf1=0.5d0*agg(k,1)
3946 cgrad ghalf2=0.5d0*agg(k,2)
3947 cgrad ghalf3=0.5d0*agg(k,3)
3948 cgrad ghalf4=0.5d0*agg(k,4)
3949 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3950 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3951 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3952 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3953 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3954 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3955 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3956 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3957 C Derivatives in DC(i+1)
3958 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3959 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3960 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3961 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3962 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3963 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3964 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3965 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3966 C Derivatives in DC(j)
3967 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3968 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3969 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3970 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3971 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3972 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3973 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3974 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3975 C Derivatives in DC(j+1) or DC(nres-1)
3976 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3977 & -3.0d0*vryg(k,3)*ury)
3978 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3979 & -3.0d0*vrzg(k,3)*ury)
3980 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3981 & -3.0d0*vryg(k,3)*urz)
3982 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3983 & -3.0d0*vrzg(k,3)*urz)
3984 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3986 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3999 aggi(k,l)=-aggi(k,l)
4000 aggi1(k,l)=-aggi1(k,l)
4001 aggj(k,l)=-aggj(k,l)
4002 aggj1(k,l)=-aggj1(k,l)
4005 if (j.lt.nres-1) then
4011 aggi(k,l)=-aggi(k,l)
4012 aggi1(k,l)=-aggi1(k,l)
4013 aggj(k,l)=-aggj(k,l)
4014 aggj1(k,l)=-aggj1(k,l)
4025 aggi(k,l)=-aggi(k,l)
4026 aggi1(k,l)=-aggi1(k,l)
4027 aggj(k,l)=-aggj(k,l)
4028 aggj1(k,l)=-aggj1(k,l)
4033 IF (wel_loc.gt.0.0d0) THEN
4034 C Contribution to the local-electrostatic energy coming from the i-j pair
4035 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4037 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4038 c & ' eel_loc_ij',eel_loc_ij
4039 c write(iout,*) 'muije=',muij(1),muij(2),muij(3),muij(4)
4040 C Calculate patrial derivative for theta angle
4042 geel_loc_ij=a22*gmuij1(1)
4046 c write(iout,*) "derivative over thatai"
4047 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4049 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4050 & geel_loc_ij*wel_loc
4051 c write(iout,*) "derivative over thatai-1"
4052 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4059 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4060 & geel_loc_ij*wel_loc
4061 c Derivative over j residue
4062 geel_loc_ji=a22*gmuji1(1)
4066 c write(iout,*) "derivative over thataj"
4067 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4070 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4071 & geel_loc_ji*wel_loc
4077 c write(iout,*) "derivative over thataj-1"
4078 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4080 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4081 & geel_loc_ji*wel_loc
4083 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4085 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4086 & 'eelloc',i,j,eel_loc_ij
4087 c if (eel_loc_ij.ne.0)
4088 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4089 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4091 eel_loc=eel_loc+eel_loc_ij
4092 C Partial derivatives in virtual-bond dihedral angles gamma
4094 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4095 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4096 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
4097 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4098 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4099 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
4100 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4102 ggg(l)=agg(l,1)*muij(1)+
4103 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
4104 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4105 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4106 cgrad ghalf=0.5d0*ggg(l)
4107 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4108 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4112 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4115 C Remaining derivatives of eello
4117 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4118 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4119 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4120 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4121 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4122 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4123 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4124 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4127 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4128 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4129 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4130 & .and. num_conti.le.maxconts) then
4131 c write (iout,*) i,j," entered corr"
4133 C Calculate the contact function. The ith column of the array JCONT will
4134 C contain the numbers of atoms that make contacts with the atom I (of numbers
4135 C greater than I). The arrays FACONT and GACONT will contain the values of
4136 C the contact function and its derivative.
4137 c r0ij=1.02D0*rpp(iteli,itelj)
4138 c r0ij=1.11D0*rpp(iteli,itelj)
4139 r0ij=2.20D0*rpp(iteli,itelj)
4140 c r0ij=1.55D0*rpp(iteli,itelj)
4141 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4142 if (fcont.gt.0.0D0) then
4143 num_conti=num_conti+1
4144 if (num_conti.gt.maxconts) then
4145 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4146 & ' will skip next contacts for this conf.'
4148 jcont_hb(num_conti,i)=j
4149 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4150 cd & " jcont_hb",jcont_hb(num_conti,i)
4151 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4152 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4153 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4155 d_cont(num_conti,i)=rij
4156 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4157 C --- Electrostatic-interaction matrix ---
4158 a_chuj(1,1,num_conti,i)=a22
4159 a_chuj(1,2,num_conti,i)=a23
4160 a_chuj(2,1,num_conti,i)=a32
4161 a_chuj(2,2,num_conti,i)=a33
4162 C --- Gradient of rij
4164 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4171 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4172 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4173 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4174 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4175 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4180 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4181 C Calculate contact energies
4183 wij=cosa-3.0D0*cosb*cosg
4186 c fac3=dsqrt(-ael6i)/r0ij**3
4187 fac3=dsqrt(-ael6i)*r3ij
4188 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4189 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4190 if (ees0tmp.gt.0) then
4191 ees0pij=dsqrt(ees0tmp)
4195 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4196 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4197 if (ees0tmp.gt.0) then
4198 ees0mij=dsqrt(ees0tmp)
4203 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4204 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4205 C Diagnostics. Comment out or remove after debugging!
4206 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4207 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4208 c ees0m(num_conti,i)=0.0D0
4210 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4211 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4212 C Angular derivatives of the contact function
4213 ees0pij1=fac3/ees0pij
4214 ees0mij1=fac3/ees0mij
4215 fac3p=-3.0D0*fac3*rrmij
4216 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4217 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4219 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4220 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4221 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4222 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4223 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4224 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4225 ecosap=ecosa1+ecosa2
4226 ecosbp=ecosb1+ecosb2
4227 ecosgp=ecosg1+ecosg2
4228 ecosam=ecosa1-ecosa2
4229 ecosbm=ecosb1-ecosb2
4230 ecosgm=ecosg1-ecosg2
4239 facont_hb(num_conti,i)=fcont
4240 fprimcont=fprimcont/rij
4241 cd facont_hb(num_conti,i)=1.0D0
4242 C Following line is for diagnostics.
4245 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4246 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4249 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4250 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4252 gggp(1)=gggp(1)+ees0pijp*xj
4253 gggp(2)=gggp(2)+ees0pijp*yj
4254 gggp(3)=gggp(3)+ees0pijp*zj
4255 gggm(1)=gggm(1)+ees0mijp*xj
4256 gggm(2)=gggm(2)+ees0mijp*yj
4257 gggm(3)=gggm(3)+ees0mijp*zj
4258 C Derivatives due to the contact function
4259 gacont_hbr(1,num_conti,i)=fprimcont*xj
4260 gacont_hbr(2,num_conti,i)=fprimcont*yj
4261 gacont_hbr(3,num_conti,i)=fprimcont*zj
4264 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4265 c following the change of gradient-summation algorithm.
4267 cgrad ghalfp=0.5D0*gggp(k)
4268 cgrad ghalfm=0.5D0*gggm(k)
4269 gacontp_hb1(k,num_conti,i)=!ghalfp
4270 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4271 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4272 gacontp_hb2(k,num_conti,i)=!ghalfp
4273 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4274 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4275 gacontp_hb3(k,num_conti,i)=gggp(k)
4276 gacontm_hb1(k,num_conti,i)=!ghalfm
4277 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4278 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4279 gacontm_hb2(k,num_conti,i)=!ghalfm
4280 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4281 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4282 gacontm_hb3(k,num_conti,i)=gggm(k)
4284 C Diagnostics. Comment out or remove after debugging!
4286 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4287 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4288 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4289 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4290 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4291 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4294 endif ! num_conti.le.maxconts
4297 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4300 ghalf=0.5d0*agg(l,k)
4301 aggi(l,k)=aggi(l,k)+ghalf
4302 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4303 aggj(l,k)=aggj(l,k)+ghalf
4306 if (j.eq.nres-1 .and. i.lt.j-2) then
4309 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4314 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4317 C-----------------------------------------------------------------------------
4318 subroutine eturn3(i,eello_turn3)
4319 C Third- and fourth-order contributions from turns
4320 implicit real*8 (a-h,o-z)
4321 include 'DIMENSIONS'
4322 include 'COMMON.IOUNITS'
4323 include 'COMMON.GEO'
4324 include 'COMMON.VAR'
4325 include 'COMMON.LOCAL'
4326 include 'COMMON.CHAIN'
4327 include 'COMMON.DERIV'
4328 include 'COMMON.INTERACT'
4329 include 'COMMON.CONTACTS'
4330 include 'COMMON.TORSION'
4331 include 'COMMON.VECTORS'
4332 include 'COMMON.FFIELD'
4333 include 'COMMON.CONTROL'
4335 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4336 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4337 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4338 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4339 & auxgmat2(2,2),auxgmatt2(2,2)
4340 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4341 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4342 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4343 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4346 c write (iout,*) "eturn3",i,j,j1,j2
4351 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4353 C Third-order contributions
4360 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4361 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4362 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4363 c auxalary matices for theta gradient
4364 c auxalary matrix for i+1 and constant i+2
4365 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4366 c auxalary matrix for i+2 and constant i+1
4367 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4368 call transpose2(auxmat(1,1),auxmat1(1,1))
4369 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4370 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4371 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4372 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4373 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4374 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4375 C Derivatives in theta
4376 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4377 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4378 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4379 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4381 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4382 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4383 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4384 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4385 cd & ' eello_turn3_num',4*eello_turn3_num
4386 C Derivatives in gamma(i)
4387 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4388 call transpose2(auxmat2(1,1),auxmat3(1,1))
4389 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4390 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4391 C Derivatives in gamma(i+1)
4392 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4393 call transpose2(auxmat2(1,1),auxmat3(1,1))
4394 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4395 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4396 & +0.5d0*(pizda(1,1)+pizda(2,2))
4397 C Cartesian derivatives
4399 c ghalf1=0.5d0*agg(l,1)
4400 c ghalf2=0.5d0*agg(l,2)
4401 c ghalf3=0.5d0*agg(l,3)
4402 c ghalf4=0.5d0*agg(l,4)
4403 a_temp(1,1)=aggi(l,1)!+ghalf1
4404 a_temp(1,2)=aggi(l,2)!+ghalf2
4405 a_temp(2,1)=aggi(l,3)!+ghalf3
4406 a_temp(2,2)=aggi(l,4)!+ghalf4
4407 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4408 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4409 & +0.5d0*(pizda(1,1)+pizda(2,2))
4410 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4411 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4412 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4413 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4414 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4415 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4416 & +0.5d0*(pizda(1,1)+pizda(2,2))
4417 a_temp(1,1)=aggj(l,1)!+ghalf1
4418 a_temp(1,2)=aggj(l,2)!+ghalf2
4419 a_temp(2,1)=aggj(l,3)!+ghalf3
4420 a_temp(2,2)=aggj(l,4)!+ghalf4
4421 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4422 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4423 & +0.5d0*(pizda(1,1)+pizda(2,2))
4424 a_temp(1,1)=aggj1(l,1)
4425 a_temp(1,2)=aggj1(l,2)
4426 a_temp(2,1)=aggj1(l,3)
4427 a_temp(2,2)=aggj1(l,4)
4428 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4429 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4430 & +0.5d0*(pizda(1,1)+pizda(2,2))
4434 C-------------------------------------------------------------------------------
4435 subroutine eturn4(i,eello_turn4)
4436 C Third- and fourth-order contributions from turns
4437 implicit real*8 (a-h,o-z)
4438 include 'DIMENSIONS'
4439 include 'COMMON.IOUNITS'
4440 include 'COMMON.GEO'
4441 include 'COMMON.VAR'
4442 include 'COMMON.LOCAL'
4443 include 'COMMON.CHAIN'
4444 include 'COMMON.DERIV'
4445 include 'COMMON.INTERACT'
4446 include 'COMMON.CONTACTS'
4447 include 'COMMON.TORSION'
4448 include 'COMMON.VECTORS'
4449 include 'COMMON.FFIELD'
4450 include 'COMMON.CONTROL'
4452 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4453 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4454 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4455 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4456 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4457 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4458 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4459 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4460 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4461 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4462 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4465 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4467 C Fourth-order contributions
4475 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4476 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4477 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4478 c write(iout,*)"WCHODZE W PROGRAM"
4483 iti1=itortyp(itype(i+1))
4484 iti2=itortyp(itype(i+2))
4485 iti3=itortyp(itype(i+3))
4486 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4487 call transpose2(EUg(1,1,i+1),e1t(1,1))
4488 call transpose2(Eug(1,1,i+2),e2t(1,1))
4489 call transpose2(Eug(1,1,i+3),e3t(1,1))
4490 C Ematrix derivative in theta
4491 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4492 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4493 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4494 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4495 c eta1 in derivative theta
4496 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4497 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4498 c auxgvec is derivative of Ub2 so i+3 theta
4499 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4500 c auxalary matrix of E i+1
4501 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4504 s1=scalar2(b1(1,i+2),auxvec(1))
4505 c derivative of theta i+2 with constant i+3
4506 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4507 c derivative of theta i+2 with constant i+2
4508 gs32=scalar2(b1(1,i+2),auxgvec(1))
4509 c derivative of E matix in theta of i+1
4510 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4512 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4513 c ea31 in derivative theta
4514 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4515 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4516 c auxilary matrix auxgvec of Ub2 with constant E matirx
4517 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4518 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4519 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4523 s2=scalar2(b1(1,i+1),auxvec(1))
4524 c derivative of theta i+1 with constant i+3
4525 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4526 c derivative of theta i+2 with constant i+1
4527 gs21=scalar2(b1(1,i+1),auxgvec(1))
4528 c derivative of theta i+3 with constant i+1
4529 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4530 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4532 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4533 c two derivatives over diffetent matrices
4534 c gtae3e2 is derivative over i+3
4535 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4536 c ae3gte2 is derivative over i+2
4537 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4538 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4539 c three possible derivative over theta E matices
4541 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4543 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4545 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4546 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4548 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4549 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4550 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4552 eello_turn4=eello_turn4-(s1+s2+s3)
4553 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4554 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4555 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4556 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4557 cd & ' eello_turn4_num',8*eello_turn4_num
4559 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4560 & -(gs13+gsE13+gsEE1)*wturn4
4561 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4562 & -(gs23+gs21+gsEE2)*wturn4
4563 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4564 & -(gs32+gsE31+gsEE3)*wturn4
4565 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4568 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4569 & 'eturn4',i,j,-(s1+s2+s3)
4570 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4571 c & ' eello_turn4_num',8*eello_turn4_num
4572 C Derivatives in gamma(i)
4573 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4574 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4575 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4576 s1=scalar2(b1(1,i+2),auxvec(1))
4577 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4578 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4579 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4580 C Derivatives in gamma(i+1)
4581 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4582 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4583 s2=scalar2(b1(1,i+1),auxvec(1))
4584 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4585 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4586 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4587 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4588 C Derivatives in gamma(i+2)
4589 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4590 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4591 s1=scalar2(b1(1,i+2),auxvec(1))
4592 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4593 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4594 s2=scalar2(b1(1,i+1),auxvec(1))
4595 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4596 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4597 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4598 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4599 C Cartesian derivatives
4600 C Derivatives of this turn contributions in DC(i+2)
4601 if (j.lt.nres-1) then
4603 a_temp(1,1)=agg(l,1)
4604 a_temp(1,2)=agg(l,2)
4605 a_temp(2,1)=agg(l,3)
4606 a_temp(2,2)=agg(l,4)
4607 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4608 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4609 s1=scalar2(b1(1,i+2),auxvec(1))
4610 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4611 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4612 s2=scalar2(b1(1,i+1),auxvec(1))
4613 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4614 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4615 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4617 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4620 C Remaining derivatives of this turn contribution
4622 a_temp(1,1)=aggi(l,1)
4623 a_temp(1,2)=aggi(l,2)
4624 a_temp(2,1)=aggi(l,3)
4625 a_temp(2,2)=aggi(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 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4636 a_temp(1,1)=aggi1(l,1)
4637 a_temp(1,2)=aggi1(l,2)
4638 a_temp(2,1)=aggi1(l,3)
4639 a_temp(2,2)=aggi1(l,4)
4640 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4641 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4642 s1=scalar2(b1(1,i+2),auxvec(1))
4643 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4644 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4645 s2=scalar2(b1(1,i+1),auxvec(1))
4646 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4647 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4648 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4649 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4650 a_temp(1,1)=aggj(l,1)
4651 a_temp(1,2)=aggj(l,2)
4652 a_temp(2,1)=aggj(l,3)
4653 a_temp(2,2)=aggj(l,4)
4654 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4655 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4656 s1=scalar2(b1(1,i+2),auxvec(1))
4657 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4658 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4659 s2=scalar2(b1(1,i+1),auxvec(1))
4660 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4661 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4662 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4663 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4664 a_temp(1,1)=aggj1(l,1)
4665 a_temp(1,2)=aggj1(l,2)
4666 a_temp(2,1)=aggj1(l,3)
4667 a_temp(2,2)=aggj1(l,4)
4668 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4669 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4670 s1=scalar2(b1(1,i+2),auxvec(1))
4671 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4672 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4673 s2=scalar2(b1(1,i+1),auxvec(1))
4674 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4675 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4676 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4677 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4678 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4682 C-----------------------------------------------------------------------------
4683 subroutine vecpr(u,v,w)
4684 implicit real*8(a-h,o-z)
4685 dimension u(3),v(3),w(3)
4686 w(1)=u(2)*v(3)-u(3)*v(2)
4687 w(2)=-u(1)*v(3)+u(3)*v(1)
4688 w(3)=u(1)*v(2)-u(2)*v(1)
4691 C-----------------------------------------------------------------------------
4692 subroutine unormderiv(u,ugrad,unorm,ungrad)
4693 C This subroutine computes the derivatives of a normalized vector u, given
4694 C the derivatives computed without normalization conditions, ugrad. Returns
4697 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4698 double precision vec(3)
4699 double precision scalar
4701 c write (2,*) 'ugrad',ugrad
4704 vec(i)=scalar(ugrad(1,i),u(1))
4706 c write (2,*) 'vec',vec
4709 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4712 c write (2,*) 'ungrad',ungrad
4715 C-----------------------------------------------------------------------------
4716 subroutine escp_soft_sphere(evdw2,evdw2_14)
4718 C This subroutine calculates the excluded-volume interaction energy between
4719 C peptide-group centers and side chains and its gradient in virtual-bond and
4720 C side-chain vectors.
4722 implicit real*8 (a-h,o-z)
4723 include 'DIMENSIONS'
4724 include 'COMMON.GEO'
4725 include 'COMMON.VAR'
4726 include 'COMMON.LOCAL'
4727 include 'COMMON.CHAIN'
4728 include 'COMMON.DERIV'
4729 include 'COMMON.INTERACT'
4730 include 'COMMON.FFIELD'
4731 include 'COMMON.IOUNITS'
4732 include 'COMMON.CONTROL'
4737 cd print '(a)','Enter ESCP'
4738 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4742 do i=iatscp_s,iatscp_e
4743 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4745 xi=0.5D0*(c(1,i)+c(1,i+1))
4746 yi=0.5D0*(c(2,i)+c(2,i+1))
4747 zi=0.5D0*(c(3,i)+c(3,i+1))
4748 C Return atom into box, boxxsize is size of box in x dimension
4750 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4751 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4752 C Condition for being inside the proper box
4753 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4754 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4758 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4759 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4760 C Condition for being inside the proper box
4761 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4762 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4766 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4767 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4768 cC Condition for being inside the proper box
4769 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4770 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4774 if (xi.lt.0) xi=xi+boxxsize
4776 if (yi.lt.0) yi=yi+boxysize
4778 if (zi.lt.0) zi=zi+boxzsize
4779 C xi=xi+xshift*boxxsize
4780 C yi=yi+yshift*boxysize
4781 C zi=zi+zshift*boxzsize
4782 do iint=1,nscp_gr(i)
4784 do j=iscpstart(i,iint),iscpend(i,iint)
4785 if (itype(j).eq.ntyp1) cycle
4786 itypj=iabs(itype(j))
4787 C Uncomment following three lines for SC-p interactions
4791 C Uncomment following three lines for Ca-p interactions
4796 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4797 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4798 C Condition for being inside the proper box
4799 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4800 c & (xj.lt.((-0.5d0)*boxxsize))) then
4804 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4805 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4806 cC Condition for being inside the proper box
4807 c if ((yj.gt.((0.5d0)*boxysize)).or.
4808 c & (yj.lt.((-0.5d0)*boxysize))) then
4812 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4813 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4814 C Condition for being inside the proper box
4815 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4816 c & (zj.lt.((-0.5d0)*boxzsize))) then
4819 if (xj.lt.0) xj=xj+boxxsize
4821 if (yj.lt.0) yj=yj+boxysize
4823 if (zj.lt.0) zj=zj+boxzsize
4824 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4832 xj=xj_safe+xshift*boxxsize
4833 yj=yj_safe+yshift*boxysize
4834 zj=zj_safe+zshift*boxzsize
4835 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4836 if(dist_temp.lt.dist_init) then
4846 if (subchap.eq.1) then
4859 rij=xj*xj+yj*yj+zj*zj
4863 if (rij.lt.r0ijsq) then
4864 evdwij=0.25d0*(rij-r0ijsq)**2
4872 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4877 cgrad if (j.lt.i) then
4878 cd write (iout,*) 'j<i'
4879 C Uncomment following three lines for SC-p interactions
4881 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4884 cd write (iout,*) 'j>i'
4886 cgrad ggg(k)=-ggg(k)
4887 C Uncomment following line for SC-p interactions
4888 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4892 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4894 cgrad kstart=min0(i+1,j)
4895 cgrad kend=max0(i-1,j-1)
4896 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4897 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4898 cgrad do k=kstart,kend
4900 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4904 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4905 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4916 C-----------------------------------------------------------------------------
4917 subroutine escp(evdw2,evdw2_14)
4919 C This subroutine calculates the excluded-volume interaction energy between
4920 C peptide-group centers and side chains and its gradient in virtual-bond and
4921 C side-chain vectors.
4923 implicit real*8 (a-h,o-z)
4924 include 'DIMENSIONS'
4925 include 'COMMON.GEO'
4926 include 'COMMON.VAR'
4927 include 'COMMON.LOCAL'
4928 include 'COMMON.CHAIN'
4929 include 'COMMON.DERIV'
4930 include 'COMMON.INTERACT'
4931 include 'COMMON.FFIELD'
4932 include 'COMMON.IOUNITS'
4933 include 'COMMON.CONTROL'
4934 include 'COMMON.SPLITELE'
4938 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4939 cd print '(a)','Enter ESCP'
4940 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4944 do i=iatscp_s,iatscp_e
4945 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4947 xi=0.5D0*(c(1,i)+c(1,i+1))
4948 yi=0.5D0*(c(2,i)+c(2,i+1))
4949 zi=0.5D0*(c(3,i)+c(3,i+1))
4951 if (xi.lt.0) xi=xi+boxxsize
4953 if (yi.lt.0) yi=yi+boxysize
4955 if (zi.lt.0) zi=zi+boxzsize
4956 c xi=xi+xshift*boxxsize
4957 c yi=yi+yshift*boxysize
4958 c zi=zi+zshift*boxzsize
4959 c print *,xi,yi,zi,'polozenie i'
4960 C Return atom into box, boxxsize is size of box in x dimension
4962 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4963 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4964 C Condition for being inside the proper box
4965 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4966 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4970 c print *,xi,boxxsize,"pierwszy"
4972 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4973 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4974 C Condition for being inside the proper box
4975 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4976 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4980 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4981 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4982 C Condition for being inside the proper box
4983 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4984 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4987 do iint=1,nscp_gr(i)
4989 do j=iscpstart(i,iint),iscpend(i,iint)
4990 itypj=iabs(itype(j))
4991 if (itypj.eq.ntyp1) cycle
4992 C Uncomment following three lines for SC-p interactions
4996 C Uncomment following three lines for Ca-p interactions
5001 if (xj.lt.0) xj=xj+boxxsize
5003 if (yj.lt.0) yj=yj+boxysize
5005 if (zj.lt.0) zj=zj+boxzsize
5007 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5008 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5009 C Condition for being inside the proper box
5010 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5011 c & (xj.lt.((-0.5d0)*boxxsize))) then
5015 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5016 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5017 cC Condition for being inside the proper box
5018 c if ((yj.gt.((0.5d0)*boxysize)).or.
5019 c & (yj.lt.((-0.5d0)*boxysize))) then
5023 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5024 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5025 C Condition for being inside the proper box
5026 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5027 c & (zj.lt.((-0.5d0)*boxzsize))) then
5030 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5031 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5039 xj=xj_safe+xshift*boxxsize
5040 yj=yj_safe+yshift*boxysize
5041 zj=zj_safe+zshift*boxzsize
5042 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5043 if(dist_temp.lt.dist_init) then
5053 if (subchap.eq.1) then
5062 c print *,xj,yj,zj,'polozenie j'
5063 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5065 sss=sscale(1.0d0/(dsqrt(rrij)))
5066 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5067 c if (sss.eq.0) print *,'czasem jest OK'
5068 if (sss.le.0.0d0) cycle
5069 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5071 e1=fac*fac*aad(itypj,iteli)
5072 e2=fac*bad(itypj,iteli)
5073 if (iabs(j-i) .le. 2) then
5076 evdw2_14=evdw2_14+(e1+e2)*sss
5079 evdw2=evdw2+evdwij*sss
5080 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5081 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5084 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5086 fac=-(evdwij+e1)*rrij*sss
5087 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5091 cgrad if (j.lt.i) then
5092 cd write (iout,*) 'j<i'
5093 C Uncomment following three lines for SC-p interactions
5095 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5098 cd write (iout,*) 'j>i'
5100 cgrad ggg(k)=-ggg(k)
5101 C Uncomment following line for SC-p interactions
5102 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5103 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5107 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5109 cgrad kstart=min0(i+1,j)
5110 cgrad kend=max0(i-1,j-1)
5111 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5112 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5113 cgrad do k=kstart,kend
5115 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5119 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5120 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5122 c endif !endif for sscale cutoff
5132 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5133 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5134 gradx_scp(j,i)=expon*gradx_scp(j,i)
5137 C******************************************************************************
5141 C To save time the factor EXPON has been extracted from ALL components
5142 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5145 C******************************************************************************
5148 C--------------------------------------------------------------------------
5149 subroutine edis(ehpb)
5151 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5153 implicit real*8 (a-h,o-z)
5154 include 'DIMENSIONS'
5155 include 'COMMON.SBRIDGE'
5156 include 'COMMON.CHAIN'
5157 include 'COMMON.DERIV'
5158 include 'COMMON.VAR'
5159 include 'COMMON.INTERACT'
5160 include 'COMMON.IOUNITS'
5161 include 'COMMON.CONTROL'
5167 C write (iout,*) ,"link_end",link_end,constr_dist
5168 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5169 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5170 if (link_end.eq.0) return
5171 do i=link_start,link_end
5172 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5173 C CA-CA distance used in regularization of structure.
5176 C iii and jjj point to the residues for which the distance is assigned.
5177 if (ii.gt.nres) then
5184 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5185 c & dhpb(i),dhpb1(i),forcon(i)
5186 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5187 C distance and angle dependent SS bond potential.
5188 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5189 C & iabs(itype(jjj)).eq.1) then
5190 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5191 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5192 if (.not.dyn_ss .and. i.le.nss) then
5193 C 15/02/13 CC dynamic SSbond - additional check
5194 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5195 & iabs(itype(jjj)).eq.1) then
5196 call ssbond_ene(iii,jjj,eij)
5199 cd write (iout,*) "eij",eij
5200 cd & ' waga=',waga,' fac=',fac
5201 else if (ii.gt.nres .and. jj.gt.nres) then
5202 c Restraints from contact prediction
5204 if (constr_dist.eq.11) then
5205 ehpb=ehpb+fordepth(i)**4.0d0
5206 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5207 fac=fordepth(i)**4.0d0
5208 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5209 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5210 & ehpb,fordepth(i),dd
5212 if (dhpb1(i).gt.0.0d0) then
5213 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5214 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5215 c write (iout,*) "beta nmr",
5216 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5220 C Get the force constant corresponding to this distance.
5222 C Calculate the contribution to energy.
5223 ehpb=ehpb+waga*rdis*rdis
5224 c write (iout,*) "beta reg",dd,waga*rdis*rdis
5226 C Evaluate gradient.
5232 ggg(j)=fac*(c(j,jj)-c(j,ii))
5235 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5236 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5239 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5240 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5243 C Calculate the distance between the two points and its difference from the
5246 if (constr_dist.eq.11) then
5247 ehpb=ehpb+fordepth(i)**4.0d0
5248 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5249 fac=fordepth(i)**4.0d0
5250 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5251 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5252 & ehpb,fordepth(i),dd
5254 if (dhpb1(i).gt.0.0d0) then
5255 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5256 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5257 c write (iout,*) "alph nmr",
5258 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5261 C Get the force constant corresponding to this distance.
5263 C Calculate the contribution to energy.
5264 ehpb=ehpb+waga*rdis*rdis
5265 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5267 C Evaluate gradient.
5273 ggg(j)=fac*(c(j,jj)-c(j,ii))
5275 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5276 C If this is a SC-SC distance, we need to calculate the contributions to the
5277 C Cartesian gradient in the SC vectors (ghpbx).
5280 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5281 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5284 cgrad do j=iii,jjj-1
5286 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5290 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5291 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5295 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5298 C--------------------------------------------------------------------------
5299 subroutine ssbond_ene(i,j,eij)
5301 C Calculate the distance and angle dependent SS-bond potential energy
5302 C using a free-energy function derived based on RHF/6-31G** ab initio
5303 C calculations of diethyl disulfide.
5305 C A. Liwo and U. Kozlowska, 11/24/03
5307 implicit real*8 (a-h,o-z)
5308 include 'DIMENSIONS'
5309 include 'COMMON.SBRIDGE'
5310 include 'COMMON.CHAIN'
5311 include 'COMMON.DERIV'
5312 include 'COMMON.LOCAL'
5313 include 'COMMON.INTERACT'
5314 include 'COMMON.VAR'
5315 include 'COMMON.IOUNITS'
5316 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5317 itypi=iabs(itype(i))
5321 dxi=dc_norm(1,nres+i)
5322 dyi=dc_norm(2,nres+i)
5323 dzi=dc_norm(3,nres+i)
5324 c dsci_inv=dsc_inv(itypi)
5325 dsci_inv=vbld_inv(nres+i)
5326 itypj=iabs(itype(j))
5327 c dscj_inv=dsc_inv(itypj)
5328 dscj_inv=vbld_inv(nres+j)
5332 dxj=dc_norm(1,nres+j)
5333 dyj=dc_norm(2,nres+j)
5334 dzj=dc_norm(3,nres+j)
5335 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5340 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5341 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5342 om12=dxi*dxj+dyi*dyj+dzi*dzj
5344 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5345 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5351 deltat12=om2-om1+2.0d0
5353 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5354 & +akct*deltad*deltat12
5355 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5356 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5357 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5358 c & " deltat12",deltat12," eij",eij
5359 ed=2*akcm*deltad+akct*deltat12
5361 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5362 eom1=-2*akth*deltat1-pom1-om2*pom2
5363 eom2= 2*akth*deltat2+pom1-om1*pom2
5366 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5367 ghpbx(k,i)=ghpbx(k,i)-ggk
5368 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5369 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5370 ghpbx(k,j)=ghpbx(k,j)+ggk
5371 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5372 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5373 ghpbc(k,i)=ghpbc(k,i)-ggk
5374 ghpbc(k,j)=ghpbc(k,j)+ggk
5377 C Calculate the components of the gradient in DC and X
5381 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5386 C--------------------------------------------------------------------------
5387 subroutine ebond(estr)
5389 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5391 implicit real*8 (a-h,o-z)
5392 include 'DIMENSIONS'
5393 include 'COMMON.LOCAL'
5394 include 'COMMON.GEO'
5395 include 'COMMON.INTERACT'
5396 include 'COMMON.DERIV'
5397 include 'COMMON.VAR'
5398 include 'COMMON.CHAIN'
5399 include 'COMMON.IOUNITS'
5400 include 'COMMON.NAMES'
5401 include 'COMMON.FFIELD'
5402 include 'COMMON.CONTROL'
5403 include 'COMMON.SETUP'
5404 double precision u(3),ud(3)
5407 do i=ibondp_start,ibondp_end
5408 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5409 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5411 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5412 c & *dc(j,i-1)/vbld(i)
5414 c if (energy_dec) write(iout,*)
5415 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5417 C Checking if it involves dummy (NH3+ or COO-) group
5418 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5419 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5420 diff = vbld(i)-vbldpDUM
5422 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5423 diff = vbld(i)-vbldp0
5425 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5426 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5429 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5431 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5434 estr=0.5d0*AKP*estr+estr1
5436 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5438 do i=ibond_start,ibond_end
5440 if (iti.ne.10 .and. iti.ne.ntyp1) then
5443 diff=vbld(i+nres)-vbldsc0(1,iti)
5444 if (energy_dec) write (iout,*)
5445 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5446 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5447 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5449 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5453 diff=vbld(i+nres)-vbldsc0(j,iti)
5454 ud(j)=aksc(j,iti)*diff
5455 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5469 uprod2=uprod2*u(k)*u(k)
5473 usumsqder=usumsqder+ud(j)*uprod2
5475 estr=estr+uprod/usum
5477 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5485 C--------------------------------------------------------------------------
5486 subroutine ebend(etheta,ethetacnstr)
5488 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5489 C angles gamma and its derivatives in consecutive thetas and gammas.
5491 implicit real*8 (a-h,o-z)
5492 include 'DIMENSIONS'
5493 include 'COMMON.LOCAL'
5494 include 'COMMON.GEO'
5495 include 'COMMON.INTERACT'
5496 include 'COMMON.DERIV'
5497 include 'COMMON.VAR'
5498 include 'COMMON.CHAIN'
5499 include 'COMMON.IOUNITS'
5500 include 'COMMON.NAMES'
5501 include 'COMMON.FFIELD'
5502 include 'COMMON.CONTROL'
5503 include 'COMMON.TORCNSTR'
5504 common /calcthet/ term1,term2,termm,diffak,ratak,
5505 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5506 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5507 double precision y(2),z(2)
5509 c time11=dexp(-2*time)
5512 c write (*,'(a,i2)') 'EBEND ICG=',icg
5513 do i=ithet_start,ithet_end
5514 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5515 & .or.itype(i).eq.ntyp1) cycle
5516 C Zero the energy function and its derivative at 0 or pi.
5517 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5519 ichir1=isign(1,itype(i-2))
5520 ichir2=isign(1,itype(i))
5521 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5522 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5523 if (itype(i-1).eq.10) then
5524 itype1=isign(10,itype(i-2))
5525 ichir11=isign(1,itype(i-2))
5526 ichir12=isign(1,itype(i-2))
5527 itype2=isign(10,itype(i))
5528 ichir21=isign(1,itype(i))
5529 ichir22=isign(1,itype(i))
5532 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5535 if (phii.ne.phii) phii=150.0
5545 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5548 if (phii1.ne.phii1) phii1=150.0
5560 C Calculate the "mean" value of theta from the part of the distribution
5561 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5562 C In following comments this theta will be referred to as t_c.
5563 thet_pred_mean=0.0d0
5565 athetk=athet(k,it,ichir1,ichir2)
5566 bthetk=bthet(k,it,ichir1,ichir2)
5568 athetk=athet(k,itype1,ichir11,ichir12)
5569 bthetk=bthet(k,itype2,ichir21,ichir22)
5571 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5572 c write(iout,*) 'chuj tu', y(k),z(k)
5574 dthett=thet_pred_mean*ssd
5575 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5576 C Derivatives of the "mean" values in gamma1 and gamma2.
5577 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5578 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5579 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5580 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5582 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5583 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5584 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5585 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5587 if (theta(i).gt.pi-delta) then
5588 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5590 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5591 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5592 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5594 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5596 else if (theta(i).lt.delta) then
5597 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5598 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5599 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5601 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5602 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5605 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5608 etheta=etheta+ethetai
5609 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5610 & 'ebend',i,ethetai,theta(i),itype(i)
5611 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5612 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5613 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5616 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5617 do i=ithetaconstr_start,ithetaconstr_end
5618 itheta=itheta_constr(i)
5619 thetiii=theta(itheta)
5620 difi=pinorm(thetiii-theta_constr0(i))
5621 if (difi.gt.theta_drange(i)) then
5622 difi=difi-theta_drange(i)
5623 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
5624 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5625 & +for_thet_constr(i)*difi**3
5626 else if (difi.lt.-drange(i)) then
5628 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
5629 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5630 & +for_thet_constr(i)*difi**3
5634 if (energy_dec) then
5635 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
5636 & i,itheta,rad2deg*thetiii,
5637 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
5638 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
5639 & gloc(itheta+nphi-2,icg)
5643 C Ufff.... We've done all this!!!
5646 C---------------------------------------------------------------------------
5647 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5649 implicit real*8 (a-h,o-z)
5650 include 'DIMENSIONS'
5651 include 'COMMON.LOCAL'
5652 include 'COMMON.IOUNITS'
5653 common /calcthet/ term1,term2,termm,diffak,ratak,
5654 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5655 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5656 C Calculate the contributions to both Gaussian lobes.
5657 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5658 C The "polynomial part" of the "standard deviation" of this part of
5659 C the distributioni.
5660 ccc write (iout,*) thetai,thet_pred_mean
5663 sig=sig*thet_pred_mean+polthet(j,it)
5665 C Derivative of the "interior part" of the "standard deviation of the"
5666 C gamma-dependent Gaussian lobe in t_c.
5667 sigtc=3*polthet(3,it)
5669 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5672 C Set the parameters of both Gaussian lobes of the distribution.
5673 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5674 fac=sig*sig+sigc0(it)
5677 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5678 sigsqtc=-4.0D0*sigcsq*sigtc
5679 c print *,i,sig,sigtc,sigsqtc
5680 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5681 sigtc=-sigtc/(fac*fac)
5682 C Following variable is sigma(t_c)**(-2)
5683 sigcsq=sigcsq*sigcsq
5685 sig0inv=1.0D0/sig0i**2
5686 delthec=thetai-thet_pred_mean
5687 delthe0=thetai-theta0i
5688 term1=-0.5D0*sigcsq*delthec*delthec
5689 term2=-0.5D0*sig0inv*delthe0*delthe0
5690 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5691 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5692 C NaNs in taking the logarithm. We extract the largest exponent which is added
5693 C to the energy (this being the log of the distribution) at the end of energy
5694 C term evaluation for this virtual-bond angle.
5695 if (term1.gt.term2) then
5697 term2=dexp(term2-termm)
5701 term1=dexp(term1-termm)
5704 C The ratio between the gamma-independent and gamma-dependent lobes of
5705 C the distribution is a Gaussian function of thet_pred_mean too.
5706 diffak=gthet(2,it)-thet_pred_mean
5707 ratak=diffak/gthet(3,it)**2
5708 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5709 C Let's differentiate it in thet_pred_mean NOW.
5711 C Now put together the distribution terms to make complete distribution.
5712 termexp=term1+ak*term2
5713 termpre=sigc+ak*sig0i
5714 C Contribution of the bending energy from this theta is just the -log of
5715 C the sum of the contributions from the two lobes and the pre-exponential
5716 C factor. Simple enough, isn't it?
5717 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5718 C write (iout,*) 'termexp',termexp,termm,termpre,i
5719 C NOW the derivatives!!!
5720 C 6/6/97 Take into account the deformation.
5721 E_theta=(delthec*sigcsq*term1
5722 & +ak*delthe0*sig0inv*term2)/termexp
5723 E_tc=((sigtc+aktc*sig0i)/termpre
5724 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5725 & aktc*term2)/termexp)
5728 c-----------------------------------------------------------------------------
5729 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5730 implicit real*8 (a-h,o-z)
5731 include 'DIMENSIONS'
5732 include 'COMMON.LOCAL'
5733 include 'COMMON.IOUNITS'
5734 common /calcthet/ term1,term2,termm,diffak,ratak,
5735 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5736 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5737 delthec=thetai-thet_pred_mean
5738 delthe0=thetai-theta0i
5739 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5740 t3 = thetai-thet_pred_mean
5744 t14 = t12+t6*sigsqtc
5746 t21 = thetai-theta0i
5752 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5753 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5754 & *(-t12*t9-ak*sig0inv*t27)
5758 C--------------------------------------------------------------------------
5759 subroutine ebend(etheta,ethetacnstr)
5761 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5762 C angles gamma and its derivatives in consecutive thetas and gammas.
5763 C ab initio-derived potentials from
5764 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5766 implicit real*8 (a-h,o-z)
5767 include 'DIMENSIONS'
5768 include 'COMMON.LOCAL'
5769 include 'COMMON.GEO'
5770 include 'COMMON.INTERACT'
5771 include 'COMMON.DERIV'
5772 include 'COMMON.VAR'
5773 include 'COMMON.CHAIN'
5774 include 'COMMON.IOUNITS'
5775 include 'COMMON.NAMES'
5776 include 'COMMON.FFIELD'
5777 include 'COMMON.CONTROL'
5778 include 'COMMON.TORCNSTR'
5779 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5780 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5781 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5782 & sinph1ph2(maxdouble,maxdouble)
5783 logical lprn /.false./, lprn1 /.false./
5785 do i=ithet_start,ithet_end
5786 c print *,i,itype(i-1),itype(i),itype(i-2)
5787 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5788 & .or.itype(i).eq.ntyp1) cycle
5789 C print *,i,theta(i)
5790 if (iabs(itype(i+1)).eq.20) iblock=2
5791 if (iabs(itype(i+1)).ne.20) iblock=1
5795 theti2=0.5d0*theta(i)
5796 ityp2=ithetyp((itype(i-1)))
5798 coskt(k)=dcos(k*theti2)
5799 sinkt(k)=dsin(k*theti2)
5802 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5805 if (phii.ne.phii) phii=150.0
5809 ityp1=ithetyp((itype(i-2)))
5810 C propagation of chirality for glycine type
5812 cosph1(k)=dcos(k*phii)
5813 sinph1(k)=dsin(k*phii)
5818 ityp1=ithetyp((itype(i-2)))
5823 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5826 if (phii1.ne.phii1) phii1=150.0
5831 ityp3=ithetyp((itype(i)))
5833 cosph2(k)=dcos(k*phii1)
5834 sinph2(k)=dsin(k*phii1)
5838 ityp3=ithetyp((itype(i)))
5844 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5847 ccl=cosph1(l)*cosph2(k-l)
5848 ssl=sinph1(l)*sinph2(k-l)
5849 scl=sinph1(l)*cosph2(k-l)
5850 csl=cosph1(l)*sinph2(k-l)
5851 cosph1ph2(l,k)=ccl-ssl
5852 cosph1ph2(k,l)=ccl+ssl
5853 sinph1ph2(l,k)=scl+csl
5854 sinph1ph2(k,l)=scl-csl
5858 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5859 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5860 write (iout,*) "coskt and sinkt"
5862 write (iout,*) k,coskt(k),sinkt(k)
5866 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5867 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5870 & write (iout,*) "k",k,"
5871 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5872 & " ethetai",ethetai
5875 write (iout,*) "cosph and sinph"
5877 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5879 write (iout,*) "cosph1ph2 and sinph2ph2"
5882 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5883 & sinph1ph2(l,k),sinph1ph2(k,l)
5886 write(iout,*) "ethetai",ethetai
5891 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5892 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5893 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5894 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5895 ethetai=ethetai+sinkt(m)*aux
5896 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5897 dephii=dephii+k*sinkt(m)*(
5898 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5899 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5900 dephii1=dephii1+k*sinkt(m)*(
5901 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5902 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5904 & write (iout,*) "m",m," k",k," bbthet",
5905 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5906 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5907 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5908 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5909 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5912 C print *,"cosph1", (cosph1(k), k=1,nsingle)
5913 C print *,"cosph2", (cosph2(k), k=1,nsingle)
5914 C print *,"sinph1", (sinph1(k), k=1,nsingle)
5915 C print *,"sinph2", (sinph2(k), k=1,nsingle)
5917 & write(iout,*) "ethetai",ethetai
5918 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5922 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5923 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5924 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5925 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5926 ethetai=ethetai+sinkt(m)*aux
5927 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5928 dephii=dephii+l*sinkt(m)*(
5929 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5930 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5931 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5932 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5933 dephii1=dephii1+(k-l)*sinkt(m)*(
5934 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5935 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5936 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5937 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5939 write (iout,*) "m",m," k",k," l",l," ffthet",
5940 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5941 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5942 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5943 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5944 & " ethetai",ethetai
5945 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5946 & cosph1ph2(k,l)*sinkt(m),
5947 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5956 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5957 & i,theta(i)*rad2deg,phii*rad2deg,
5958 & phii1*rad2deg,ethetai
5960 etheta=etheta+ethetai
5961 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5962 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5963 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5967 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5968 do i=ithetaconstr_start,ithetaconstr_end
5969 itheta=itheta_constr(i)
5970 thetiii=theta(itheta)
5971 difi=pinorm(thetiii-theta_constr0(i))
5972 if (difi.gt.theta_drange(i)) then
5973 difi=difi-theta_drange(i)
5974 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5975 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5976 & +for_thet_constr(i)*difi**3
5977 else if (difi.lt.-drange(i)) then
5979 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5980 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5981 & +for_thet_constr(i)*difi**3
5985 if (energy_dec) then
5986 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
5987 & i,itheta,rad2deg*thetiii,
5988 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
5989 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
5990 & gloc(itheta+nphi-2,icg)
5998 c-----------------------------------------------------------------------------
5999 subroutine esc(escloc)
6000 C Calculate the local energy of a side chain and its derivatives in the
6001 C corresponding virtual-bond valence angles THETA and the spherical angles
6003 implicit real*8 (a-h,o-z)
6004 include 'DIMENSIONS'
6005 include 'COMMON.GEO'
6006 include 'COMMON.LOCAL'
6007 include 'COMMON.VAR'
6008 include 'COMMON.INTERACT'
6009 include 'COMMON.DERIV'
6010 include 'COMMON.CHAIN'
6011 include 'COMMON.IOUNITS'
6012 include 'COMMON.NAMES'
6013 include 'COMMON.FFIELD'
6014 include 'COMMON.CONTROL'
6015 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6016 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6017 common /sccalc/ time11,time12,time112,theti,it,nlobit
6020 c write (iout,'(a)') 'ESC'
6021 do i=loc_start,loc_end
6023 if (it.eq.ntyp1) cycle
6024 if (it.eq.10) goto 1
6025 nlobit=nlob(iabs(it))
6026 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6027 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6028 theti=theta(i+1)-pipol
6033 if (x(2).gt.pi-delta) then
6037 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6039 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6040 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6042 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6043 & ddersc0(1),dersc(1))
6044 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6045 & ddersc0(3),dersc(3))
6047 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6049 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6050 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6051 & dersc0(2),esclocbi,dersc02)
6052 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6054 call splinthet(x(2),0.5d0*delta,ss,ssd)
6059 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6061 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6062 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6064 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6066 c write (iout,*) escloci
6067 else if (x(2).lt.delta) then
6071 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6073 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6074 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6076 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6077 & ddersc0(1),dersc(1))
6078 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6079 & ddersc0(3),dersc(3))
6081 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6083 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6084 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6085 & dersc0(2),esclocbi,dersc02)
6086 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6091 call splinthet(x(2),0.5d0*delta,ss,ssd)
6093 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6095 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6096 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6098 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6099 c write (iout,*) escloci
6101 call enesc(x,escloci,dersc,ddummy,.false.)
6104 escloc=escloc+escloci
6105 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6106 & 'escloc',i,escloci
6107 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6109 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6111 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6112 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6117 C---------------------------------------------------------------------------
6118 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6119 implicit real*8 (a-h,o-z)
6120 include 'DIMENSIONS'
6121 include 'COMMON.GEO'
6122 include 'COMMON.LOCAL'
6123 include 'COMMON.IOUNITS'
6124 common /sccalc/ time11,time12,time112,theti,it,nlobit
6125 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6126 double precision contr(maxlob,-1:1)
6128 c write (iout,*) 'it=',it,' nlobit=',nlobit
6132 if (mixed) ddersc(j)=0.0d0
6136 C Because of periodicity of the dependence of the SC energy in omega we have
6137 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6138 C To avoid underflows, first compute & store the exponents.
6146 z(k)=x(k)-censc(k,j,it)
6151 Axk=Axk+gaussc(l,k,j,it)*z(l)
6157 expfac=expfac+Ax(k,j,iii)*z(k)
6165 C As in the case of ebend, we want to avoid underflows in exponentiation and
6166 C subsequent NaNs and INFs in energy calculation.
6167 C Find the largest exponent
6171 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6175 cd print *,'it=',it,' emin=',emin
6177 C Compute the contribution to SC energy and derivatives
6182 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6183 if(adexp.ne.adexp) adexp=1.0
6186 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6188 cd print *,'j=',j,' expfac=',expfac
6189 escloc_i=escloc_i+expfac
6191 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6195 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6196 & +gaussc(k,2,j,it))*expfac
6203 dersc(1)=dersc(1)/cos(theti)**2
6204 ddersc(1)=ddersc(1)/cos(theti)**2
6207 escloci=-(dlog(escloc_i)-emin)
6209 dersc(j)=dersc(j)/escloc_i
6213 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6218 C------------------------------------------------------------------------------
6219 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6220 implicit real*8 (a-h,o-z)
6221 include 'DIMENSIONS'
6222 include 'COMMON.GEO'
6223 include 'COMMON.LOCAL'
6224 include 'COMMON.IOUNITS'
6225 common /sccalc/ time11,time12,time112,theti,it,nlobit
6226 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6227 double precision contr(maxlob)
6238 z(k)=x(k)-censc(k,j,it)
6244 Axk=Axk+gaussc(l,k,j,it)*z(l)
6250 expfac=expfac+Ax(k,j)*z(k)
6255 C As in the case of ebend, we want to avoid underflows in exponentiation and
6256 C subsequent NaNs and INFs in energy calculation.
6257 C Find the largest exponent
6260 if (emin.gt.contr(j)) emin=contr(j)
6264 C Compute the contribution to SC energy and derivatives
6268 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6269 escloc_i=escloc_i+expfac
6271 dersc(k)=dersc(k)+Ax(k,j)*expfac
6273 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6274 & +gaussc(1,2,j,it))*expfac
6278 dersc(1)=dersc(1)/cos(theti)**2
6279 dersc12=dersc12/cos(theti)**2
6280 escloci=-(dlog(escloc_i)-emin)
6282 dersc(j)=dersc(j)/escloc_i
6284 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6288 c----------------------------------------------------------------------------------
6289 subroutine esc(escloc)
6290 C Calculate the local energy of a side chain and its derivatives in the
6291 C corresponding virtual-bond valence angles THETA and the spherical angles
6292 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6293 C added by Urszula Kozlowska. 07/11/2007
6295 implicit real*8 (a-h,o-z)
6296 include 'DIMENSIONS'
6297 include 'COMMON.GEO'
6298 include 'COMMON.LOCAL'
6299 include 'COMMON.VAR'
6300 include 'COMMON.SCROT'
6301 include 'COMMON.INTERACT'
6302 include 'COMMON.DERIV'
6303 include 'COMMON.CHAIN'
6304 include 'COMMON.IOUNITS'
6305 include 'COMMON.NAMES'
6306 include 'COMMON.FFIELD'
6307 include 'COMMON.CONTROL'
6308 include 'COMMON.VECTORS'
6309 double precision x_prime(3),y_prime(3),z_prime(3)
6310 & , sumene,dsc_i,dp2_i,x(65),
6311 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6312 & de_dxx,de_dyy,de_dzz,de_dt
6313 double precision s1_t,s1_6_t,s2_t,s2_6_t
6315 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6316 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6317 & dt_dCi(3),dt_dCi1(3)
6318 common /sccalc/ time11,time12,time112,theti,it,nlobit
6321 do i=loc_start,loc_end
6322 if (itype(i).eq.ntyp1) cycle
6323 costtab(i+1) =dcos(theta(i+1))
6324 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6325 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6326 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6327 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6328 cosfac=dsqrt(cosfac2)
6329 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6330 sinfac=dsqrt(sinfac2)
6332 if (it.eq.10) goto 1
6334 C Compute the axes of tghe local cartesian coordinates system; store in
6335 c x_prime, y_prime and z_prime
6342 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6343 C & dc_norm(3,i+nres)
6345 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6346 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6349 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6352 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6353 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6354 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6355 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6356 c & " xy",scalar(x_prime(1),y_prime(1)),
6357 c & " xz",scalar(x_prime(1),z_prime(1)),
6358 c & " yy",scalar(y_prime(1),y_prime(1)),
6359 c & " yz",scalar(y_prime(1),z_prime(1)),
6360 c & " zz",scalar(z_prime(1),z_prime(1))
6362 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6363 C to local coordinate system. Store in xx, yy, zz.
6369 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6370 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6371 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6378 C Compute the energy of the ith side cbain
6380 c write (2,*) "xx",xx," yy",yy," zz",zz
6383 x(j) = sc_parmin(j,it)
6386 Cc diagnostics - remove later
6388 yy1 = dsin(alph(2))*dcos(omeg(2))
6389 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6390 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6391 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6393 C," --- ", xx_w,yy_w,zz_w
6396 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6397 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6399 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6400 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6402 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6403 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6404 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6405 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6406 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6408 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6409 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6410 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6411 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6412 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6414 dsc_i = 0.743d0+x(61)
6416 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6417 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6418 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6419 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6420 s1=(1+x(63))/(0.1d0 + dscp1)
6421 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6422 s2=(1+x(65))/(0.1d0 + dscp2)
6423 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6424 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6425 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6426 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6428 c & dscp1,dscp2,sumene
6429 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6430 escloc = escloc + sumene
6431 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6436 C This section to check the numerical derivatives of the energy of ith side
6437 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6438 C #define DEBUG in the code to turn it on.
6440 write (2,*) "sumene =",sumene
6444 write (2,*) xx,yy,zz
6445 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6446 de_dxx_num=(sumenep-sumene)/aincr
6448 write (2,*) "xx+ sumene from enesc=",sumenep
6451 write (2,*) xx,yy,zz
6452 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6453 de_dyy_num=(sumenep-sumene)/aincr
6455 write (2,*) "yy+ sumene from enesc=",sumenep
6458 write (2,*) xx,yy,zz
6459 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6460 de_dzz_num=(sumenep-sumene)/aincr
6462 write (2,*) "zz+ sumene from enesc=",sumenep
6463 costsave=cost2tab(i+1)
6464 sintsave=sint2tab(i+1)
6465 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6466 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6467 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6468 de_dt_num=(sumenep-sumene)/aincr
6469 write (2,*) " t+ sumene from enesc=",sumenep
6470 cost2tab(i+1)=costsave
6471 sint2tab(i+1)=sintsave
6472 C End of diagnostics section.
6475 C Compute the gradient of esc
6477 c zz=zz*dsign(1.0,dfloat(itype(i)))
6478 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6479 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6480 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6481 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6482 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6483 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6484 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6485 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6486 pom1=(sumene3*sint2tab(i+1)+sumene1)
6487 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6488 pom2=(sumene4*cost2tab(i+1)+sumene2)
6489 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6490 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6491 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6492 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6494 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6495 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6496 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6498 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6499 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6500 & +(pom1+pom2)*pom_dx
6502 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6505 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6506 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6507 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6509 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6510 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6511 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6512 & +x(59)*zz**2 +x(60)*xx*zz
6513 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6514 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6515 & +(pom1-pom2)*pom_dy
6517 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6520 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6521 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6522 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6523 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6524 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6525 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6526 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6527 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6529 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6532 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6533 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6534 & +pom1*pom_dt1+pom2*pom_dt2
6536 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6541 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6542 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6543 cosfac2xx=cosfac2*xx
6544 sinfac2yy=sinfac2*yy
6546 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6548 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6550 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6551 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6552 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6553 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6554 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6555 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6556 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6557 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6558 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6559 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6563 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6564 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6565 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6566 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6569 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6570 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6571 dZZ_XYZ(k)=vbld_inv(i+nres)*
6572 & (z_prime(k)-zz*dC_norm(k,i+nres))
6574 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6575 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6579 dXX_Ctab(k,i)=dXX_Ci(k)
6580 dXX_C1tab(k,i)=dXX_Ci1(k)
6581 dYY_Ctab(k,i)=dYY_Ci(k)
6582 dYY_C1tab(k,i)=dYY_Ci1(k)
6583 dZZ_Ctab(k,i)=dZZ_Ci(k)
6584 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6585 dXX_XYZtab(k,i)=dXX_XYZ(k)
6586 dYY_XYZtab(k,i)=dYY_XYZ(k)
6587 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6591 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6592 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6593 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6594 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6595 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6597 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6598 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6599 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6600 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6601 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6602 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6603 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6604 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6606 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6607 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6609 C to check gradient call subroutine check_grad
6615 c------------------------------------------------------------------------------
6616 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6618 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6619 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6620 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6621 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6623 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6624 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6626 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6627 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6628 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6629 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6630 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6632 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6633 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6634 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6635 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6636 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6638 dsc_i = 0.743d0+x(61)
6640 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6641 & *(xx*cost2+yy*sint2))
6642 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6643 & *(xx*cost2-yy*sint2))
6644 s1=(1+x(63))/(0.1d0 + dscp1)
6645 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6646 s2=(1+x(65))/(0.1d0 + dscp2)
6647 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6648 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6649 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6654 c------------------------------------------------------------------------------
6655 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6657 C This procedure calculates two-body contact function g(rij) and its derivative:
6660 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6663 C where x=(rij-r0ij)/delta
6665 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6668 double precision rij,r0ij,eps0ij,fcont,fprimcont
6669 double precision x,x2,x4,delta
6673 if (x.lt.-1.0D0) then
6676 else if (x.le.1.0D0) then
6679 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6680 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6687 c------------------------------------------------------------------------------
6688 subroutine splinthet(theti,delta,ss,ssder)
6689 implicit real*8 (a-h,o-z)
6690 include 'DIMENSIONS'
6691 include 'COMMON.VAR'
6692 include 'COMMON.GEO'
6695 if (theti.gt.pipol) then
6696 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6698 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6703 c------------------------------------------------------------------------------
6704 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6706 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6707 double precision ksi,ksi2,ksi3,a1,a2,a3
6708 a1=fprim0*delta/(f1-f0)
6714 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6715 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6718 c------------------------------------------------------------------------------
6719 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6721 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6722 double precision ksi,ksi2,ksi3,a1,a2,a3
6727 a2=3*(f1x-f0x)-2*fprim0x*delta
6728 a3=fprim0x*delta-2*(f1x-f0x)
6729 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6732 C-----------------------------------------------------------------------------
6734 C-----------------------------------------------------------------------------
6735 subroutine etor(etors,edihcnstr)
6736 implicit real*8 (a-h,o-z)
6737 include 'DIMENSIONS'
6738 include 'COMMON.VAR'
6739 include 'COMMON.GEO'
6740 include 'COMMON.LOCAL'
6741 include 'COMMON.TORSION'
6742 include 'COMMON.INTERACT'
6743 include 'COMMON.DERIV'
6744 include 'COMMON.CHAIN'
6745 include 'COMMON.NAMES'
6746 include 'COMMON.IOUNITS'
6747 include 'COMMON.FFIELD'
6748 include 'COMMON.TORCNSTR'
6749 include 'COMMON.CONTROL'
6751 C Set lprn=.true. for debugging
6755 do i=iphi_start,iphi_end
6757 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6758 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6759 itori=itortyp(itype(i-2))
6760 itori1=itortyp(itype(i-1))
6763 C Proline-Proline pair is a special case...
6764 if (itori.eq.3 .and. itori1.eq.3) then
6765 if (phii.gt.-dwapi3) then
6767 fac=1.0D0/(1.0D0-cosphi)
6768 etorsi=v1(1,3,3)*fac
6769 etorsi=etorsi+etorsi
6770 etors=etors+etorsi-v1(1,3,3)
6771 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6772 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6775 v1ij=v1(j+1,itori,itori1)
6776 v2ij=v2(j+1,itori,itori1)
6779 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6780 if (energy_dec) etors_ii=etors_ii+
6781 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6782 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6786 v1ij=v1(j,itori,itori1)
6787 v2ij=v2(j,itori,itori1)
6790 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6791 if (energy_dec) etors_ii=etors_ii+
6792 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6793 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6796 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6799 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6800 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6801 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6802 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6803 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6805 ! 6/20/98 - dihedral angle constraints
6808 itori=idih_constr(i)
6811 if (difi.gt.drange(i)) then
6813 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6814 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6815 else if (difi.lt.-drange(i)) then
6817 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
6818 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6820 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6821 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6823 ! write (iout,*) 'edihcnstr',edihcnstr
6826 c------------------------------------------------------------------------------
6827 subroutine etor_d(etors_d)
6831 c----------------------------------------------------------------------------
6833 subroutine etor(etors,edihcnstr)
6834 implicit real*8 (a-h,o-z)
6835 include 'DIMENSIONS'
6836 include 'COMMON.VAR'
6837 include 'COMMON.GEO'
6838 include 'COMMON.LOCAL'
6839 include 'COMMON.TORSION'
6840 include 'COMMON.INTERACT'
6841 include 'COMMON.DERIV'
6842 include 'COMMON.CHAIN'
6843 include 'COMMON.NAMES'
6844 include 'COMMON.IOUNITS'
6845 include 'COMMON.FFIELD'
6846 include 'COMMON.TORCNSTR'
6847 include 'COMMON.CONTROL'
6849 C Set lprn=.true. for debugging
6853 do i=iphi_start,iphi_end
6854 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6855 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6856 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6857 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6858 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6859 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6860 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6861 C For introducing the NH3+ and COO- group please check the etor_d for reference
6864 if (iabs(itype(i)).eq.20) then
6869 itori=itortyp(itype(i-2))
6870 itori1=itortyp(itype(i-1))
6873 C Regular cosine and sine terms
6874 do j=1,nterm(itori,itori1,iblock)
6875 v1ij=v1(j,itori,itori1,iblock)
6876 v2ij=v2(j,itori,itori1,iblock)
6879 etors=etors+v1ij*cosphi+v2ij*sinphi
6880 if (energy_dec) etors_ii=etors_ii+
6881 & v1ij*cosphi+v2ij*sinphi
6882 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6886 C E = SUM ----------------------------------- - v1
6887 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6889 cosphi=dcos(0.5d0*phii)
6890 sinphi=dsin(0.5d0*phii)
6891 do j=1,nlor(itori,itori1,iblock)
6892 vl1ij=vlor1(j,itori,itori1)
6893 vl2ij=vlor2(j,itori,itori1)
6894 vl3ij=vlor3(j,itori,itori1)
6895 pom=vl2ij*cosphi+vl3ij*sinphi
6896 pom1=1.0d0/(pom*pom+1.0d0)
6897 etors=etors+vl1ij*pom1
6898 if (energy_dec) etors_ii=etors_ii+
6901 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6903 C Subtract the constant term
6904 etors=etors-v0(itori,itori1,iblock)
6905 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6906 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6908 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6909 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6910 & (v1(j,itori,itori1,iblock),j=1,6),
6911 & (v2(j,itori,itori1,iblock),j=1,6)
6912 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6913 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6915 ! 6/20/98 - dihedral angle constraints
6917 c do i=1,ndih_constr
6918 do i=idihconstr_start,idihconstr_end
6919 itori=idih_constr(i)
6921 difi=pinorm(phii-phi0(i))
6922 if (difi.gt.drange(i)) then
6924 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6925 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6926 else if (difi.lt.-drange(i)) then
6928 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6929 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6933 if (energy_dec) then
6934 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
6935 & i,itori,rad2deg*phii,
6936 & rad2deg*phi0(i), rad2deg*drange(i),
6937 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
6940 cd write (iout,*) 'edihcnstr',edihcnstr
6943 c----------------------------------------------------------------------------
6944 subroutine etor_d(etors_d)
6945 C 6/23/01 Compute double torsional energy
6946 implicit real*8 (a-h,o-z)
6947 include 'DIMENSIONS'
6948 include 'COMMON.VAR'
6949 include 'COMMON.GEO'
6950 include 'COMMON.LOCAL'
6951 include 'COMMON.TORSION'
6952 include 'COMMON.INTERACT'
6953 include 'COMMON.DERIV'
6954 include 'COMMON.CHAIN'
6955 include 'COMMON.NAMES'
6956 include 'COMMON.IOUNITS'
6957 include 'COMMON.FFIELD'
6958 include 'COMMON.TORCNSTR'
6960 C Set lprn=.true. for debugging
6964 c write(iout,*) "a tu??"
6965 do i=iphid_start,iphid_end
6966 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6967 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6968 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6969 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6970 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6971 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6972 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6973 & (itype(i+1).eq.ntyp1)) cycle
6974 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6975 itori=itortyp(itype(i-2))
6976 itori1=itortyp(itype(i-1))
6977 itori2=itortyp(itype(i))
6983 if (iabs(itype(i+1)).eq.20) iblock=2
6984 C Iblock=2 Proline type
6985 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6986 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6987 C if (itype(i+1).eq.ntyp1) iblock=3
6988 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6989 C IS or IS NOT need for this
6990 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6991 C is (itype(i-3).eq.ntyp1) ntblock=2
6992 C ntblock is N-terminal blocking group
6994 C Regular cosine and sine terms
6995 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6996 C Example of changes for NH3+ blocking group
6997 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6998 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6999 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7000 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7001 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7002 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7003 cosphi1=dcos(j*phii)
7004 sinphi1=dsin(j*phii)
7005 cosphi2=dcos(j*phii1)
7006 sinphi2=dsin(j*phii1)
7007 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7008 & v2cij*cosphi2+v2sij*sinphi2
7009 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7010 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7012 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7014 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7015 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7016 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7017 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7018 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7019 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7020 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7021 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7022 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7023 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7024 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7025 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7026 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7027 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7030 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7031 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7036 c------------------------------------------------------------------------------
7037 subroutine eback_sc_corr(esccor)
7038 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7039 c conformational states; temporarily implemented as differences
7040 c between UNRES torsional potentials (dependent on three types of
7041 c residues) and the torsional potentials dependent on all 20 types
7042 c of residues computed from AM1 energy surfaces of terminally-blocked
7043 c amino-acid residues.
7044 implicit real*8 (a-h,o-z)
7045 include 'DIMENSIONS'
7046 include 'COMMON.VAR'
7047 include 'COMMON.GEO'
7048 include 'COMMON.LOCAL'
7049 include 'COMMON.TORSION'
7050 include 'COMMON.SCCOR'
7051 include 'COMMON.INTERACT'
7052 include 'COMMON.DERIV'
7053 include 'COMMON.CHAIN'
7054 include 'COMMON.NAMES'
7055 include 'COMMON.IOUNITS'
7056 include 'COMMON.FFIELD'
7057 include 'COMMON.CONTROL'
7059 C Set lprn=.true. for debugging
7062 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7064 do i=itau_start,itau_end
7065 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7067 isccori=isccortyp(itype(i-2))
7068 isccori1=isccortyp(itype(i-1))
7069 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7071 do intertyp=1,3 !intertyp
7072 cc Added 09 May 2012 (Adasko)
7073 cc Intertyp means interaction type of backbone mainchain correlation:
7074 c 1 = SC...Ca...Ca...Ca
7075 c 2 = Ca...Ca...Ca...SC
7076 c 3 = SC...Ca...Ca...SCi
7078 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7079 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7080 & (itype(i-1).eq.ntyp1)))
7081 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7082 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7083 & .or.(itype(i).eq.ntyp1)))
7084 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7085 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7086 & (itype(i-3).eq.ntyp1)))) cycle
7087 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7088 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7090 do j=1,nterm_sccor(isccori,isccori1)
7091 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7092 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7093 cosphi=dcos(j*tauangle(intertyp,i))
7094 sinphi=dsin(j*tauangle(intertyp,i))
7095 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7096 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7098 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7099 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7101 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7102 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
7103 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
7104 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7105 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7111 c----------------------------------------------------------------------------
7112 subroutine multibody(ecorr)
7113 C This subroutine calculates multi-body contributions to energy following
7114 C the idea of Skolnick et al. If side chains I and J make a contact and
7115 C at the same time side chains I+1 and J+1 make a contact, an extra
7116 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7117 implicit real*8 (a-h,o-z)
7118 include 'DIMENSIONS'
7119 include 'COMMON.IOUNITS'
7120 include 'COMMON.DERIV'
7121 include 'COMMON.INTERACT'
7122 include 'COMMON.CONTACTS'
7123 double precision gx(3),gx1(3)
7126 C Set lprn=.true. for debugging
7130 write (iout,'(a)') 'Contact function values:'
7132 write (iout,'(i2,20(1x,i2,f10.5))')
7133 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7148 num_conti=num_cont(i)
7149 num_conti1=num_cont(i1)
7154 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7155 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7156 cd & ' ishift=',ishift
7157 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7158 C The system gains extra energy.
7159 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7160 endif ! j1==j+-ishift
7169 c------------------------------------------------------------------------------
7170 double precision function esccorr(i,j,k,l,jj,kk)
7171 implicit real*8 (a-h,o-z)
7172 include 'DIMENSIONS'
7173 include 'COMMON.IOUNITS'
7174 include 'COMMON.DERIV'
7175 include 'COMMON.INTERACT'
7176 include 'COMMON.CONTACTS'
7177 double precision gx(3),gx1(3)
7182 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7183 C Calculate the multi-body contribution to energy.
7184 C Calculate multi-body contributions to the gradient.
7185 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7186 cd & k,l,(gacont(m,kk,k),m=1,3)
7188 gx(m) =ekl*gacont(m,jj,i)
7189 gx1(m)=eij*gacont(m,kk,k)
7190 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7191 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7192 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7193 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7197 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7202 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7208 c------------------------------------------------------------------------------
7209 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7210 C This subroutine calculates multi-body contributions to hydrogen-bonding
7211 implicit real*8 (a-h,o-z)
7212 include 'DIMENSIONS'
7213 include 'COMMON.IOUNITS'
7216 parameter (max_cont=maxconts)
7217 parameter (max_dim=26)
7218 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7219 double precision zapas(max_dim,maxconts,max_fg_procs),
7220 & zapas_recv(max_dim,maxconts,max_fg_procs)
7221 common /przechowalnia/ zapas
7222 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7223 & status_array(MPI_STATUS_SIZE,maxconts*2)
7225 include 'COMMON.SETUP'
7226 include 'COMMON.FFIELD'
7227 include 'COMMON.DERIV'
7228 include 'COMMON.INTERACT'
7229 include 'COMMON.CONTACTS'
7230 include 'COMMON.CONTROL'
7231 include 'COMMON.LOCAL'
7232 double precision gx(3),gx1(3),time00
7235 C Set lprn=.true. for debugging
7240 if (nfgtasks.le.1) goto 30
7242 write (iout,'(a)') 'Contact function values before RECEIVE:'
7244 write (iout,'(2i3,50(1x,i2,f5.2))')
7245 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7246 & j=1,num_cont_hb(i))
7250 do i=1,ntask_cont_from
7253 do i=1,ntask_cont_to
7256 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7258 C Make the list of contacts to send to send to other procesors
7259 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7261 do i=iturn3_start,iturn3_end
7262 c write (iout,*) "make contact list turn3",i," num_cont",
7264 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7266 do i=iturn4_start,iturn4_end
7267 c write (iout,*) "make contact list turn4",i," num_cont",
7269 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7273 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7275 do j=1,num_cont_hb(i)
7278 iproc=iint_sent_local(k,jjc,ii)
7279 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7280 if (iproc.gt.0) then
7281 ncont_sent(iproc)=ncont_sent(iproc)+1
7282 nn=ncont_sent(iproc)
7284 zapas(2,nn,iproc)=jjc
7285 zapas(3,nn,iproc)=facont_hb(j,i)
7286 zapas(4,nn,iproc)=ees0p(j,i)
7287 zapas(5,nn,iproc)=ees0m(j,i)
7288 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7289 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7290 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7291 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7292 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7293 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7294 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7295 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7296 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7297 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7298 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7299 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7300 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7301 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7302 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7303 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7304 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7305 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7306 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7307 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7308 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7315 & "Numbers of contacts to be sent to other processors",
7316 & (ncont_sent(i),i=1,ntask_cont_to)
7317 write (iout,*) "Contacts sent"
7318 do ii=1,ntask_cont_to
7320 iproc=itask_cont_to(ii)
7321 write (iout,*) nn," contacts to processor",iproc,
7322 & " of CONT_TO_COMM group"
7324 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7332 CorrelID1=nfgtasks+fg_rank+1
7334 C Receive the numbers of needed contacts from other processors
7335 do ii=1,ntask_cont_from
7336 iproc=itask_cont_from(ii)
7338 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7339 & FG_COMM,req(ireq),IERR)
7341 c write (iout,*) "IRECV ended"
7343 C Send the number of contacts needed by other processors
7344 do ii=1,ntask_cont_to
7345 iproc=itask_cont_to(ii)
7347 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7348 & FG_COMM,req(ireq),IERR)
7350 c write (iout,*) "ISEND ended"
7351 c write (iout,*) "number of requests (nn)",ireq
7354 & call MPI_Waitall(ireq,req,status_array,ierr)
7356 c & "Numbers of contacts to be received from other processors",
7357 c & (ncont_recv(i),i=1,ntask_cont_from)
7361 do ii=1,ntask_cont_from
7362 iproc=itask_cont_from(ii)
7364 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7365 c & " of CONT_TO_COMM group"
7369 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7370 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7371 c write (iout,*) "ireq,req",ireq,req(ireq)
7374 C Send the contacts to processors that need them
7375 do ii=1,ntask_cont_to
7376 iproc=itask_cont_to(ii)
7378 c write (iout,*) nn," contacts to processor",iproc,
7379 c & " of CONT_TO_COMM group"
7382 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7383 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7384 c write (iout,*) "ireq,req",ireq,req(ireq)
7386 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7390 c write (iout,*) "number of requests (contacts)",ireq
7391 c write (iout,*) "req",(req(i),i=1,4)
7394 & call MPI_Waitall(ireq,req,status_array,ierr)
7395 do iii=1,ntask_cont_from
7396 iproc=itask_cont_from(iii)
7399 write (iout,*) "Received",nn," contacts from processor",iproc,
7400 & " of CONT_FROM_COMM group"
7403 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7408 ii=zapas_recv(1,i,iii)
7409 c Flag the received contacts to prevent double-counting
7410 jj=-zapas_recv(2,i,iii)
7411 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7413 nnn=num_cont_hb(ii)+1
7416 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7417 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7418 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7419 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7420 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7421 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7422 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7423 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7424 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7425 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7426 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7427 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7428 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7429 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7430 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7431 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7432 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7433 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7434 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7435 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7436 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7437 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7438 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7439 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7444 write (iout,'(a)') 'Contact function values after receive:'
7446 write (iout,'(2i3,50(1x,i3,f5.2))')
7447 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7448 & j=1,num_cont_hb(i))
7455 write (iout,'(a)') 'Contact function values:'
7457 write (iout,'(2i3,50(1x,i3,f5.2))')
7458 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7459 & j=1,num_cont_hb(i))
7463 C Remove the loop below after debugging !!!
7470 C Calculate the local-electrostatic correlation terms
7471 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7473 num_conti=num_cont_hb(i)
7474 num_conti1=num_cont_hb(i+1)
7481 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7482 c & ' jj=',jj,' kk=',kk
7483 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7484 & .or. j.lt.0 .and. j1.gt.0) .and.
7485 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7486 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7487 C The system gains extra energy.
7488 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7489 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7490 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7492 else if (j1.eq.j) then
7493 C Contacts I-J and I-(J+1) occur simultaneously.
7494 C The system loses extra energy.
7495 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7500 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7501 c & ' jj=',jj,' kk=',kk
7503 C Contacts I-J and (I+1)-J occur simultaneously.
7504 C The system loses extra energy.
7505 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7512 c------------------------------------------------------------------------------
7513 subroutine add_hb_contact(ii,jj,itask)
7514 implicit real*8 (a-h,o-z)
7515 include "DIMENSIONS"
7516 include "COMMON.IOUNITS"
7519 parameter (max_cont=maxconts)
7520 parameter (max_dim=26)
7521 include "COMMON.CONTACTS"
7522 double precision zapas(max_dim,maxconts,max_fg_procs),
7523 & zapas_recv(max_dim,maxconts,max_fg_procs)
7524 common /przechowalnia/ zapas
7525 integer i,j,ii,jj,iproc,itask(4),nn
7526 c write (iout,*) "itask",itask
7529 if (iproc.gt.0) then
7530 do j=1,num_cont_hb(ii)
7532 c write (iout,*) "i",ii," j",jj," jjc",jjc
7534 ncont_sent(iproc)=ncont_sent(iproc)+1
7535 nn=ncont_sent(iproc)
7536 zapas(1,nn,iproc)=ii
7537 zapas(2,nn,iproc)=jjc
7538 zapas(3,nn,iproc)=facont_hb(j,ii)
7539 zapas(4,nn,iproc)=ees0p(j,ii)
7540 zapas(5,nn,iproc)=ees0m(j,ii)
7541 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7542 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7543 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7544 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7545 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7546 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7547 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7548 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7549 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7550 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7551 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7552 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7553 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7554 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7555 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7556 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7557 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7558 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7559 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7560 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7561 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7569 c------------------------------------------------------------------------------
7570 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7572 C This subroutine calculates multi-body contributions to hydrogen-bonding
7573 implicit real*8 (a-h,o-z)
7574 include 'DIMENSIONS'
7575 include 'COMMON.IOUNITS'
7578 parameter (max_cont=maxconts)
7579 parameter (max_dim=70)
7580 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7581 double precision zapas(max_dim,maxconts,max_fg_procs),
7582 & zapas_recv(max_dim,maxconts,max_fg_procs)
7583 common /przechowalnia/ zapas
7584 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7585 & status_array(MPI_STATUS_SIZE,maxconts*2)
7587 include 'COMMON.SETUP'
7588 include 'COMMON.FFIELD'
7589 include 'COMMON.DERIV'
7590 include 'COMMON.LOCAL'
7591 include 'COMMON.INTERACT'
7592 include 'COMMON.CONTACTS'
7593 include 'COMMON.CHAIN'
7594 include 'COMMON.CONTROL'
7595 double precision gx(3),gx1(3)
7596 integer num_cont_hb_old(maxres)
7598 double precision eello4,eello5,eelo6,eello_turn6
7599 external eello4,eello5,eello6,eello_turn6
7600 C Set lprn=.true. for debugging
7605 num_cont_hb_old(i)=num_cont_hb(i)
7609 if (nfgtasks.le.1) goto 30
7611 write (iout,'(a)') 'Contact function values before RECEIVE:'
7613 write (iout,'(2i3,50(1x,i2,f5.2))')
7614 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7615 & j=1,num_cont_hb(i))
7619 do i=1,ntask_cont_from
7622 do i=1,ntask_cont_to
7625 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7627 C Make the list of contacts to send to send to other procesors
7628 do i=iturn3_start,iturn3_end
7629 c write (iout,*) "make contact list turn3",i," num_cont",
7631 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7633 do i=iturn4_start,iturn4_end
7634 c write (iout,*) "make contact list turn4",i," num_cont",
7636 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7640 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7642 do j=1,num_cont_hb(i)
7645 iproc=iint_sent_local(k,jjc,ii)
7646 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7647 if (iproc.ne.0) then
7648 ncont_sent(iproc)=ncont_sent(iproc)+1
7649 nn=ncont_sent(iproc)
7651 zapas(2,nn,iproc)=jjc
7652 zapas(3,nn,iproc)=d_cont(j,i)
7656 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7661 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7669 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7680 & "Numbers of contacts to be sent to other processors",
7681 & (ncont_sent(i),i=1,ntask_cont_to)
7682 write (iout,*) "Contacts sent"
7683 do ii=1,ntask_cont_to
7685 iproc=itask_cont_to(ii)
7686 write (iout,*) nn," contacts to processor",iproc,
7687 & " of CONT_TO_COMM group"
7689 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7697 CorrelID1=nfgtasks+fg_rank+1
7699 C Receive the numbers of needed contacts from other processors
7700 do ii=1,ntask_cont_from
7701 iproc=itask_cont_from(ii)
7703 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7704 & FG_COMM,req(ireq),IERR)
7706 c write (iout,*) "IRECV ended"
7708 C Send the number of contacts needed by other processors
7709 do ii=1,ntask_cont_to
7710 iproc=itask_cont_to(ii)
7712 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7713 & FG_COMM,req(ireq),IERR)
7715 c write (iout,*) "ISEND ended"
7716 c write (iout,*) "number of requests (nn)",ireq
7719 & call MPI_Waitall(ireq,req,status_array,ierr)
7721 c & "Numbers of contacts to be received from other processors",
7722 c & (ncont_recv(i),i=1,ntask_cont_from)
7726 do ii=1,ntask_cont_from
7727 iproc=itask_cont_from(ii)
7729 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7730 c & " of CONT_TO_COMM group"
7734 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7735 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7736 c write (iout,*) "ireq,req",ireq,req(ireq)
7739 C Send the contacts to processors that need them
7740 do ii=1,ntask_cont_to
7741 iproc=itask_cont_to(ii)
7743 c write (iout,*) nn," contacts to processor",iproc,
7744 c & " of CONT_TO_COMM group"
7747 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7748 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7749 c write (iout,*) "ireq,req",ireq,req(ireq)
7751 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7755 c write (iout,*) "number of requests (contacts)",ireq
7756 c write (iout,*) "req",(req(i),i=1,4)
7759 & call MPI_Waitall(ireq,req,status_array,ierr)
7760 do iii=1,ntask_cont_from
7761 iproc=itask_cont_from(iii)
7764 write (iout,*) "Received",nn," contacts from processor",iproc,
7765 & " of CONT_FROM_COMM group"
7768 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7773 ii=zapas_recv(1,i,iii)
7774 c Flag the received contacts to prevent double-counting
7775 jj=-zapas_recv(2,i,iii)
7776 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7778 nnn=num_cont_hb(ii)+1
7781 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7785 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7790 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7798 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7807 write (iout,'(a)') 'Contact function values after receive:'
7809 write (iout,'(2i3,50(1x,i3,5f6.3))')
7810 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7811 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7818 write (iout,'(a)') 'Contact function values:'
7820 write (iout,'(2i3,50(1x,i2,5f6.3))')
7821 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7822 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7828 C Remove the loop below after debugging !!!
7835 C Calculate the dipole-dipole interaction energies
7836 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7837 do i=iatel_s,iatel_e+1
7838 num_conti=num_cont_hb(i)
7847 C Calculate the local-electrostatic correlation terms
7848 c write (iout,*) "gradcorr5 in eello5 before loop"
7850 c write (iout,'(i5,3f10.5)')
7851 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7853 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7854 c write (iout,*) "corr loop i",i
7856 num_conti=num_cont_hb(i)
7857 num_conti1=num_cont_hb(i+1)
7864 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7865 c & ' jj=',jj,' kk=',kk
7866 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7867 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7868 & .or. j.lt.0 .and. j1.gt.0) .and.
7869 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7870 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7871 C The system gains extra energy.
7873 sqd1=dsqrt(d_cont(jj,i))
7874 sqd2=dsqrt(d_cont(kk,i1))
7875 sred_geom = sqd1*sqd2
7876 IF (sred_geom.lt.cutoff_corr) THEN
7877 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7879 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7880 cd & ' jj=',jj,' kk=',kk
7881 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7882 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7884 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7885 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7888 cd write (iout,*) 'sred_geom=',sred_geom,
7889 cd & ' ekont=',ekont,' fprim=',fprimcont,
7890 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7891 cd write (iout,*) "g_contij",g_contij
7892 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7893 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7894 call calc_eello(i,jp,i+1,jp1,jj,kk)
7895 if (wcorr4.gt.0.0d0)
7896 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7897 if (energy_dec.and.wcorr4.gt.0.0d0)
7898 1 write (iout,'(a6,4i5,0pf7.3)')
7899 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7900 c write (iout,*) "gradcorr5 before eello5"
7902 c write (iout,'(i5,3f10.5)')
7903 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7905 if (wcorr5.gt.0.0d0)
7906 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7907 c write (iout,*) "gradcorr5 after eello5"
7909 c write (iout,'(i5,3f10.5)')
7910 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7912 if (energy_dec.and.wcorr5.gt.0.0d0)
7913 1 write (iout,'(a6,4i5,0pf7.3)')
7914 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7915 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7916 cd write(2,*)'ijkl',i,jp,i+1,jp1
7917 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7918 & .or. wturn6.eq.0.0d0))then
7919 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7920 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7921 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7922 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7923 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7924 cd & 'ecorr6=',ecorr6
7925 cd write (iout,'(4e15.5)') sred_geom,
7926 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7927 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7928 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7929 else if (wturn6.gt.0.0d0
7930 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7931 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7932 eturn6=eturn6+eello_turn6(i,jj,kk)
7933 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7934 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7935 cd write (2,*) 'multibody_eello:eturn6',eturn6
7944 num_cont_hb(i)=num_cont_hb_old(i)
7946 c write (iout,*) "gradcorr5 in eello5"
7948 c write (iout,'(i5,3f10.5)')
7949 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7953 c------------------------------------------------------------------------------
7954 subroutine add_hb_contact_eello(ii,jj,itask)
7955 implicit real*8 (a-h,o-z)
7956 include "DIMENSIONS"
7957 include "COMMON.IOUNITS"
7960 parameter (max_cont=maxconts)
7961 parameter (max_dim=70)
7962 include "COMMON.CONTACTS"
7963 double precision zapas(max_dim,maxconts,max_fg_procs),
7964 & zapas_recv(max_dim,maxconts,max_fg_procs)
7965 common /przechowalnia/ zapas
7966 integer i,j,ii,jj,iproc,itask(4),nn
7967 c write (iout,*) "itask",itask
7970 if (iproc.gt.0) then
7971 do j=1,num_cont_hb(ii)
7973 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7975 ncont_sent(iproc)=ncont_sent(iproc)+1
7976 nn=ncont_sent(iproc)
7977 zapas(1,nn,iproc)=ii
7978 zapas(2,nn,iproc)=jjc
7979 zapas(3,nn,iproc)=d_cont(j,ii)
7983 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7988 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7996 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8008 c------------------------------------------------------------------------------
8009 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8010 implicit real*8 (a-h,o-z)
8011 include 'DIMENSIONS'
8012 include 'COMMON.IOUNITS'
8013 include 'COMMON.DERIV'
8014 include 'COMMON.INTERACT'
8015 include 'COMMON.CONTACTS'
8016 double precision gx(3),gx1(3)
8026 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8027 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8028 C Following 4 lines for diagnostics.
8033 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8034 c & 'Contacts ',i,j,
8035 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8036 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8038 C Calculate the multi-body contribution to energy.
8039 c ecorr=ecorr+ekont*ees
8040 C Calculate multi-body contributions to the gradient.
8041 coeffpees0pij=coeffp*ees0pij
8042 coeffmees0mij=coeffm*ees0mij
8043 coeffpees0pkl=coeffp*ees0pkl
8044 coeffmees0mkl=coeffm*ees0mkl
8046 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8047 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8048 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8049 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8050 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8051 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8052 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8053 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8054 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8055 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8056 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8057 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8058 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8059 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8060 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8061 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8062 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8063 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8064 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8065 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8066 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8067 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8068 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8069 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8070 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8075 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8076 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8077 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8078 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8083 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8084 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8085 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8086 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8089 c write (iout,*) "ehbcorr",ekont*ees
8094 C---------------------------------------------------------------------------
8095 subroutine dipole(i,j,jj)
8096 implicit real*8 (a-h,o-z)
8097 include 'DIMENSIONS'
8098 include 'COMMON.IOUNITS'
8099 include 'COMMON.CHAIN'
8100 include 'COMMON.FFIELD'
8101 include 'COMMON.DERIV'
8102 include 'COMMON.INTERACT'
8103 include 'COMMON.CONTACTS'
8104 include 'COMMON.TORSION'
8105 include 'COMMON.VAR'
8106 include 'COMMON.GEO'
8107 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8109 iti1 = itortyp(itype(i+1))
8110 if (j.lt.nres-1) then
8111 itj1 = itortyp(itype(j+1))
8116 dipi(iii,1)=Ub2(iii,i)
8117 dipderi(iii)=Ub2der(iii,i)
8118 dipi(iii,2)=b1(iii,i+1)
8119 dipj(iii,1)=Ub2(iii,j)
8120 dipderj(iii)=Ub2der(iii,j)
8121 dipj(iii,2)=b1(iii,j+1)
8125 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8128 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8135 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8139 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8144 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8145 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8147 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8149 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8151 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8156 C---------------------------------------------------------------------------
8157 subroutine calc_eello(i,j,k,l,jj,kk)
8159 C This subroutine computes matrices and vectors needed to calculate
8160 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8162 implicit real*8 (a-h,o-z)
8163 include 'DIMENSIONS'
8164 include 'COMMON.IOUNITS'
8165 include 'COMMON.CHAIN'
8166 include 'COMMON.DERIV'
8167 include 'COMMON.INTERACT'
8168 include 'COMMON.CONTACTS'
8169 include 'COMMON.TORSION'
8170 include 'COMMON.VAR'
8171 include 'COMMON.GEO'
8172 include 'COMMON.FFIELD'
8173 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8174 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8177 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8178 cd & ' jj=',jj,' kk=',kk
8179 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8180 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8181 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8184 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8185 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8188 call transpose2(aa1(1,1),aa1t(1,1))
8189 call transpose2(aa2(1,1),aa2t(1,1))
8192 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8193 & aa1tder(1,1,lll,kkk))
8194 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8195 & aa2tder(1,1,lll,kkk))
8199 C parallel orientation of the two CA-CA-CA frames.
8201 iti=itortyp(itype(i))
8205 itk1=itortyp(itype(k+1))
8206 itj=itortyp(itype(j))
8207 if (l.lt.nres-1) then
8208 itl1=itortyp(itype(l+1))
8212 C A1 kernel(j+1) A2T
8214 cd write (iout,'(3f10.5,5x,3f10.5)')
8215 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8217 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8218 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8219 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8220 C Following matrices are needed only for 6-th order cumulants
8221 IF (wcorr6.gt.0.0d0) THEN
8222 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8223 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8224 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8225 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8226 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8227 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8228 & ADtEAderx(1,1,1,1,1,1))
8230 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8231 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8232 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8233 & ADtEA1derx(1,1,1,1,1,1))
8235 C End 6-th order cumulants
8238 cd write (2,*) 'In calc_eello6'
8240 cd write (2,*) 'iii=',iii
8242 cd write (2,*) 'kkk=',kkk
8244 cd write (2,'(3(2f10.5),5x)')
8245 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8250 call transpose2(EUgder(1,1,k),auxmat(1,1))
8251 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8252 call transpose2(EUg(1,1,k),auxmat(1,1))
8253 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8254 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8258 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8259 & EAEAderx(1,1,lll,kkk,iii,1))
8263 C A1T kernel(i+1) A2
8264 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8265 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8266 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8267 C Following matrices are needed only for 6-th order cumulants
8268 IF (wcorr6.gt.0.0d0) THEN
8269 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8270 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8271 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8272 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8273 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8274 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8275 & ADtEAderx(1,1,1,1,1,2))
8276 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8277 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8278 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8279 & ADtEA1derx(1,1,1,1,1,2))
8281 C End 6-th order cumulants
8282 call transpose2(EUgder(1,1,l),auxmat(1,1))
8283 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8284 call transpose2(EUg(1,1,l),auxmat(1,1))
8285 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8286 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8290 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8291 & EAEAderx(1,1,lll,kkk,iii,2))
8296 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8297 C They are needed only when the fifth- or the sixth-order cumulants are
8299 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8300 call transpose2(AEA(1,1,1),auxmat(1,1))
8301 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8302 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8303 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8304 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8305 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8306 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8307 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8308 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8309 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8310 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8311 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8312 call transpose2(AEA(1,1,2),auxmat(1,1))
8313 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8314 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8315 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8316 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8317 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8318 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8319 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8320 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8321 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8322 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8323 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8324 C Calculate the Cartesian derivatives of the vectors.
8328 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8329 call matvec2(auxmat(1,1),b1(1,i),
8330 & AEAb1derx(1,lll,kkk,iii,1,1))
8331 call matvec2(auxmat(1,1),Ub2(1,i),
8332 & AEAb2derx(1,lll,kkk,iii,1,1))
8333 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8334 & AEAb1derx(1,lll,kkk,iii,2,1))
8335 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8336 & AEAb2derx(1,lll,kkk,iii,2,1))
8337 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8338 call matvec2(auxmat(1,1),b1(1,j),
8339 & AEAb1derx(1,lll,kkk,iii,1,2))
8340 call matvec2(auxmat(1,1),Ub2(1,j),
8341 & AEAb2derx(1,lll,kkk,iii,1,2))
8342 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8343 & AEAb1derx(1,lll,kkk,iii,2,2))
8344 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8345 & AEAb2derx(1,lll,kkk,iii,2,2))
8352 C Antiparallel orientation of the two CA-CA-CA frames.
8354 iti=itortyp(itype(i))
8358 itk1=itortyp(itype(k+1))
8359 itl=itortyp(itype(l))
8360 itj=itortyp(itype(j))
8361 if (j.lt.nres-1) then
8362 itj1=itortyp(itype(j+1))
8366 C A2 kernel(j-1)T A1T
8367 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8368 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8369 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8370 C Following matrices are needed only for 6-th order cumulants
8371 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8372 & j.eq.i+4 .and. l.eq.i+3)) THEN
8373 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8374 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8375 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8376 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8377 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8378 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8379 & ADtEAderx(1,1,1,1,1,1))
8380 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8381 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8382 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8383 & ADtEA1derx(1,1,1,1,1,1))
8385 C End 6-th order cumulants
8386 call transpose2(EUgder(1,1,k),auxmat(1,1))
8387 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8388 call transpose2(EUg(1,1,k),auxmat(1,1))
8389 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8390 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8394 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8395 & EAEAderx(1,1,lll,kkk,iii,1))
8399 C A2T kernel(i+1)T A1
8400 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8401 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8402 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8403 C Following matrices are needed only for 6-th order cumulants
8404 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8405 & j.eq.i+4 .and. l.eq.i+3)) THEN
8406 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8407 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8408 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8409 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8410 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8411 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8412 & ADtEAderx(1,1,1,1,1,2))
8413 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8414 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8415 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8416 & ADtEA1derx(1,1,1,1,1,2))
8418 C End 6-th order cumulants
8419 call transpose2(EUgder(1,1,j),auxmat(1,1))
8420 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8421 call transpose2(EUg(1,1,j),auxmat(1,1))
8422 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8423 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8427 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8428 & EAEAderx(1,1,lll,kkk,iii,2))
8433 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8434 C They are needed only when the fifth- or the sixth-order cumulants are
8436 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8437 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8438 call transpose2(AEA(1,1,1),auxmat(1,1))
8439 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8440 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8441 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8442 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8443 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8444 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8445 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8446 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8447 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8448 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8449 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8450 call transpose2(AEA(1,1,2),auxmat(1,1))
8451 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8452 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8453 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8454 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8455 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8456 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8457 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8458 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8459 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8460 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8461 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8462 C Calculate the Cartesian derivatives of the vectors.
8466 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8467 call matvec2(auxmat(1,1),b1(1,i),
8468 & AEAb1derx(1,lll,kkk,iii,1,1))
8469 call matvec2(auxmat(1,1),Ub2(1,i),
8470 & AEAb2derx(1,lll,kkk,iii,1,1))
8471 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8472 & AEAb1derx(1,lll,kkk,iii,2,1))
8473 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8474 & AEAb2derx(1,lll,kkk,iii,2,1))
8475 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8476 call matvec2(auxmat(1,1),b1(1,l),
8477 & AEAb1derx(1,lll,kkk,iii,1,2))
8478 call matvec2(auxmat(1,1),Ub2(1,l),
8479 & AEAb2derx(1,lll,kkk,iii,1,2))
8480 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8481 & AEAb1derx(1,lll,kkk,iii,2,2))
8482 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8483 & AEAb2derx(1,lll,kkk,iii,2,2))
8492 C---------------------------------------------------------------------------
8493 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8494 & KK,KKderg,AKA,AKAderg,AKAderx)
8498 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8499 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8500 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8505 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8507 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8510 cd if (lprn) write (2,*) 'In kernel'
8512 cd if (lprn) write (2,*) 'kkk=',kkk
8514 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8515 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8517 cd write (2,*) 'lll=',lll
8518 cd write (2,*) 'iii=1'
8520 cd write (2,'(3(2f10.5),5x)')
8521 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8524 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8525 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8527 cd write (2,*) 'lll=',lll
8528 cd write (2,*) 'iii=2'
8530 cd write (2,'(3(2f10.5),5x)')
8531 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8538 C---------------------------------------------------------------------------
8539 double precision function eello4(i,j,k,l,jj,kk)
8540 implicit real*8 (a-h,o-z)
8541 include 'DIMENSIONS'
8542 include 'COMMON.IOUNITS'
8543 include 'COMMON.CHAIN'
8544 include 'COMMON.DERIV'
8545 include 'COMMON.INTERACT'
8546 include 'COMMON.CONTACTS'
8547 include 'COMMON.TORSION'
8548 include 'COMMON.VAR'
8549 include 'COMMON.GEO'
8550 double precision pizda(2,2),ggg1(3),ggg2(3)
8551 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8555 cd print *,'eello4:',i,j,k,l,jj,kk
8556 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8557 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8558 cold eij=facont_hb(jj,i)
8559 cold ekl=facont_hb(kk,k)
8561 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8562 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8563 gcorr_loc(k-1)=gcorr_loc(k-1)
8564 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8566 gcorr_loc(l-1)=gcorr_loc(l-1)
8567 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8569 gcorr_loc(j-1)=gcorr_loc(j-1)
8570 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8575 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8576 & -EAEAderx(2,2,lll,kkk,iii,1)
8577 cd derx(lll,kkk,iii)=0.0d0
8581 cd gcorr_loc(l-1)=0.0d0
8582 cd gcorr_loc(j-1)=0.0d0
8583 cd gcorr_loc(k-1)=0.0d0
8585 cd write (iout,*)'Contacts have occurred for peptide groups',
8586 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8587 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8588 if (j.lt.nres-1) then
8595 if (l.lt.nres-1) then
8603 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8604 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8605 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8606 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8607 cgrad ghalf=0.5d0*ggg1(ll)
8608 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8609 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8610 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8611 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8612 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8613 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8614 cgrad ghalf=0.5d0*ggg2(ll)
8615 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8616 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8617 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8618 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8619 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8620 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8624 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8629 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8634 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8639 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8643 cd write (2,*) iii,gcorr_loc(iii)
8646 cd write (2,*) 'ekont',ekont
8647 cd write (iout,*) 'eello4',ekont*eel4
8650 C---------------------------------------------------------------------------
8651 double precision function eello5(i,j,k,l,jj,kk)
8652 implicit real*8 (a-h,o-z)
8653 include 'DIMENSIONS'
8654 include 'COMMON.IOUNITS'
8655 include 'COMMON.CHAIN'
8656 include 'COMMON.DERIV'
8657 include 'COMMON.INTERACT'
8658 include 'COMMON.CONTACTS'
8659 include 'COMMON.TORSION'
8660 include 'COMMON.VAR'
8661 include 'COMMON.GEO'
8662 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8663 double precision ggg1(3),ggg2(3)
8664 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8669 C /l\ / \ \ / \ / \ / C
8670 C / \ / \ \ / \ / \ / C
8671 C j| o |l1 | o | o| o | | o |o C
8672 C \ |/k\| |/ \| / |/ \| |/ \| C
8673 C \i/ \ / \ / / \ / \ C
8675 C (I) (II) (III) (IV) C
8677 C eello5_1 eello5_2 eello5_3 eello5_4 C
8679 C Antiparallel chains C
8682 C /j\ / \ \ / \ / \ / C
8683 C / \ / \ \ / \ / \ / C
8684 C j1| o |l | o | o| o | | o |o C
8685 C \ |/k\| |/ \| / |/ \| |/ \| C
8686 C \i/ \ / \ / / \ / \ C
8688 C (I) (II) (III) (IV) C
8690 C eello5_1 eello5_2 eello5_3 eello5_4 C
8692 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8694 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8695 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8700 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8702 itk=itortyp(itype(k))
8703 itl=itortyp(itype(l))
8704 itj=itortyp(itype(j))
8709 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8710 cd & eel5_3_num,eel5_4_num)
8714 derx(lll,kkk,iii)=0.0d0
8718 cd eij=facont_hb(jj,i)
8719 cd ekl=facont_hb(kk,k)
8721 cd write (iout,*)'Contacts have occurred for peptide groups',
8722 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8724 C Contribution from the graph I.
8725 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8726 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8727 call transpose2(EUg(1,1,k),auxmat(1,1))
8728 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8729 vv(1)=pizda(1,1)-pizda(2,2)
8730 vv(2)=pizda(1,2)+pizda(2,1)
8731 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8732 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8733 C Explicit gradient in virtual-dihedral angles.
8734 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8735 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8736 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8737 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8738 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8739 vv(1)=pizda(1,1)-pizda(2,2)
8740 vv(2)=pizda(1,2)+pizda(2,1)
8741 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8742 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8743 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8744 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8745 vv(1)=pizda(1,1)-pizda(2,2)
8746 vv(2)=pizda(1,2)+pizda(2,1)
8748 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8749 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8750 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8752 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8753 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8754 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8756 C Cartesian gradient
8760 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8762 vv(1)=pizda(1,1)-pizda(2,2)
8763 vv(2)=pizda(1,2)+pizda(2,1)
8764 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8765 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8766 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8772 C Contribution from graph II
8773 call transpose2(EE(1,1,itk),auxmat(1,1))
8774 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8775 vv(1)=pizda(1,1)+pizda(2,2)
8776 vv(2)=pizda(2,1)-pizda(1,2)
8777 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8778 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8779 C Explicit gradient in virtual-dihedral angles.
8780 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8781 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8782 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8783 vv(1)=pizda(1,1)+pizda(2,2)
8784 vv(2)=pizda(2,1)-pizda(1,2)
8786 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8787 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8788 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8790 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8791 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8792 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8794 C Cartesian gradient
8798 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8800 vv(1)=pizda(1,1)+pizda(2,2)
8801 vv(2)=pizda(2,1)-pizda(1,2)
8802 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8803 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8804 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8812 C Parallel orientation
8813 C Contribution from graph III
8814 call transpose2(EUg(1,1,l),auxmat(1,1))
8815 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8816 vv(1)=pizda(1,1)-pizda(2,2)
8817 vv(2)=pizda(1,2)+pizda(2,1)
8818 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8819 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8820 C Explicit gradient in virtual-dihedral angles.
8821 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8822 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8823 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8824 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8825 vv(1)=pizda(1,1)-pizda(2,2)
8826 vv(2)=pizda(1,2)+pizda(2,1)
8827 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8828 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8829 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8830 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8831 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8832 vv(1)=pizda(1,1)-pizda(2,2)
8833 vv(2)=pizda(1,2)+pizda(2,1)
8834 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8835 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8836 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8837 C Cartesian gradient
8841 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8843 vv(1)=pizda(1,1)-pizda(2,2)
8844 vv(2)=pizda(1,2)+pizda(2,1)
8845 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8846 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8847 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8852 C Contribution from graph IV
8854 call transpose2(EE(1,1,itl),auxmat(1,1))
8855 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8856 vv(1)=pizda(1,1)+pizda(2,2)
8857 vv(2)=pizda(2,1)-pizda(1,2)
8858 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8859 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8860 C Explicit gradient in virtual-dihedral angles.
8861 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8862 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8863 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8864 vv(1)=pizda(1,1)+pizda(2,2)
8865 vv(2)=pizda(2,1)-pizda(1,2)
8866 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8867 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8868 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8869 C Cartesian gradient
8873 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8875 vv(1)=pizda(1,1)+pizda(2,2)
8876 vv(2)=pizda(2,1)-pizda(1,2)
8877 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8878 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8879 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8884 C Antiparallel orientation
8885 C Contribution from graph III
8887 call transpose2(EUg(1,1,j),auxmat(1,1))
8888 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8889 vv(1)=pizda(1,1)-pizda(2,2)
8890 vv(2)=pizda(1,2)+pizda(2,1)
8891 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8892 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8893 C Explicit gradient in virtual-dihedral angles.
8894 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8895 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8896 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8897 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8898 vv(1)=pizda(1,1)-pizda(2,2)
8899 vv(2)=pizda(1,2)+pizda(2,1)
8900 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8901 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8902 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8903 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8904 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8905 vv(1)=pizda(1,1)-pizda(2,2)
8906 vv(2)=pizda(1,2)+pizda(2,1)
8907 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8908 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8909 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8910 C Cartesian gradient
8914 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8916 vv(1)=pizda(1,1)-pizda(2,2)
8917 vv(2)=pizda(1,2)+pizda(2,1)
8918 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8919 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8920 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8925 C Contribution from graph IV
8927 call transpose2(EE(1,1,itj),auxmat(1,1))
8928 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8929 vv(1)=pizda(1,1)+pizda(2,2)
8930 vv(2)=pizda(2,1)-pizda(1,2)
8931 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8932 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8933 C Explicit gradient in virtual-dihedral angles.
8934 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8935 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8936 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8937 vv(1)=pizda(1,1)+pizda(2,2)
8938 vv(2)=pizda(2,1)-pizda(1,2)
8939 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8940 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8941 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8942 C Cartesian gradient
8946 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8948 vv(1)=pizda(1,1)+pizda(2,2)
8949 vv(2)=pizda(2,1)-pizda(1,2)
8950 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8951 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8952 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8958 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8959 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8960 cd write (2,*) 'ijkl',i,j,k,l
8961 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8962 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8964 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8965 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8966 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8967 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8968 if (j.lt.nres-1) then
8975 if (l.lt.nres-1) then
8985 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8986 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8987 C summed up outside the subrouine as for the other subroutines
8988 C handling long-range interactions. The old code is commented out
8989 C with "cgrad" to keep track of changes.
8991 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8992 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8993 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8994 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8995 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8996 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8997 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8998 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8999 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9000 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9002 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9003 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9004 cgrad ghalf=0.5d0*ggg1(ll)
9006 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9007 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9008 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9009 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9010 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9011 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9012 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9013 cgrad ghalf=0.5d0*ggg2(ll)
9015 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
9016 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9017 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
9018 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9019 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9020 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9025 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9026 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9031 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9032 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9038 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9043 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9047 cd write (2,*) iii,g_corr5_loc(iii)
9050 cd write (2,*) 'ekont',ekont
9051 cd write (iout,*) 'eello5',ekont*eel5
9054 c--------------------------------------------------------------------------
9055 double precision function eello6(i,j,k,l,jj,kk)
9056 implicit real*8 (a-h,o-z)
9057 include 'DIMENSIONS'
9058 include 'COMMON.IOUNITS'
9059 include 'COMMON.CHAIN'
9060 include 'COMMON.DERIV'
9061 include 'COMMON.INTERACT'
9062 include 'COMMON.CONTACTS'
9063 include 'COMMON.TORSION'
9064 include 'COMMON.VAR'
9065 include 'COMMON.GEO'
9066 include 'COMMON.FFIELD'
9067 double precision ggg1(3),ggg2(3)
9068 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9073 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9081 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9082 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9086 derx(lll,kkk,iii)=0.0d0
9090 cd eij=facont_hb(jj,i)
9091 cd ekl=facont_hb(kk,k)
9097 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9098 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9099 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9100 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9101 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9102 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9104 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9105 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9106 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9107 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9108 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9109 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9113 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9115 C If turn contributions are considered, they will be handled separately.
9116 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9117 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9118 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9119 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9120 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9121 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9122 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9124 if (j.lt.nres-1) then
9131 if (l.lt.nres-1) then
9139 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9140 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9141 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9142 cgrad ghalf=0.5d0*ggg1(ll)
9144 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9145 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9146 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9147 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9148 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9149 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9150 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9151 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9152 cgrad ghalf=0.5d0*ggg2(ll)
9153 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9155 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9156 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9157 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9158 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9159 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9160 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9165 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9166 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9171 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9172 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9178 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9183 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9187 cd write (2,*) iii,g_corr6_loc(iii)
9190 cd write (2,*) 'ekont',ekont
9191 cd write (iout,*) 'eello6',ekont*eel6
9194 c--------------------------------------------------------------------------
9195 double precision function eello6_graph1(i,j,k,l,imat,swap)
9196 implicit real*8 (a-h,o-z)
9197 include 'DIMENSIONS'
9198 include 'COMMON.IOUNITS'
9199 include 'COMMON.CHAIN'
9200 include 'COMMON.DERIV'
9201 include 'COMMON.INTERACT'
9202 include 'COMMON.CONTACTS'
9203 include 'COMMON.TORSION'
9204 include 'COMMON.VAR'
9205 include 'COMMON.GEO'
9206 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9210 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9212 C Parallel Antiparallel C
9218 C \ j|/k\| / \ |/k\|l / C
9223 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9224 itk=itortyp(itype(k))
9225 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9226 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9227 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9228 call transpose2(EUgC(1,1,k),auxmat(1,1))
9229 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9230 vv1(1)=pizda1(1,1)-pizda1(2,2)
9231 vv1(2)=pizda1(1,2)+pizda1(2,1)
9232 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9233 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9234 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9235 s5=scalar2(vv(1),Dtobr2(1,i))
9236 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9237 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9238 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9239 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9240 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9241 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9242 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9243 & +scalar2(vv(1),Dtobr2der(1,i)))
9244 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9245 vv1(1)=pizda1(1,1)-pizda1(2,2)
9246 vv1(2)=pizda1(1,2)+pizda1(2,1)
9247 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9248 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9250 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9251 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9252 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9253 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9254 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9256 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9257 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9258 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9259 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9260 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9262 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9263 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9264 vv1(1)=pizda1(1,1)-pizda1(2,2)
9265 vv1(2)=pizda1(1,2)+pizda1(2,1)
9266 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9267 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9268 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9269 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9278 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9279 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9280 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9281 call transpose2(EUgC(1,1,k),auxmat(1,1))
9282 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9284 vv1(1)=pizda1(1,1)-pizda1(2,2)
9285 vv1(2)=pizda1(1,2)+pizda1(2,1)
9286 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9287 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9288 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9289 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9290 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9291 s5=scalar2(vv(1),Dtobr2(1,i))
9292 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9298 c----------------------------------------------------------------------------
9299 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9300 implicit real*8 (a-h,o-z)
9301 include 'DIMENSIONS'
9302 include 'COMMON.IOUNITS'
9303 include 'COMMON.CHAIN'
9304 include 'COMMON.DERIV'
9305 include 'COMMON.INTERACT'
9306 include 'COMMON.CONTACTS'
9307 include 'COMMON.TORSION'
9308 include 'COMMON.VAR'
9309 include 'COMMON.GEO'
9311 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9312 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9315 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9317 C Parallel Antiparallel C
9323 C \ j|/k\| \ |/k\|l C
9328 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9329 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9330 C AL 7/4/01 s1 would occur in the sixth-order moment,
9331 C but not in a cluster cumulant
9333 s1=dip(1,jj,i)*dip(1,kk,k)
9335 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9336 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9337 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9338 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9339 call transpose2(EUg(1,1,k),auxmat(1,1))
9340 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9341 vv(1)=pizda(1,1)-pizda(2,2)
9342 vv(2)=pizda(1,2)+pizda(2,1)
9343 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9344 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9346 eello6_graph2=-(s1+s2+s3+s4)
9348 eello6_graph2=-(s2+s3+s4)
9351 C Derivatives in gamma(i-1)
9354 s1=dipderg(1,jj,i)*dip(1,kk,k)
9356 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9357 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9358 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9359 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9361 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9363 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9365 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9367 C Derivatives in gamma(k-1)
9369 s1=dip(1,jj,i)*dipderg(1,kk,k)
9371 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9372 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9373 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9374 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9375 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9376 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9377 vv(1)=pizda(1,1)-pizda(2,2)
9378 vv(2)=pizda(1,2)+pizda(2,1)
9379 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9381 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9383 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9385 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9386 C Derivatives in gamma(j-1) or gamma(l-1)
9389 s1=dipderg(3,jj,i)*dip(1,kk,k)
9391 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9392 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9393 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9394 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9395 vv(1)=pizda(1,1)-pizda(2,2)
9396 vv(2)=pizda(1,2)+pizda(2,1)
9397 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9400 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9402 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9405 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9406 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9408 C Derivatives in gamma(l-1) or gamma(j-1)
9411 s1=dip(1,jj,i)*dipderg(3,kk,k)
9413 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9414 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9415 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9416 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9417 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9418 vv(1)=pizda(1,1)-pizda(2,2)
9419 vv(2)=pizda(1,2)+pizda(2,1)
9420 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9423 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9425 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9428 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9429 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9431 C Cartesian derivatives.
9433 write (2,*) 'In eello6_graph2'
9435 write (2,*) 'iii=',iii
9437 write (2,*) 'kkk=',kkk
9439 write (2,'(3(2f10.5),5x)')
9440 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9450 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9452 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9455 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9457 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9458 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9460 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9461 call transpose2(EUg(1,1,k),auxmat(1,1))
9462 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9464 vv(1)=pizda(1,1)-pizda(2,2)
9465 vv(2)=pizda(1,2)+pizda(2,1)
9466 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9467 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9469 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9471 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9474 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9476 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9483 c----------------------------------------------------------------------------
9484 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9485 implicit real*8 (a-h,o-z)
9486 include 'DIMENSIONS'
9487 include 'COMMON.IOUNITS'
9488 include 'COMMON.CHAIN'
9489 include 'COMMON.DERIV'
9490 include 'COMMON.INTERACT'
9491 include 'COMMON.CONTACTS'
9492 include 'COMMON.TORSION'
9493 include 'COMMON.VAR'
9494 include 'COMMON.GEO'
9495 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9497 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9499 C Parallel Antiparallel C
9505 C j|/k\| / |/k\|l / C
9510 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9512 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9513 C energy moment and not to the cluster cumulant.
9514 iti=itortyp(itype(i))
9515 if (j.lt.nres-1) then
9516 itj1=itortyp(itype(j+1))
9520 itk=itortyp(itype(k))
9521 itk1=itortyp(itype(k+1))
9522 if (l.lt.nres-1) then
9523 itl1=itortyp(itype(l+1))
9528 s1=dip(4,jj,i)*dip(4,kk,k)
9530 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9531 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9532 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9533 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9534 call transpose2(EE(1,1,itk),auxmat(1,1))
9535 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9536 vv(1)=pizda(1,1)+pizda(2,2)
9537 vv(2)=pizda(2,1)-pizda(1,2)
9538 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9539 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9540 cd & "sum",-(s2+s3+s4)
9542 eello6_graph3=-(s1+s2+s3+s4)
9544 eello6_graph3=-(s2+s3+s4)
9547 C Derivatives in gamma(k-1)
9548 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9549 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9550 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9551 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9552 C Derivatives in gamma(l-1)
9553 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9554 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9555 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9556 vv(1)=pizda(1,1)+pizda(2,2)
9557 vv(2)=pizda(2,1)-pizda(1,2)
9558 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9559 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9560 C Cartesian derivatives.
9566 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9568 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9571 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9573 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9574 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9576 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9577 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9579 vv(1)=pizda(1,1)+pizda(2,2)
9580 vv(2)=pizda(2,1)-pizda(1,2)
9581 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9583 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9585 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9588 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9590 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9592 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9598 c----------------------------------------------------------------------------
9599 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9600 implicit real*8 (a-h,o-z)
9601 include 'DIMENSIONS'
9602 include 'COMMON.IOUNITS'
9603 include 'COMMON.CHAIN'
9604 include 'COMMON.DERIV'
9605 include 'COMMON.INTERACT'
9606 include 'COMMON.CONTACTS'
9607 include 'COMMON.TORSION'
9608 include 'COMMON.VAR'
9609 include 'COMMON.GEO'
9610 include 'COMMON.FFIELD'
9611 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9612 & auxvec1(2),auxmat1(2,2)
9614 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9616 C Parallel Antiparallel C
9622 C \ j|/k\| \ |/k\|l C
9627 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9629 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9630 C energy moment and not to the cluster cumulant.
9631 cd write (2,*) 'eello_graph4: wturn6',wturn6
9632 iti=itortyp(itype(i))
9633 itj=itortyp(itype(j))
9634 if (j.lt.nres-1) then
9635 itj1=itortyp(itype(j+1))
9639 itk=itortyp(itype(k))
9640 if (k.lt.nres-1) then
9641 itk1=itortyp(itype(k+1))
9645 itl=itortyp(itype(l))
9646 if (l.lt.nres-1) then
9647 itl1=itortyp(itype(l+1))
9651 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9652 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9653 cd & ' itl',itl,' itl1',itl1
9656 s1=dip(3,jj,i)*dip(3,kk,k)
9658 s1=dip(2,jj,j)*dip(2,kk,l)
9661 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9662 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9664 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9665 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9667 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9668 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9670 call transpose2(EUg(1,1,k),auxmat(1,1))
9671 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9672 vv(1)=pizda(1,1)-pizda(2,2)
9673 vv(2)=pizda(2,1)+pizda(1,2)
9674 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9675 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9677 eello6_graph4=-(s1+s2+s3+s4)
9679 eello6_graph4=-(s2+s3+s4)
9681 C Derivatives in gamma(i-1)
9685 s1=dipderg(2,jj,i)*dip(3,kk,k)
9687 s1=dipderg(4,jj,j)*dip(2,kk,l)
9690 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9692 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9693 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9695 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9696 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9698 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9699 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9700 cd write (2,*) 'turn6 derivatives'
9702 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9704 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9708 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9710 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9714 C Derivatives in gamma(k-1)
9717 s1=dip(3,jj,i)*dipderg(2,kk,k)
9719 s1=dip(2,jj,j)*dipderg(4,kk,l)
9722 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9723 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9725 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9726 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9728 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9729 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9731 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9732 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9733 vv(1)=pizda(1,1)-pizda(2,2)
9734 vv(2)=pizda(2,1)+pizda(1,2)
9735 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9736 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9738 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9740 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9744 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9746 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9749 C Derivatives in gamma(j-1) or gamma(l-1)
9750 if (l.eq.j+1 .and. l.gt.1) then
9751 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9752 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9753 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9754 vv(1)=pizda(1,1)-pizda(2,2)
9755 vv(2)=pizda(2,1)+pizda(1,2)
9756 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9757 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9758 else if (j.gt.1) then
9759 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9760 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9761 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9762 vv(1)=pizda(1,1)-pizda(2,2)
9763 vv(2)=pizda(2,1)+pizda(1,2)
9764 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9765 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9766 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9768 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9771 C Cartesian derivatives.
9778 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9780 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9784 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9786 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9790 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9792 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9794 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9795 & b1(1,j+1),auxvec(1))
9796 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9798 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9799 & b1(1,l+1),auxvec(1))
9800 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9802 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9804 vv(1)=pizda(1,1)-pizda(2,2)
9805 vv(2)=pizda(2,1)+pizda(1,2)
9806 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9808 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9810 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9813 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9816 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9819 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9821 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9823 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9827 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9829 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9832 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9834 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9842 c----------------------------------------------------------------------------
9843 double precision function eello_turn6(i,jj,kk)
9844 implicit real*8 (a-h,o-z)
9845 include 'DIMENSIONS'
9846 include 'COMMON.IOUNITS'
9847 include 'COMMON.CHAIN'
9848 include 'COMMON.DERIV'
9849 include 'COMMON.INTERACT'
9850 include 'COMMON.CONTACTS'
9851 include 'COMMON.TORSION'
9852 include 'COMMON.VAR'
9853 include 'COMMON.GEO'
9854 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9855 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9857 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9858 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9859 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9860 C the respective energy moment and not to the cluster cumulant.
9869 iti=itortyp(itype(i))
9870 itk=itortyp(itype(k))
9871 itk1=itortyp(itype(k+1))
9872 itl=itortyp(itype(l))
9873 itj=itortyp(itype(j))
9874 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9875 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9876 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9881 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9883 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9887 derx_turn(lll,kkk,iii)=0.0d0
9894 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9896 cd write (2,*) 'eello6_5',eello6_5
9898 call transpose2(AEA(1,1,1),auxmat(1,1))
9899 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9900 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9901 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9903 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9904 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9905 s2 = scalar2(b1(1,k),vtemp1(1))
9907 call transpose2(AEA(1,1,2),atemp(1,1))
9908 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9909 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9910 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9912 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9913 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9914 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9916 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9917 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9918 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9919 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9920 ss13 = scalar2(b1(1,k),vtemp4(1))
9921 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9923 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9929 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9930 C Derivatives in gamma(i+2)
9934 call transpose2(AEA(1,1,1),auxmatd(1,1))
9935 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9936 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9937 call transpose2(AEAderg(1,1,2),atempd(1,1))
9938 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9939 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9941 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9942 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9943 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9949 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9950 C Derivatives in gamma(i+3)
9952 call transpose2(AEA(1,1,1),auxmatd(1,1))
9953 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9954 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9955 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9957 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9958 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9959 s2d = scalar2(b1(1,k),vtemp1d(1))
9961 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9962 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9964 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9966 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9967 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9968 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9976 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9977 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9979 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9980 & -0.5d0*ekont*(s2d+s12d)
9982 C Derivatives in gamma(i+4)
9983 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9984 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9985 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9987 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9988 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9989 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9997 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9999 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10001 C Derivatives in gamma(i+5)
10003 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10004 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10005 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10007 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10008 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10009 s2d = scalar2(b1(1,k),vtemp1d(1))
10011 call transpose2(AEA(1,1,2),atempd(1,1))
10012 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10013 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10015 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10016 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10018 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10019 ss13d = scalar2(b1(1,k),vtemp4d(1))
10020 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10028 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10029 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10031 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10032 & -0.5d0*ekont*(s2d+s12d)
10034 C Cartesian derivatives
10039 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10040 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10041 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10043 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10044 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10046 s2d = scalar2(b1(1,k),vtemp1d(1))
10048 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10049 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10050 s8d = -(atempd(1,1)+atempd(2,2))*
10051 & scalar2(cc(1,1,itl),vtemp2(1))
10053 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10055 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10056 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10063 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10064 & - 0.5d0*(s1d+s2d)
10066 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10070 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10071 & - 0.5d0*(s8d+s12d)
10073 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10082 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10083 & achuj_tempd(1,1))
10084 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10085 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10086 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10087 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10088 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10090 ss13d = scalar2(b1(1,k),vtemp4d(1))
10091 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10092 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10096 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10097 cd & 16*eel_turn6_num
10099 if (j.lt.nres-1) then
10106 if (l.lt.nres-1) then
10114 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10115 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10116 cgrad ghalf=0.5d0*ggg1(ll)
10118 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10119 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10120 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10121 & +ekont*derx_turn(ll,2,1)
10122 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10123 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10124 & +ekont*derx_turn(ll,4,1)
10125 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10126 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10127 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10128 cgrad ghalf=0.5d0*ggg2(ll)
10130 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10131 & +ekont*derx_turn(ll,2,2)
10132 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10133 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10134 & +ekont*derx_turn(ll,4,2)
10135 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10136 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10137 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10142 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10147 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10153 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10158 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10162 cd write (2,*) iii,g_corr6_loc(iii)
10164 eello_turn6=ekont*eel_turn6
10165 cd write (2,*) 'ekont',ekont
10166 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10170 C-----------------------------------------------------------------------------
10171 double precision function scalar(u,v)
10172 !DIR$ INLINEALWAYS scalar
10174 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10177 double precision u(3),v(3)
10178 cd double precision sc
10186 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10189 crc-------------------------------------------------
10190 SUBROUTINE MATVEC2(A1,V1,V2)
10191 !DIR$ INLINEALWAYS MATVEC2
10193 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10195 implicit real*8 (a-h,o-z)
10196 include 'DIMENSIONS'
10197 DIMENSION A1(2,2),V1(2),V2(2)
10201 c 3 VI=VI+A1(I,K)*V1(K)
10205 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10206 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10211 C---------------------------------------
10212 SUBROUTINE MATMAT2(A1,A2,A3)
10214 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10216 implicit real*8 (a-h,o-z)
10217 include 'DIMENSIONS'
10218 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10219 c DIMENSION AI3(2,2)
10223 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10229 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10230 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10231 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10232 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10240 c-------------------------------------------------------------------------
10241 double precision function scalar2(u,v)
10242 !DIR$ INLINEALWAYS scalar2
10244 double precision u(2),v(2)
10245 double precision sc
10247 scalar2=u(1)*v(1)+u(2)*v(2)
10251 C-----------------------------------------------------------------------------
10253 subroutine transpose2(a,at)
10254 !DIR$ INLINEALWAYS transpose2
10256 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10259 double precision a(2,2),at(2,2)
10266 c--------------------------------------------------------------------------
10267 subroutine transpose(n,a,at)
10270 double precision a(n,n),at(n,n)
10278 C---------------------------------------------------------------------------
10279 subroutine prodmat3(a1,a2,kk,transp,prod)
10280 !DIR$ INLINEALWAYS prodmat3
10282 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10286 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10288 crc double precision auxmat(2,2),prod_(2,2)
10291 crc call transpose2(kk(1,1),auxmat(1,1))
10292 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10293 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10295 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10296 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10297 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10298 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10299 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10300 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10301 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10302 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10305 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10306 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10308 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10309 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10310 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10311 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10312 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10313 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10314 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10315 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10318 c call transpose2(a2(1,1),a2t(1,1))
10321 crc print *,((prod_(i,j),i=1,2),j=1,2)
10322 crc print *,((prod(i,j),i=1,2),j=1,2)
10326 CCC----------------------------------------------
10327 subroutine Eliptransfer(eliptran)
10328 implicit real*8 (a-h,o-z)
10329 include 'DIMENSIONS'
10330 include 'COMMON.GEO'
10331 include 'COMMON.VAR'
10332 include 'COMMON.LOCAL'
10333 include 'COMMON.CHAIN'
10334 include 'COMMON.DERIV'
10335 include 'COMMON.NAMES'
10336 include 'COMMON.INTERACT'
10337 include 'COMMON.IOUNITS'
10338 include 'COMMON.CALC'
10339 include 'COMMON.CONTROL'
10340 include 'COMMON.SPLITELE'
10341 include 'COMMON.SBRIDGE'
10342 C this is done by Adasko
10343 C print *,"wchodze"
10344 C structure of box:
10346 C--bordliptop-- buffore starts
10347 C--bufliptop--- here true lipid starts
10349 C--buflipbot--- lipid ends buffore starts
10350 C--bordlipbot--buffore ends
10352 do i=ilip_start,ilip_end
10354 if (itype(i).eq.ntyp1) cycle
10356 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10357 if (positi.le.0) positi=positi+boxzsize
10359 C first for peptide groups
10360 c for each residue check if it is in lipid or lipid water border area
10361 if ((positi.gt.bordlipbot)
10362 &.and.(positi.lt.bordliptop)) then
10363 C the energy transfer exist
10364 if (positi.lt.buflipbot) then
10365 C what fraction I am in
10367 & ((positi-bordlipbot)/lipbufthick)
10368 C lipbufthick is thickenes of lipid buffore
10369 sslip=sscalelip(fracinbuf)
10370 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10371 eliptran=eliptran+sslip*pepliptran
10372 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10373 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10374 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10376 C print *,"doing sccale for lower part"
10377 C print *,i,sslip,fracinbuf,ssgradlip
10378 elseif (positi.gt.bufliptop) then
10379 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10380 sslip=sscalelip(fracinbuf)
10381 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10382 eliptran=eliptran+sslip*pepliptran
10383 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10384 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10385 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10386 C print *, "doing sscalefor top part"
10387 C print *,i,sslip,fracinbuf,ssgradlip
10389 eliptran=eliptran+pepliptran
10390 C print *,"I am in true lipid"
10393 C eliptran=elpitran+0.0 ! I am in water
10396 C print *, "nic nie bylo w lipidzie?"
10397 C now multiply all by the peptide group transfer factor
10398 C eliptran=eliptran*pepliptran
10399 C now the same for side chains
10401 do i=ilip_start,ilip_end
10402 if (itype(i).eq.ntyp1) cycle
10403 positi=(mod(c(3,i+nres),boxzsize))
10404 if (positi.le.0) positi=positi+boxzsize
10405 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10406 c for each residue check if it is in lipid or lipid water border area
10407 C respos=mod(c(3,i+nres),boxzsize)
10408 C print *,positi,bordlipbot,buflipbot
10409 if ((positi.gt.bordlipbot)
10410 & .and.(positi.lt.bordliptop)) then
10411 C the energy transfer exist
10412 if (positi.lt.buflipbot) then
10414 & ((positi-bordlipbot)/lipbufthick)
10415 C lipbufthick is thickenes of lipid buffore
10416 sslip=sscalelip(fracinbuf)
10417 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10418 eliptran=eliptran+sslip*liptranene(itype(i))
10419 gliptranx(3,i)=gliptranx(3,i)
10420 &+ssgradlip*liptranene(itype(i))
10421 gliptranc(3,i-1)= gliptranc(3,i-1)
10422 &+ssgradlip*liptranene(itype(i))
10423 C print *,"doing sccale for lower part"
10424 elseif (positi.gt.bufliptop) then
10426 &((bordliptop-positi)/lipbufthick)
10427 sslip=sscalelip(fracinbuf)
10428 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10429 eliptran=eliptran+sslip*liptranene(itype(i))
10430 gliptranx(3,i)=gliptranx(3,i)
10431 &+ssgradlip*liptranene(itype(i))
10432 gliptranc(3,i-1)= gliptranc(3,i-1)
10433 &+ssgradlip*liptranene(itype(i))
10434 C print *, "doing sscalefor top part",sslip,fracinbuf
10436 eliptran=eliptran+liptranene(itype(i))
10437 C print *,"I am in true lipid"
10439 endif ! if in lipid or buffor
10441 C eliptran=elpitran+0.0 ! I am in water
10445 C---------------------------------------------------------
10446 C AFM soubroutine for constant force
10447 subroutine AFMforce(Eafmforce)
10448 implicit real*8 (a-h,o-z)
10449 include 'DIMENSIONS'
10450 include 'COMMON.GEO'
10451 include 'COMMON.VAR'
10452 include 'COMMON.LOCAL'
10453 include 'COMMON.CHAIN'
10454 include 'COMMON.DERIV'
10455 include 'COMMON.NAMES'
10456 include 'COMMON.INTERACT'
10457 include 'COMMON.IOUNITS'
10458 include 'COMMON.CALC'
10459 include 'COMMON.CONTROL'
10460 include 'COMMON.SPLITELE'
10461 include 'COMMON.SBRIDGE'
10466 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10467 dist=dist+diffafm(i)**2
10470 Eafmforce=-forceAFMconst*(dist-distafminit)
10472 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
10473 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
10475 C print *,'AFM',Eafmforce
10478 C---------------------------------------------------------
10479 C AFM subroutine with pseudoconstant velocity
10480 subroutine AFMvel(Eafmforce)
10481 implicit real*8 (a-h,o-z)
10482 include 'DIMENSIONS'
10483 include 'COMMON.GEO'
10484 include 'COMMON.VAR'
10485 include 'COMMON.LOCAL'
10486 include 'COMMON.CHAIN'
10487 include 'COMMON.DERIV'
10488 include 'COMMON.NAMES'
10489 include 'COMMON.INTERACT'
10490 include 'COMMON.IOUNITS'
10491 include 'COMMON.CALC'
10492 include 'COMMON.CONTROL'
10493 include 'COMMON.SPLITELE'
10494 include 'COMMON.SBRIDGE'
10496 C Only for check grad COMMENT if not used for checkgrad
10498 C--------------------------------------------------------
10499 C print *,"wchodze"
10503 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10504 dist=dist+diffafm(i)**2
10507 Eafmforce=0.5d0*forceAFMconst
10508 & *(distafminit+totTafm*velAFMconst-dist)**2
10509 C Eafmforce=-forceAFMconst*(dist-distafminit)
10511 gradafm(i,afmend-1)=-forceAFMconst*
10512 &(distafminit+totTafm*velAFMconst-dist)
10514 gradafm(i,afmbeg-1)=forceAFMconst*
10515 &(distafminit+totTafm*velAFMconst-dist)
10518 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
10521 C-----------------------------------------------------------
10522 C first for shielding is setting of function of side-chains
10523 subroutine set_shield_fac
10524 implicit real*8 (a-h,o-z)
10525 include 'DIMENSIONS'
10526 include 'COMMON.CHAIN'
10527 include 'COMMON.DERIV'
10528 include 'COMMON.IOUNITS'
10529 include 'COMMON.SHIELD'
10530 include 'COMMON.INTERACT'
10531 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10532 double precision div77_81/0.974996043d0/,
10533 &div4_81/0.2222222222d0/
10535 C the vector between center of side_chain and peptide group
10536 double precision pep_side(3),long,side_calf(3),
10538 C the line belowe needs to be changed for FGPROC>1
10540 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10542 Cif there two consequtive dummy atoms there is no peptide group between them
10543 C the line below has to be changed for FGPROC>1
10549 C first lets set vector conecting the ithe side-chain with kth side-chain
10550 pep_side(j)=c(k+nres,j)-(c(i,j)+c(i+1,j))/2.0d0
10551 C and vector conecting the side-chain with its proper calfa
10552 side_calf(j)=c(k+nres,j)-c(k,j)
10553 pept_group(j)=c(i,j)-c(i+1,j)
10554 C lets have their lenght
10555 dist_pep_side=pep_side(j)**2+dist_pep_side
10556 dist_side_calf=dist_side_calf+side_calf(j)**2
10557 dist_pept_group=dist_pept_group+pept_group(j)**2
10559 dist_pep_side=dsqrt(dist_pep_side)
10560 dist_pept_group=dsqrt(dist_pept_group)
10561 C now sscale fraction
10562 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10564 if (sh_frac_dist.le.0.0) cycle
10565 C If we reach here it means that this side chain reaches the shielding sphere
10566 C Lets add him to the list for gradient
10567 ishield_list(i)=ishield_list(i)+1
10568 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10569 C this list is essential otherwise problem would be O3
10570 shield_list(ishield_list)=k
10571 C Lets have the sscale value
10572 if (sh_frac_dist.gt.1.0) then
10573 scale_fac_dist=1.0d0
10575 sh_frac_dist_grad(j)=0.0d0
10578 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10579 & *(2.0*sh_frac_dist-3.0d0)
10580 fac_help_scale=6.0*(scale_fac_dist-scale_fac_dist**2)
10581 & /dist_pep_side/buff_shield*0.5
10582 C remember for the final gradient multiply sh_frac_dist_grad(j)
10583 C for side_chain by factor -2 !
10585 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10588 C this is what is now we have the distance scaling now volume...
10589 short=short_r_sidechain(itype(k))
10590 long=long_r_sidechain(itype(k))
10591 costhet=1.0d0/dsqrt(1+short**2/dist_pep_side**2)
10593 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side
10595 costhet_grad(j)=costhet_fac*pep_side(j)
10597 C remember for the final gradient multiply costhet_grad(j)
10598 C for side_chain by factor -2 !
10599 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10600 C pep_side0pept_group is vector multiplication
10601 pep_side0pept_group=0.0
10603 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10605 fac_alfa_sin=1.0-(pep_side0pept_group/
10606 & (dist_pep_side*dist_side_calf))**2
10607 fac_alfa_sin=dsqrt(fac_alfa_sin)
10608 rkprim=fac_alfa_sin*(long-short)+short
10609 cosphi=1.0d0/dsqrt(1+rkprim**2/dist_pep_side**2)
10610 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
10612 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10613 C if ((cosphi.le.0.0).or.(costhet.le.0.0)) write(iout,*) "ERROR",
10615 C now should be fac_side_grad(k) which will be gradient of factor k which also
10616 C affect the gradient of peptide group i fac_pept_grad(i) and i+1
10617 write(2,*) "myvolume",VofOverlap,VSolvSphere_div,VolumeTotal
10619 C write(2,*) "TOTAL VOLUME",i,VolumeTotal
10620 C the scaling factor of the shielding effect
10621 fac_shield(i)=VolumeTotal*div77_81+div4_81
10622 write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)