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 C 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)
549 & +welec*gshieldc(j,i)
556 gradbufc(j,i)=wsc*gvdwc(j,i)+
557 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
558 & welec*gelc_long(j,i)+
560 & wel_loc*gel_loc_long(j,i)+
561 & wcorr*gradcorr_long(j,i)+
562 & wcorr5*gradcorr5_long(j,i)+
563 & wcorr6*gradcorr6_long(j,i)+
564 & wturn6*gcorr6_turn_long(j,i)+
566 & +wliptran*gliptranc(j,i)
568 & +welec*gshieldc(j,i)
574 if (nfgtasks.gt.1) then
577 write (iout,*) "gradbufc before allreduce"
579 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
585 gradbufc_sum(j,i)=gradbufc(j,i)
588 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
589 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
590 c time_reduce=time_reduce+MPI_Wtime()-time00
592 c write (iout,*) "gradbufc_sum after allreduce"
594 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
599 c time_allreduce=time_allreduce+MPI_Wtime()-time00
607 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
608 write (iout,*) (i," jgrad_start",jgrad_start(i),
609 & " jgrad_end ",jgrad_end(i),
610 & i=igrad_start,igrad_end)
613 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
614 c do not parallelize this part.
616 c do i=igrad_start,igrad_end
617 c do j=jgrad_start(i),jgrad_end(i)
619 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
624 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
628 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
632 write (iout,*) "gradbufc after summing"
634 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
641 write (iout,*) "gradbufc"
643 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
649 gradbufc_sum(j,i)=gradbufc(j,i)
654 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
658 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
663 c gradbufc(k,i)=0.0d0
667 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
672 write (iout,*) "gradbufc after summing"
674 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
682 gradbufc(k,nres)=0.0d0
687 C print *,gradbufc(1,13)
688 C print *,welec*gelc(1,13)
689 C print *,wel_loc*gel_loc(1,13)
690 C print *,0.5d0*(wscp*gvdwc_scpp(1,13))
691 C print *,welec*gelc_long(1,13)+wvdwpp*gvdwpp(1,13)
692 C print *,wel_loc*gel_loc_long(1,13)
693 C print *,gradafm(1,13),"AFM"
694 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
695 & wel_loc*gel_loc(j,i)+
696 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
697 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
698 & wel_loc*gel_loc_long(j,i)+
699 & wcorr*gradcorr_long(j,i)+
700 & wcorr5*gradcorr5_long(j,i)+
701 & wcorr6*gradcorr6_long(j,i)+
702 & wturn6*gcorr6_turn_long(j,i))+
704 & wcorr*gradcorr(j,i)+
705 & wturn3*gcorr3_turn(j,i)+
706 & wturn4*gcorr4_turn(j,i)+
707 & wcorr5*gradcorr5(j,i)+
708 & wcorr6*gradcorr6(j,i)+
709 & wturn6*gcorr6_turn(j,i)+
710 & wsccor*gsccorc(j,i)
711 & +wscloc*gscloc(j,i)
712 & +wliptran*gliptranc(j,i)
714 & +welec*gshieldc(j,i)
715 & +welec*gshieldc_loc(j,i)
719 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
720 & wel_loc*gel_loc(j,i)+
721 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
722 & welec*gelc_long(j,i)
723 & wel_loc*gel_loc_long(j,i)+
724 & wcorr*gcorr_long(j,i)+
725 & wcorr5*gradcorr5_long(j,i)+
726 & wcorr6*gradcorr6_long(j,i)+
727 & wturn6*gcorr6_turn_long(j,i))+
729 & wcorr*gradcorr(j,i)+
730 & wturn3*gcorr3_turn(j,i)+
731 & wturn4*gcorr4_turn(j,i)+
732 & wcorr5*gradcorr5(j,i)+
733 & wcorr6*gradcorr6(j,i)+
734 & wturn6*gcorr6_turn(j,i)+
735 & wsccor*gsccorc(j,i)
736 & +wscloc*gscloc(j,i)
737 & +wliptran*gliptranc(j,i)
739 & +welec*gshieldc(j,i)
740 & +welec*gshieldc_loc(j,i)
744 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
746 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
747 & wsccor*gsccorx(j,i)
748 & +wscloc*gsclocx(j,i)
749 & +wliptran*gliptranx(j,i)
750 & +welec*gshieldx(j,i)
754 write (iout,*) "gloc before adding corr"
756 write (iout,*) i,gloc(i,icg)
760 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
761 & +wcorr5*g_corr5_loc(i)
762 & +wcorr6*g_corr6_loc(i)
763 & +wturn4*gel_loc_turn4(i)
764 & +wturn3*gel_loc_turn3(i)
765 & +wturn6*gel_loc_turn6(i)
766 & +wel_loc*gel_loc_loc(i)
769 write (iout,*) "gloc after adding corr"
771 write (iout,*) i,gloc(i,icg)
775 if (nfgtasks.gt.1) then
778 gradbufc(j,i)=gradc(j,i,icg)
779 gradbufx(j,i)=gradx(j,i,icg)
783 glocbuf(i)=gloc(i,icg)
787 write (iout,*) "gloc_sc before reduce"
790 write (iout,*) i,j,gloc_sc(j,i,icg)
797 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
801 call MPI_Barrier(FG_COMM,IERR)
802 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
804 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
805 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
806 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
807 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
808 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
809 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
810 time_reduce=time_reduce+MPI_Wtime()-time00
811 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
812 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
813 time_reduce=time_reduce+MPI_Wtime()-time00
816 write (iout,*) "gloc_sc after reduce"
819 write (iout,*) i,j,gloc_sc(j,i,icg)
825 write (iout,*) "gloc after reduce"
827 write (iout,*) i,gloc(i,icg)
832 if (gnorm_check) then
834 c Compute the maximum elements of the gradient
844 gcorr3_turn_max=0.0d0
845 gcorr4_turn_max=0.0d0
848 gcorr6_turn_max=0.0d0
858 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
859 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
860 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
861 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
862 & gvdwc_scp_max=gvdwc_scp_norm
863 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
864 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
865 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
866 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
867 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
868 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
869 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
870 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
871 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
872 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
873 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
874 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
875 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
877 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
878 & gcorr3_turn_max=gcorr3_turn_norm
879 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
881 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
882 & gcorr4_turn_max=gcorr4_turn_norm
883 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
884 if (gradcorr5_norm.gt.gradcorr5_max)
885 & gradcorr5_max=gradcorr5_norm
886 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
887 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
888 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
890 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
891 & gcorr6_turn_max=gcorr6_turn_norm
892 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
893 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
894 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
895 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
896 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
897 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
898 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
899 if (gradx_scp_norm.gt.gradx_scp_max)
900 & gradx_scp_max=gradx_scp_norm
901 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
902 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
903 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
904 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
905 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
906 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
907 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
908 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
912 open(istat,file=statname,position="append")
914 open(istat,file=statname,access="append")
916 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
917 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
918 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
919 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
920 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
921 & gsccorx_max,gsclocx_max
923 if (gvdwc_max.gt.1.0d4) then
924 write (iout,*) "gvdwc gvdwx gradb gradbx"
926 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
927 & gradb(j,i),gradbx(j,i),j=1,3)
929 call pdbout(0.0d0,'cipiszcze',iout)
935 write (iout,*) "gradc gradx gloc"
937 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
938 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
942 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
946 c-------------------------------------------------------------------------------
947 subroutine rescale_weights(t_bath)
948 implicit real*8 (a-h,o-z)
950 include 'COMMON.IOUNITS'
951 include 'COMMON.FFIELD'
952 include 'COMMON.SBRIDGE'
953 double precision kfac /2.4d0/
954 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
956 c facT=2*temp0/(t_bath+temp0)
957 if (rescale_mode.eq.0) then
963 else if (rescale_mode.eq.1) then
964 facT=kfac/(kfac-1.0d0+t_bath/temp0)
965 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
966 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
967 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
968 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
969 else if (rescale_mode.eq.2) then
975 facT=licznik/dlog(dexp(x)+dexp(-x))
976 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
977 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
978 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
979 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
981 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
982 write (*,*) "Wrong RESCALE_MODE",rescale_mode
984 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
988 welec=weights(3)*fact
989 wcorr=weights(4)*fact3
990 wcorr5=weights(5)*fact4
991 wcorr6=weights(6)*fact5
992 wel_loc=weights(7)*fact2
993 wturn3=weights(8)*fact2
994 wturn4=weights(9)*fact3
995 wturn6=weights(10)*fact5
996 wtor=weights(13)*fact
997 wtor_d=weights(14)*fact2
998 wsccor=weights(21)*fact
1002 C------------------------------------------------------------------------
1003 subroutine enerprint(energia)
1004 implicit real*8 (a-h,o-z)
1005 include 'DIMENSIONS'
1006 include 'COMMON.IOUNITS'
1007 include 'COMMON.FFIELD'
1008 include 'COMMON.SBRIDGE'
1010 double precision energia(0:n_ene)
1015 evdw2=energia(2)+energia(18)
1027 eello_turn3=energia(8)
1028 eello_turn4=energia(9)
1029 eello_turn6=energia(10)
1035 edihcnstr=energia(19)
1039 eliptran=energia(22)
1040 Eafmforce=energia(23)
1041 ethetacnstr=energia(24)
1043 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1044 & estr,wbond,ebe,wang,
1045 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1047 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1048 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1049 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1051 10 format (/'Virtual-chain energies:'//
1052 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1053 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1054 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1055 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1056 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1057 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1058 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1059 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1060 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1061 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1062 & ' (SS bridges & dist. cnstr.)'/
1063 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1064 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1065 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1066 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1067 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1068 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1069 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1070 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1071 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1072 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1073 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1074 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1075 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1076 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1077 & 'ETOT= ',1pE16.6,' (total)')
1080 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1081 & estr,wbond,ebe,wang,
1082 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1084 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1085 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1086 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1088 10 format (/'Virtual-chain energies:'//
1089 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1090 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1091 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1092 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1093 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1094 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1095 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1096 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1097 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1098 & ' (SS bridges & dist. cnstr.)'/
1099 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1100 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1101 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1102 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1103 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1104 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1105 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1106 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1107 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1108 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1109 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1110 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1111 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1112 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1113 & 'ETOT= ',1pE16.6,' (total)')
1117 C-----------------------------------------------------------------------
1118 subroutine elj(evdw)
1120 C This subroutine calculates the interaction energy of nonbonded side chains
1121 C assuming the LJ potential of interaction.
1123 implicit real*8 (a-h,o-z)
1124 include 'DIMENSIONS'
1125 parameter (accur=1.0d-10)
1126 include 'COMMON.GEO'
1127 include 'COMMON.VAR'
1128 include 'COMMON.LOCAL'
1129 include 'COMMON.CHAIN'
1130 include 'COMMON.DERIV'
1131 include 'COMMON.INTERACT'
1132 include 'COMMON.TORSION'
1133 include 'COMMON.SBRIDGE'
1134 include 'COMMON.NAMES'
1135 include 'COMMON.IOUNITS'
1136 include 'COMMON.CONTACTS'
1138 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1140 do i=iatsc_s,iatsc_e
1141 itypi=iabs(itype(i))
1142 if (itypi.eq.ntyp1) cycle
1143 itypi1=iabs(itype(i+1))
1150 C Calculate SC interaction energy.
1152 do iint=1,nint_gr(i)
1153 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1154 cd & 'iend=',iend(i,iint)
1155 do j=istart(i,iint),iend(i,iint)
1156 itypj=iabs(itype(j))
1157 if (itypj.eq.ntyp1) cycle
1161 C Change 12/1/95 to calculate four-body interactions
1162 rij=xj*xj+yj*yj+zj*zj
1164 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1165 eps0ij=eps(itypi,itypj)
1167 C have you changed here?
1171 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1172 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1173 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1174 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1175 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1176 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1179 C Calculate the components of the gradient in DC and X
1181 fac=-rrij*(e1+evdwij)
1186 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1187 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1188 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1189 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1193 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1197 C 12/1/95, revised on 5/20/97
1199 C Calculate the contact function. The ith column of the array JCONT will
1200 C contain the numbers of atoms that make contacts with the atom I (of numbers
1201 C greater than I). The arrays FACONT and GACONT will contain the values of
1202 C the contact function and its derivative.
1204 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1205 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1206 C Uncomment next line, if the correlation interactions are contact function only
1207 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1209 sigij=sigma(itypi,itypj)
1210 r0ij=rs0(itypi,itypj)
1212 C Check whether the SC's are not too far to make a contact.
1215 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1216 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1218 if (fcont.gt.0.0D0) then
1219 C If the SC-SC distance if close to sigma, apply spline.
1220 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1221 cAdam & fcont1,fprimcont1)
1222 cAdam fcont1=1.0d0-fcont1
1223 cAdam if (fcont1.gt.0.0d0) then
1224 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1225 cAdam fcont=fcont*fcont1
1227 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1228 cga eps0ij=1.0d0/dsqrt(eps0ij)
1230 cga gg(k)=gg(k)*eps0ij
1232 cga eps0ij=-evdwij*eps0ij
1233 C Uncomment for AL's type of SC correlation interactions.
1234 cadam eps0ij=-evdwij
1235 num_conti=num_conti+1
1236 jcont(num_conti,i)=j
1237 facont(num_conti,i)=fcont*eps0ij
1238 fprimcont=eps0ij*fprimcont/rij
1240 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1241 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1242 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1243 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1244 gacont(1,num_conti,i)=-fprimcont*xj
1245 gacont(2,num_conti,i)=-fprimcont*yj
1246 gacont(3,num_conti,i)=-fprimcont*zj
1247 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1248 cd write (iout,'(2i3,3f10.5)')
1249 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1255 num_cont(i)=num_conti
1259 gvdwc(j,i)=expon*gvdwc(j,i)
1260 gvdwx(j,i)=expon*gvdwx(j,i)
1263 C******************************************************************************
1267 C To save time, the factor of EXPON has been extracted from ALL components
1268 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1271 C******************************************************************************
1274 C-----------------------------------------------------------------------------
1275 subroutine eljk(evdw)
1277 C This subroutine calculates the interaction energy of nonbonded side chains
1278 C assuming the LJK potential of interaction.
1280 implicit real*8 (a-h,o-z)
1281 include 'DIMENSIONS'
1282 include 'COMMON.GEO'
1283 include 'COMMON.VAR'
1284 include 'COMMON.LOCAL'
1285 include 'COMMON.CHAIN'
1286 include 'COMMON.DERIV'
1287 include 'COMMON.INTERACT'
1288 include 'COMMON.IOUNITS'
1289 include 'COMMON.NAMES'
1292 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1294 do i=iatsc_s,iatsc_e
1295 itypi=iabs(itype(i))
1296 if (itypi.eq.ntyp1) cycle
1297 itypi1=iabs(itype(i+1))
1302 C Calculate SC interaction energy.
1304 do iint=1,nint_gr(i)
1305 do j=istart(i,iint),iend(i,iint)
1306 itypj=iabs(itype(j))
1307 if (itypj.eq.ntyp1) cycle
1311 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1312 fac_augm=rrij**expon
1313 e_augm=augm(itypi,itypj)*fac_augm
1314 r_inv_ij=dsqrt(rrij)
1316 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1317 fac=r_shift_inv**expon
1318 C have you changed here?
1322 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1323 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1324 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1325 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1326 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1327 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1328 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1331 C Calculate the components of the gradient in DC and X
1333 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1338 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1339 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1340 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1341 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1345 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1353 gvdwc(j,i)=expon*gvdwc(j,i)
1354 gvdwx(j,i)=expon*gvdwx(j,i)
1359 C-----------------------------------------------------------------------------
1360 subroutine ebp(evdw)
1362 C This subroutine calculates the interaction energy of nonbonded side chains
1363 C assuming the Berne-Pechukas potential of interaction.
1365 implicit real*8 (a-h,o-z)
1366 include 'DIMENSIONS'
1367 include 'COMMON.GEO'
1368 include 'COMMON.VAR'
1369 include 'COMMON.LOCAL'
1370 include 'COMMON.CHAIN'
1371 include 'COMMON.DERIV'
1372 include 'COMMON.NAMES'
1373 include 'COMMON.INTERACT'
1374 include 'COMMON.IOUNITS'
1375 include 'COMMON.CALC'
1376 common /srutu/ icall
1377 c double precision rrsave(maxdim)
1380 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1382 c if (icall.eq.0) then
1388 do i=iatsc_s,iatsc_e
1389 itypi=iabs(itype(i))
1390 if (itypi.eq.ntyp1) cycle
1391 itypi1=iabs(itype(i+1))
1395 dxi=dc_norm(1,nres+i)
1396 dyi=dc_norm(2,nres+i)
1397 dzi=dc_norm(3,nres+i)
1398 c dsci_inv=dsc_inv(itypi)
1399 dsci_inv=vbld_inv(i+nres)
1401 C Calculate SC interaction energy.
1403 do iint=1,nint_gr(i)
1404 do j=istart(i,iint),iend(i,iint)
1406 itypj=iabs(itype(j))
1407 if (itypj.eq.ntyp1) cycle
1408 c dscj_inv=dsc_inv(itypj)
1409 dscj_inv=vbld_inv(j+nres)
1410 chi1=chi(itypi,itypj)
1411 chi2=chi(itypj,itypi)
1418 alf12=0.5D0*(alf1+alf2)
1419 C For diagnostics only!!!
1432 dxj=dc_norm(1,nres+j)
1433 dyj=dc_norm(2,nres+j)
1434 dzj=dc_norm(3,nres+j)
1435 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1436 cd if (icall.eq.0) then
1442 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1444 C Calculate whole angle-dependent part of epsilon and contributions
1445 C to its derivatives
1446 C have you changed here?
1447 fac=(rrij*sigsq)**expon2
1450 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1451 eps2der=evdwij*eps3rt
1452 eps3der=evdwij*eps2rt
1453 evdwij=evdwij*eps2rt*eps3rt
1456 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1458 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1459 cd & restyp(itypi),i,restyp(itypj),j,
1460 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1461 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1462 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1465 C Calculate gradient components.
1466 e1=e1*eps1*eps2rt**2*eps3rt**2
1467 fac=-expon*(e1+evdwij)
1470 C Calculate radial part of the gradient
1474 C Calculate the angular part of the gradient and sum add the contributions
1475 C to the appropriate components of the Cartesian gradient.
1483 C-----------------------------------------------------------------------------
1484 subroutine egb(evdw)
1486 C This subroutine calculates the interaction energy of nonbonded side chains
1487 C assuming the Gay-Berne potential of interaction.
1489 implicit real*8 (a-h,o-z)
1490 include 'DIMENSIONS'
1491 include 'COMMON.GEO'
1492 include 'COMMON.VAR'
1493 include 'COMMON.LOCAL'
1494 include 'COMMON.CHAIN'
1495 include 'COMMON.DERIV'
1496 include 'COMMON.NAMES'
1497 include 'COMMON.INTERACT'
1498 include 'COMMON.IOUNITS'
1499 include 'COMMON.CALC'
1500 include 'COMMON.CONTROL'
1501 include 'COMMON.SPLITELE'
1502 include 'COMMON.SBRIDGE'
1504 integer xshift,yshift,zshift
1507 ccccc energy_dec=.false.
1508 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1511 c if (icall.eq.0) lprn=.false.
1513 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1514 C we have the original box)
1518 do i=iatsc_s,iatsc_e
1519 itypi=iabs(itype(i))
1520 if (itypi.eq.ntyp1) cycle
1521 itypi1=iabs(itype(i+1))
1525 C Return atom into box, boxxsize is size of box in x dimension
1527 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1528 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1529 C Condition for being inside the proper box
1530 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1531 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1535 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1536 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1537 C Condition for being inside the proper box
1538 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1539 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1543 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1544 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1545 C Condition for being inside the proper box
1546 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1547 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1551 if (xi.lt.0) xi=xi+boxxsize
1553 if (yi.lt.0) yi=yi+boxysize
1555 if (zi.lt.0) zi=zi+boxzsize
1556 C define scaling factor for lipids
1558 C if (positi.le.0) positi=positi+boxzsize
1560 C first for peptide groups
1561 c for each residue check if it is in lipid or lipid water border area
1562 if ((zi.gt.bordlipbot)
1563 &.and.(zi.lt.bordliptop)) then
1564 C the energy transfer exist
1565 if (zi.lt.buflipbot) then
1566 C what fraction I am in
1568 & ((zi-bordlipbot)/lipbufthick)
1569 C lipbufthick is thickenes of lipid buffore
1570 sslipi=sscalelip(fracinbuf)
1571 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1572 elseif (zi.gt.bufliptop) then
1573 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1574 sslipi=sscalelip(fracinbuf)
1575 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1585 C xi=xi+xshift*boxxsize
1586 C yi=yi+yshift*boxysize
1587 C zi=zi+zshift*boxzsize
1589 dxi=dc_norm(1,nres+i)
1590 dyi=dc_norm(2,nres+i)
1591 dzi=dc_norm(3,nres+i)
1592 c dsci_inv=dsc_inv(itypi)
1593 dsci_inv=vbld_inv(i+nres)
1594 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1595 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1597 C Calculate SC interaction energy.
1599 do iint=1,nint_gr(i)
1600 do j=istart(i,iint),iend(i,iint)
1601 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1603 c write(iout,*) "PRZED ZWYKLE", evdwij
1604 call dyn_ssbond_ene(i,j,evdwij)
1605 c write(iout,*) "PO ZWYKLE", evdwij
1608 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1609 & 'evdw',i,j,evdwij,' ss'
1610 C triple bond artifac removal
1611 do k=j+1,iend(i,iint)
1612 C search over all next residues
1613 if (dyn_ss_mask(k)) then
1614 C check if they are cysteins
1615 C write(iout,*) 'k=',k
1617 c write(iout,*) "PRZED TRI", evdwij
1618 evdwij_przed_tri=evdwij
1619 call triple_ssbond_ene(i,j,k,evdwij)
1620 c if(evdwij_przed_tri.ne.evdwij) then
1621 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1624 c write(iout,*) "PO TRI", evdwij
1625 C call the energy function that removes the artifical triple disulfide
1626 C bond the soubroutine is located in ssMD.F
1628 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1629 & 'evdw',i,j,evdwij,'tss'
1630 endif!dyn_ss_mask(k)
1634 itypj=iabs(itype(j))
1635 if (itypj.eq.ntyp1) cycle
1636 c dscj_inv=dsc_inv(itypj)
1637 dscj_inv=vbld_inv(j+nres)
1638 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1639 c & 1.0d0/vbld(j+nres)
1640 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1641 sig0ij=sigma(itypi,itypj)
1642 chi1=chi(itypi,itypj)
1643 chi2=chi(itypj,itypi)
1650 alf12=0.5D0*(alf1+alf2)
1651 C For diagnostics only!!!
1664 C Return atom J into box the original box
1666 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1667 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1668 C Condition for being inside the proper box
1669 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1670 c & (xj.lt.((-0.5d0)*boxxsize))) then
1674 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1675 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1676 C Condition for being inside the proper box
1677 c if ((yj.gt.((0.5d0)*boxysize)).or.
1678 c & (yj.lt.((-0.5d0)*boxysize))) then
1682 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1683 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1684 C Condition for being inside the proper box
1685 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1686 c & (zj.lt.((-0.5d0)*boxzsize))) then
1690 if (xj.lt.0) xj=xj+boxxsize
1692 if (yj.lt.0) yj=yj+boxysize
1694 if (zj.lt.0) zj=zj+boxzsize
1695 if ((zj.gt.bordlipbot)
1696 &.and.(zj.lt.bordliptop)) then
1697 C the energy transfer exist
1698 if (zj.lt.buflipbot) then
1699 C what fraction I am in
1701 & ((zj-bordlipbot)/lipbufthick)
1702 C lipbufthick is thickenes of lipid buffore
1703 sslipj=sscalelip(fracinbuf)
1704 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1705 elseif (zj.gt.bufliptop) then
1706 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1707 sslipj=sscalelip(fracinbuf)
1708 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1717 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1718 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1719 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1720 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1721 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1722 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1723 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1724 C print *,sslipi,sslipj,bordlipbot,zi,zj
1725 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1733 xj=xj_safe+xshift*boxxsize
1734 yj=yj_safe+yshift*boxysize
1735 zj=zj_safe+zshift*boxzsize
1736 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1737 if(dist_temp.lt.dist_init) then
1747 if (subchap.eq.1) then
1756 dxj=dc_norm(1,nres+j)
1757 dyj=dc_norm(2,nres+j)
1758 dzj=dc_norm(3,nres+j)
1762 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1763 c write (iout,*) "j",j," dc_norm",
1764 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1765 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1767 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1768 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1770 c write (iout,'(a7,4f8.3)')
1771 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1772 if (sss.gt.0.0d0) then
1773 C Calculate angle-dependent terms of energy and contributions to their
1777 sig=sig0ij*dsqrt(sigsq)
1778 rij_shift=1.0D0/rij-sig+sig0ij
1779 c for diagnostics; uncomment
1780 c rij_shift=1.2*sig0ij
1781 C I hate to put IF's in the loops, but here don't have another choice!!!!
1782 if (rij_shift.le.0.0D0) then
1784 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1785 cd & restyp(itypi),i,restyp(itypj),j,
1786 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1790 c---------------------------------------------------------------
1791 rij_shift=1.0D0/rij_shift
1792 fac=rij_shift**expon
1793 C here to start with
1798 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1799 eps2der=evdwij*eps3rt
1800 eps3der=evdwij*eps2rt
1801 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1802 C &((sslipi+sslipj)/2.0d0+
1803 C &(2.0d0-sslipi-sslipj)/2.0d0)
1804 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1805 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1806 evdwij=evdwij*eps2rt*eps3rt
1807 evdw=evdw+evdwij*sss
1809 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1811 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1812 & restyp(itypi),i,restyp(itypj),j,
1813 & epsi,sigm,chi1,chi2,chip1,chip2,
1814 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1815 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1819 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1822 C Calculate gradient components.
1823 e1=e1*eps1*eps2rt**2*eps3rt**2
1824 fac=-expon*(e1+evdwij)*rij_shift
1827 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1828 c & evdwij,fac,sigma(itypi,itypj),expon
1829 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1831 C Calculate the radial part of the gradient
1832 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1833 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1834 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1835 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1836 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1837 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1843 C Calculate angular part of the gradient.
1853 c write (iout,*) "Number of loop steps in EGB:",ind
1854 cccc energy_dec=.false.
1857 C-----------------------------------------------------------------------------
1858 subroutine egbv(evdw)
1860 C This subroutine calculates the interaction energy of nonbonded side chains
1861 C assuming the Gay-Berne-Vorobjev potential of interaction.
1863 implicit real*8 (a-h,o-z)
1864 include 'DIMENSIONS'
1865 include 'COMMON.GEO'
1866 include 'COMMON.VAR'
1867 include 'COMMON.LOCAL'
1868 include 'COMMON.CHAIN'
1869 include 'COMMON.DERIV'
1870 include 'COMMON.NAMES'
1871 include 'COMMON.INTERACT'
1872 include 'COMMON.IOUNITS'
1873 include 'COMMON.CALC'
1874 common /srutu/ icall
1877 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1880 c if (icall.eq.0) lprn=.true.
1882 do i=iatsc_s,iatsc_e
1883 itypi=iabs(itype(i))
1884 if (itypi.eq.ntyp1) cycle
1885 itypi1=iabs(itype(i+1))
1890 if (xi.lt.0) xi=xi+boxxsize
1892 if (yi.lt.0) yi=yi+boxysize
1894 if (zi.lt.0) zi=zi+boxzsize
1895 C define scaling factor for lipids
1897 C if (positi.le.0) positi=positi+boxzsize
1899 C first for peptide groups
1900 c for each residue check if it is in lipid or lipid water border area
1901 if ((zi.gt.bordlipbot)
1902 &.and.(zi.lt.bordliptop)) then
1903 C the energy transfer exist
1904 if (zi.lt.buflipbot) then
1905 C what fraction I am in
1907 & ((zi-bordlipbot)/lipbufthick)
1908 C lipbufthick is thickenes of lipid buffore
1909 sslipi=sscalelip(fracinbuf)
1910 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1911 elseif (zi.gt.bufliptop) then
1912 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1913 sslipi=sscalelip(fracinbuf)
1914 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1924 dxi=dc_norm(1,nres+i)
1925 dyi=dc_norm(2,nres+i)
1926 dzi=dc_norm(3,nres+i)
1927 c dsci_inv=dsc_inv(itypi)
1928 dsci_inv=vbld_inv(i+nres)
1930 C Calculate SC interaction energy.
1932 do iint=1,nint_gr(i)
1933 do j=istart(i,iint),iend(i,iint)
1935 itypj=iabs(itype(j))
1936 if (itypj.eq.ntyp1) cycle
1937 c dscj_inv=dsc_inv(itypj)
1938 dscj_inv=vbld_inv(j+nres)
1939 sig0ij=sigma(itypi,itypj)
1940 r0ij=r0(itypi,itypj)
1941 chi1=chi(itypi,itypj)
1942 chi2=chi(itypj,itypi)
1949 alf12=0.5D0*(alf1+alf2)
1950 C For diagnostics only!!!
1964 if (xj.lt.0) xj=xj+boxxsize
1966 if (yj.lt.0) yj=yj+boxysize
1968 if (zj.lt.0) zj=zj+boxzsize
1969 if ((zj.gt.bordlipbot)
1970 &.and.(zj.lt.bordliptop)) then
1971 C the energy transfer exist
1972 if (zj.lt.buflipbot) then
1973 C what fraction I am in
1975 & ((zj-bordlipbot)/lipbufthick)
1976 C lipbufthick is thickenes of lipid buffore
1977 sslipj=sscalelip(fracinbuf)
1978 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1979 elseif (zj.gt.bufliptop) then
1980 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1981 sslipj=sscalelip(fracinbuf)
1982 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1991 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1992 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1993 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1994 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1995 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
1996 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1997 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2005 xj=xj_safe+xshift*boxxsize
2006 yj=yj_safe+yshift*boxysize
2007 zj=zj_safe+zshift*boxzsize
2008 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2009 if(dist_temp.lt.dist_init) then
2019 if (subchap.eq.1) then
2028 dxj=dc_norm(1,nres+j)
2029 dyj=dc_norm(2,nres+j)
2030 dzj=dc_norm(3,nres+j)
2031 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2033 C Calculate angle-dependent terms of energy and contributions to their
2037 sig=sig0ij*dsqrt(sigsq)
2038 rij_shift=1.0D0/rij-sig+r0ij
2039 C I hate to put IF's in the loops, but here don't have another choice!!!!
2040 if (rij_shift.le.0.0D0) then
2045 c---------------------------------------------------------------
2046 rij_shift=1.0D0/rij_shift
2047 fac=rij_shift**expon
2050 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2051 eps2der=evdwij*eps3rt
2052 eps3der=evdwij*eps2rt
2053 fac_augm=rrij**expon
2054 e_augm=augm(itypi,itypj)*fac_augm
2055 evdwij=evdwij*eps2rt*eps3rt
2056 evdw=evdw+evdwij+e_augm
2058 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2060 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2061 & restyp(itypi),i,restyp(itypj),j,
2062 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2063 & chi1,chi2,chip1,chip2,
2064 & eps1,eps2rt**2,eps3rt**2,
2065 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2068 C Calculate gradient components.
2069 e1=e1*eps1*eps2rt**2*eps3rt**2
2070 fac=-expon*(e1+evdwij)*rij_shift
2072 fac=rij*fac-2*expon*rrij*e_augm
2073 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2074 C Calculate the radial part of the gradient
2078 C Calculate angular part of the gradient.
2084 C-----------------------------------------------------------------------------
2085 subroutine sc_angular
2086 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2087 C om12. Called by ebp, egb, and egbv.
2089 include 'COMMON.CALC'
2090 include 'COMMON.IOUNITS'
2094 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2095 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2096 om12=dxi*dxj+dyi*dyj+dzi*dzj
2098 C Calculate eps1(om12) and its derivative in om12
2099 faceps1=1.0D0-om12*chiom12
2100 faceps1_inv=1.0D0/faceps1
2101 eps1=dsqrt(faceps1_inv)
2102 C Following variable is eps1*deps1/dom12
2103 eps1_om12=faceps1_inv*chiom12
2108 c write (iout,*) "om12",om12," eps1",eps1
2109 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2114 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2115 sigsq=1.0D0-facsig*faceps1_inv
2116 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2117 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2118 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2124 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2125 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2127 C Calculate eps2 and its derivatives in om1, om2, and om12.
2130 chipom12=chip12*om12
2131 facp=1.0D0-om12*chipom12
2133 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2134 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2135 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2136 C Following variable is the square root of eps2
2137 eps2rt=1.0D0-facp1*facp_inv
2138 C Following three variables are the derivatives of the square root of eps
2139 C in om1, om2, and om12.
2140 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2141 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2142 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2143 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2144 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2145 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2146 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2147 c & " eps2rt_om12",eps2rt_om12
2148 C Calculate whole angle-dependent part of epsilon and contributions
2149 C to its derivatives
2152 C----------------------------------------------------------------------------
2154 implicit real*8 (a-h,o-z)
2155 include 'DIMENSIONS'
2156 include 'COMMON.CHAIN'
2157 include 'COMMON.DERIV'
2158 include 'COMMON.CALC'
2159 include 'COMMON.IOUNITS'
2160 double precision dcosom1(3),dcosom2(3)
2161 cc print *,'sss=',sss
2162 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2163 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2164 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2165 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2169 c eom12=evdwij*eps1_om12
2171 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2172 c & " sigder",sigder
2173 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2174 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2176 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2177 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2180 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2182 c write (iout,*) "gg",(gg(k),k=1,3)
2184 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2185 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2186 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2187 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2188 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2189 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2190 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2191 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2192 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2193 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2196 C Calculate the components of the gradient in DC and X
2200 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2204 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2205 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2209 C-----------------------------------------------------------------------
2210 subroutine e_softsphere(evdw)
2212 C This subroutine calculates the interaction energy of nonbonded side chains
2213 C assuming the LJ potential of interaction.
2215 implicit real*8 (a-h,o-z)
2216 include 'DIMENSIONS'
2217 parameter (accur=1.0d-10)
2218 include 'COMMON.GEO'
2219 include 'COMMON.VAR'
2220 include 'COMMON.LOCAL'
2221 include 'COMMON.CHAIN'
2222 include 'COMMON.DERIV'
2223 include 'COMMON.INTERACT'
2224 include 'COMMON.TORSION'
2225 include 'COMMON.SBRIDGE'
2226 include 'COMMON.NAMES'
2227 include 'COMMON.IOUNITS'
2228 include 'COMMON.CONTACTS'
2230 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2232 do i=iatsc_s,iatsc_e
2233 itypi=iabs(itype(i))
2234 if (itypi.eq.ntyp1) cycle
2235 itypi1=iabs(itype(i+1))
2240 C Calculate SC interaction energy.
2242 do iint=1,nint_gr(i)
2243 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2244 cd & 'iend=',iend(i,iint)
2245 do j=istart(i,iint),iend(i,iint)
2246 itypj=iabs(itype(j))
2247 if (itypj.eq.ntyp1) cycle
2251 rij=xj*xj+yj*yj+zj*zj
2252 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2253 r0ij=r0(itypi,itypj)
2255 c print *,i,j,r0ij,dsqrt(rij)
2256 if (rij.lt.r0ijsq) then
2257 evdwij=0.25d0*(rij-r0ijsq)**2
2265 C Calculate the components of the gradient in DC and X
2271 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2272 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2273 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2274 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2278 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2286 C--------------------------------------------------------------------------
2287 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2290 C Soft-sphere potential of p-p interaction
2292 implicit real*8 (a-h,o-z)
2293 include 'DIMENSIONS'
2294 include 'COMMON.CONTROL'
2295 include 'COMMON.IOUNITS'
2296 include 'COMMON.GEO'
2297 include 'COMMON.VAR'
2298 include 'COMMON.LOCAL'
2299 include 'COMMON.CHAIN'
2300 include 'COMMON.DERIV'
2301 include 'COMMON.INTERACT'
2302 include 'COMMON.CONTACTS'
2303 include 'COMMON.TORSION'
2304 include 'COMMON.VECTORS'
2305 include 'COMMON.FFIELD'
2307 C write(iout,*) 'In EELEC_soft_sphere'
2314 do i=iatel_s,iatel_e
2315 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2319 xmedi=c(1,i)+0.5d0*dxi
2320 ymedi=c(2,i)+0.5d0*dyi
2321 zmedi=c(3,i)+0.5d0*dzi
2322 xmedi=mod(xmedi,boxxsize)
2323 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2324 ymedi=mod(ymedi,boxysize)
2325 if (ymedi.lt.0) ymedi=ymedi+boxysize
2326 zmedi=mod(zmedi,boxzsize)
2327 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2329 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2330 do j=ielstart(i),ielend(i)
2331 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2335 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2336 r0ij=rpp(iteli,itelj)
2345 if (xj.lt.0) xj=xj+boxxsize
2347 if (yj.lt.0) yj=yj+boxysize
2349 if (zj.lt.0) zj=zj+boxzsize
2350 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2358 xj=xj_safe+xshift*boxxsize
2359 yj=yj_safe+yshift*boxysize
2360 zj=zj_safe+zshift*boxzsize
2361 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2362 if(dist_temp.lt.dist_init) then
2372 if (isubchap.eq.1) then
2381 rij=xj*xj+yj*yj+zj*zj
2382 sss=sscale(sqrt(rij))
2383 sssgrad=sscagrad(sqrt(rij))
2384 if (rij.lt.r0ijsq) then
2385 evdw1ij=0.25d0*(rij-r0ijsq)**2
2391 evdw1=evdw1+evdw1ij*sss
2393 C Calculate contributions to the Cartesian gradient.
2395 ggg(1)=fac*xj*sssgrad
2396 ggg(2)=fac*yj*sssgrad
2397 ggg(3)=fac*zj*sssgrad
2399 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2400 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2403 * Loop over residues i+1 thru j-1.
2407 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2412 cgrad do i=nnt,nct-1
2414 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2416 cgrad do j=i+1,nct-1
2418 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2424 c------------------------------------------------------------------------------
2425 subroutine vec_and_deriv
2426 implicit real*8 (a-h,o-z)
2427 include 'DIMENSIONS'
2431 include 'COMMON.IOUNITS'
2432 include 'COMMON.GEO'
2433 include 'COMMON.VAR'
2434 include 'COMMON.LOCAL'
2435 include 'COMMON.CHAIN'
2436 include 'COMMON.VECTORS'
2437 include 'COMMON.SETUP'
2438 include 'COMMON.TIME1'
2439 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2440 C Compute the local reference systems. For reference system (i), the
2441 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2442 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2444 do i=ivec_start,ivec_end
2448 if (i.eq.nres-1) then
2449 C Case of the last full residue
2450 C Compute the Z-axis
2451 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2452 costh=dcos(pi-theta(nres))
2453 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2457 C Compute the derivatives of uz
2459 uzder(2,1,1)=-dc_norm(3,i-1)
2460 uzder(3,1,1)= dc_norm(2,i-1)
2461 uzder(1,2,1)= dc_norm(3,i-1)
2463 uzder(3,2,1)=-dc_norm(1,i-1)
2464 uzder(1,3,1)=-dc_norm(2,i-1)
2465 uzder(2,3,1)= dc_norm(1,i-1)
2468 uzder(2,1,2)= dc_norm(3,i)
2469 uzder(3,1,2)=-dc_norm(2,i)
2470 uzder(1,2,2)=-dc_norm(3,i)
2472 uzder(3,2,2)= dc_norm(1,i)
2473 uzder(1,3,2)= dc_norm(2,i)
2474 uzder(2,3,2)=-dc_norm(1,i)
2476 C Compute the Y-axis
2479 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2481 C Compute the derivatives of uy
2484 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2485 & -dc_norm(k,i)*dc_norm(j,i-1)
2486 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2488 uyder(j,j,1)=uyder(j,j,1)-costh
2489 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2494 uygrad(l,k,j,i)=uyder(l,k,j)
2495 uzgrad(l,k,j,i)=uzder(l,k,j)
2499 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2500 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2501 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2502 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2505 C Compute the Z-axis
2506 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2507 costh=dcos(pi-theta(i+2))
2508 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2512 C Compute the derivatives of uz
2514 uzder(2,1,1)=-dc_norm(3,i+1)
2515 uzder(3,1,1)= dc_norm(2,i+1)
2516 uzder(1,2,1)= dc_norm(3,i+1)
2518 uzder(3,2,1)=-dc_norm(1,i+1)
2519 uzder(1,3,1)=-dc_norm(2,i+1)
2520 uzder(2,3,1)= dc_norm(1,i+1)
2523 uzder(2,1,2)= dc_norm(3,i)
2524 uzder(3,1,2)=-dc_norm(2,i)
2525 uzder(1,2,2)=-dc_norm(3,i)
2527 uzder(3,2,2)= dc_norm(1,i)
2528 uzder(1,3,2)= dc_norm(2,i)
2529 uzder(2,3,2)=-dc_norm(1,i)
2531 C Compute the Y-axis
2534 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2536 C Compute the derivatives of uy
2539 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2540 & -dc_norm(k,i)*dc_norm(j,i+1)
2541 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2543 uyder(j,j,1)=uyder(j,j,1)-costh
2544 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2549 uygrad(l,k,j,i)=uyder(l,k,j)
2550 uzgrad(l,k,j,i)=uzder(l,k,j)
2554 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2555 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2556 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2557 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2561 vbld_inv_temp(1)=vbld_inv(i+1)
2562 if (i.lt.nres-1) then
2563 vbld_inv_temp(2)=vbld_inv(i+2)
2565 vbld_inv_temp(2)=vbld_inv(i)
2570 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2571 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2576 #if defined(PARVEC) && defined(MPI)
2577 if (nfgtasks1.gt.1) then
2579 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2580 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2581 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2582 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2583 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2585 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2586 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2588 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2589 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2590 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2591 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2592 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2593 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2594 time_gather=time_gather+MPI_Wtime()-time00
2596 c if (fg_rank.eq.0) then
2597 c write (iout,*) "Arrays UY and UZ"
2599 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2606 C-----------------------------------------------------------------------------
2607 subroutine check_vecgrad
2608 implicit real*8 (a-h,o-z)
2609 include 'DIMENSIONS'
2610 include 'COMMON.IOUNITS'
2611 include 'COMMON.GEO'
2612 include 'COMMON.VAR'
2613 include 'COMMON.LOCAL'
2614 include 'COMMON.CHAIN'
2615 include 'COMMON.VECTORS'
2616 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2617 dimension uyt(3,maxres),uzt(3,maxres)
2618 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2619 double precision delta /1.0d-7/
2622 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2623 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2624 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2625 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2626 cd & (dc_norm(if90,i),if90=1,3)
2627 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2628 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2629 cd write(iout,'(a)')
2635 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2636 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2649 cd write (iout,*) 'i=',i
2651 erij(k)=dc_norm(k,i)
2655 dc_norm(k,i)=erij(k)
2657 dc_norm(j,i)=dc_norm(j,i)+delta
2658 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2660 c dc_norm(k,i)=dc_norm(k,i)/fac
2662 c write (iout,*) (dc_norm(k,i),k=1,3)
2663 c write (iout,*) (erij(k),k=1,3)
2666 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2667 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2668 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2669 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2671 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2672 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2673 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2676 dc_norm(k,i)=erij(k)
2679 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2680 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2681 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2682 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2683 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2684 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2685 cd write (iout,'(a)')
2690 C--------------------------------------------------------------------------
2691 subroutine set_matrices
2692 implicit real*8 (a-h,o-z)
2693 include 'DIMENSIONS'
2696 include "COMMON.SETUP"
2698 integer status(MPI_STATUS_SIZE)
2700 include 'COMMON.IOUNITS'
2701 include 'COMMON.GEO'
2702 include 'COMMON.VAR'
2703 include 'COMMON.LOCAL'
2704 include 'COMMON.CHAIN'
2705 include 'COMMON.DERIV'
2706 include 'COMMON.INTERACT'
2707 include 'COMMON.CONTACTS'
2708 include 'COMMON.TORSION'
2709 include 'COMMON.VECTORS'
2710 include 'COMMON.FFIELD'
2711 double precision auxvec(2),auxmat(2,2)
2713 C Compute the virtual-bond-torsional-angle dependent quantities needed
2714 C to calculate the el-loc multibody terms of various order.
2716 c write(iout,*) 'nphi=',nphi,nres
2718 do i=ivec_start+2,ivec_end+2
2723 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2724 iti = itortyp(itype(i-2))
2728 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2729 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2730 iti1 = itortyp(itype(i-1))
2735 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2736 & +bnew1(2,1,iti)*dsin(theta(i-1))
2737 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2738 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2739 & +bnew1(2,1,iti)*dcos(theta(i-1))
2740 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2741 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2742 c &*(cos(theta(i)/2.0)
2743 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2744 & +bnew2(2,1,iti)*dsin(theta(i-1))
2745 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2746 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2747 c &*(cos(theta(i)/2.0)
2748 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2749 & +bnew2(2,1,iti)*dcos(theta(i-1))
2750 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2751 c if (ggb1(1,i).eq.0.0d0) then
2752 c write(iout,*) 'i=',i,ggb1(1,i),
2753 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2754 c &bnew1(2,1,iti)*cos(theta(i)),
2755 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2757 b1(2,i-2)=bnew1(1,2,iti)
2759 b2(2,i-2)=bnew2(1,2,iti)
2761 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2762 EE(1,2,i-2)=eeold(1,2,iti)
2763 EE(2,1,i-2)=eeold(2,1,iti)
2764 EE(2,2,i-2)=eeold(2,2,iti)
2765 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2770 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2771 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2772 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2773 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2774 b1tilde(1,i-2)=b1(1,i-2)
2775 b1tilde(2,i-2)=-b1(2,i-2)
2776 b2tilde(1,i-2)=b2(1,i-2)
2777 b2tilde(2,i-2)=-b2(2,i-2)
2778 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2779 c write(iout,*) 'b1=',b1(1,i-2)
2780 c write (iout,*) 'theta=', theta(i-1)
2787 b1tilde(1,i-2)=b1(1,i-2)
2788 b1tilde(2,i-2)=-b1(2,i-2)
2789 b2tilde(1,i-2)=b2(1,i-2)
2790 b2tilde(2,i-2)=-b2(2,i-2)
2791 EE(1,2,i-2)=eeold(1,2,iti)
2792 EE(2,1,i-2)=eeold(2,1,iti)
2793 EE(2,2,i-2)=eeold(2,2,iti)
2794 EE(1,1,i-2)=eeold(1,1,iti)
2798 do i=ivec_start+2,ivec_end+2
2802 if (i .lt. nres+1) then
2839 if (i .gt. 3 .and. i .lt. nres+1) then
2840 obrot_der(1,i-2)=-sin1
2841 obrot_der(2,i-2)= cos1
2842 Ugder(1,1,i-2)= sin1
2843 Ugder(1,2,i-2)=-cos1
2844 Ugder(2,1,i-2)=-cos1
2845 Ugder(2,2,i-2)=-sin1
2848 obrot2_der(1,i-2)=-dwasin2
2849 obrot2_der(2,i-2)= dwacos2
2850 Ug2der(1,1,i-2)= dwasin2
2851 Ug2der(1,2,i-2)=-dwacos2
2852 Ug2der(2,1,i-2)=-dwacos2
2853 Ug2der(2,2,i-2)=-dwasin2
2855 obrot_der(1,i-2)=0.0d0
2856 obrot_der(2,i-2)=0.0d0
2857 Ugder(1,1,i-2)=0.0d0
2858 Ugder(1,2,i-2)=0.0d0
2859 Ugder(2,1,i-2)=0.0d0
2860 Ugder(2,2,i-2)=0.0d0
2861 obrot2_der(1,i-2)=0.0d0
2862 obrot2_der(2,i-2)=0.0d0
2863 Ug2der(1,1,i-2)=0.0d0
2864 Ug2der(1,2,i-2)=0.0d0
2865 Ug2der(2,1,i-2)=0.0d0
2866 Ug2der(2,2,i-2)=0.0d0
2868 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2869 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2870 iti = itortyp(itype(i-2))
2874 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2875 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2876 iti1 = itortyp(itype(i-1))
2880 cd write (iout,*) '*******i',i,' iti1',iti
2881 cd write (iout,*) 'b1',b1(:,iti)
2882 cd write (iout,*) 'b2',b2(:,iti)
2883 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2884 c if (i .gt. iatel_s+2) then
2885 if (i .gt. nnt+2) then
2886 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2888 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2889 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2891 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2892 c & EE(1,2,iti),EE(2,2,iti)
2893 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2894 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2895 c write(iout,*) "Macierz EUG",
2896 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2898 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2900 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2901 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2902 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2903 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2904 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2915 DtUg2(l,k,i-2)=0.0d0
2919 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2920 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2922 muder(k,i-2)=Ub2der(k,i-2)
2924 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2925 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2926 if (itype(i-1).le.ntyp) then
2927 iti1 = itortyp(itype(i-1))
2935 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2937 c write (iout,*) 'mu ',mu(:,i-2),i-2
2938 cd write (iout,*) 'mu1',mu1(:,i-2)
2939 cd write (iout,*) 'mu2',mu2(:,i-2)
2940 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2942 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2943 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2944 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2945 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2946 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2947 C Vectors and matrices dependent on a single virtual-bond dihedral.
2948 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2949 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2950 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2951 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2952 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2953 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2954 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2955 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2956 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2959 C Matrices dependent on two consecutive virtual-bond dihedrals.
2960 C The order of matrices is from left to right.
2961 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2963 c do i=max0(ivec_start,2),ivec_end
2965 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2966 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2967 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2968 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2969 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2970 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2971 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2972 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2975 #if defined(MPI) && defined(PARMAT)
2977 c if (fg_rank.eq.0) then
2978 write (iout,*) "Arrays UG and UGDER before GATHER"
2980 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2981 & ((ug(l,k,i),l=1,2),k=1,2),
2982 & ((ugder(l,k,i),l=1,2),k=1,2)
2984 write (iout,*) "Arrays UG2 and UG2DER"
2986 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2987 & ((ug2(l,k,i),l=1,2),k=1,2),
2988 & ((ug2der(l,k,i),l=1,2),k=1,2)
2990 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2992 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2993 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2994 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2996 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2998 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2999 & costab(i),sintab(i),costab2(i),sintab2(i)
3001 write (iout,*) "Array MUDER"
3003 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3007 if (nfgtasks.gt.1) then
3009 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
3010 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
3011 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
3013 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
3014 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3016 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
3017 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3019 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
3020 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3022 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
3023 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3025 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
3026 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3028 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
3029 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3031 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
3032 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
3033 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3034 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
3035 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
3036 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3037 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
3038 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
3039 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3040 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
3041 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
3042 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3043 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3045 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
3046 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3048 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
3049 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3051 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
3052 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3054 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3055 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3057 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3058 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3060 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3061 & ivec_count(fg_rank1),
3062 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3064 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3065 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3067 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3068 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3070 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3071 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3073 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3074 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3076 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3077 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3079 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3080 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3082 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3083 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3085 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3086 & ivec_count(fg_rank1),
3087 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3089 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3090 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3092 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3093 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3095 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3096 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3098 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3099 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3101 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3102 & ivec_count(fg_rank1),
3103 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3105 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3106 & ivec_count(fg_rank1),
3107 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3109 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3110 & ivec_count(fg_rank1),
3111 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3112 & MPI_MAT2,FG_COMM1,IERR)
3113 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3114 & ivec_count(fg_rank1),
3115 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3116 & MPI_MAT2,FG_COMM1,IERR)
3119 c Passes matrix info through the ring
3122 if (irecv.lt.0) irecv=nfgtasks1-1
3125 if (inext.ge.nfgtasks1) inext=0
3127 c write (iout,*) "isend",isend," irecv",irecv
3129 lensend=lentyp(isend)
3130 lenrecv=lentyp(irecv)
3131 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3132 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3133 c & MPI_ROTAT1(lensend),inext,2200+isend,
3134 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3135 c & iprev,2200+irecv,FG_COMM,status,IERR)
3136 c write (iout,*) "Gather ROTAT1"
3138 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3139 c & MPI_ROTAT2(lensend),inext,3300+isend,
3140 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3141 c & iprev,3300+irecv,FG_COMM,status,IERR)
3142 c write (iout,*) "Gather ROTAT2"
3144 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3145 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3146 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3147 & iprev,4400+irecv,FG_COMM,status,IERR)
3148 c write (iout,*) "Gather ROTAT_OLD"
3150 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3151 & MPI_PRECOMP11(lensend),inext,5500+isend,
3152 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3153 & iprev,5500+irecv,FG_COMM,status,IERR)
3154 c write (iout,*) "Gather PRECOMP11"
3156 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3157 & MPI_PRECOMP12(lensend),inext,6600+isend,
3158 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3159 & iprev,6600+irecv,FG_COMM,status,IERR)
3160 c write (iout,*) "Gather PRECOMP12"
3162 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3164 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3165 & MPI_ROTAT2(lensend),inext,7700+isend,
3166 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3167 & iprev,7700+irecv,FG_COMM,status,IERR)
3168 c write (iout,*) "Gather PRECOMP21"
3170 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3171 & MPI_PRECOMP22(lensend),inext,8800+isend,
3172 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3173 & iprev,8800+irecv,FG_COMM,status,IERR)
3174 c write (iout,*) "Gather PRECOMP22"
3176 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3177 & MPI_PRECOMP23(lensend),inext,9900+isend,
3178 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3179 & MPI_PRECOMP23(lenrecv),
3180 & iprev,9900+irecv,FG_COMM,status,IERR)
3181 c write (iout,*) "Gather PRECOMP23"
3186 if (irecv.lt.0) irecv=nfgtasks1-1
3189 time_gather=time_gather+MPI_Wtime()-time00
3192 c if (fg_rank.eq.0) then
3193 write (iout,*) "Arrays UG and UGDER"
3195 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3196 & ((ug(l,k,i),l=1,2),k=1,2),
3197 & ((ugder(l,k,i),l=1,2),k=1,2)
3199 write (iout,*) "Arrays UG2 and UG2DER"
3201 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3202 & ((ug2(l,k,i),l=1,2),k=1,2),
3203 & ((ug2der(l,k,i),l=1,2),k=1,2)
3205 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3207 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3208 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3209 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3211 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3213 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3214 & costab(i),sintab(i),costab2(i),sintab2(i)
3216 write (iout,*) "Array MUDER"
3218 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3224 cd iti = itortyp(itype(i))
3227 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3228 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3233 C--------------------------------------------------------------------------
3234 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3236 C This subroutine calculates the average interaction energy and its gradient
3237 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3238 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3239 C The potential depends both on the distance of peptide-group centers and on
3240 C the orientation of the CA-CA virtual bonds.
3242 implicit real*8 (a-h,o-z)
3246 include 'DIMENSIONS'
3247 include 'COMMON.CONTROL'
3248 include 'COMMON.SETUP'
3249 include 'COMMON.IOUNITS'
3250 include 'COMMON.GEO'
3251 include 'COMMON.VAR'
3252 include 'COMMON.LOCAL'
3253 include 'COMMON.CHAIN'
3254 include 'COMMON.DERIV'
3255 include 'COMMON.INTERACT'
3256 include 'COMMON.CONTACTS'
3257 include 'COMMON.TORSION'
3258 include 'COMMON.VECTORS'
3259 include 'COMMON.FFIELD'
3260 include 'COMMON.TIME1'
3261 include 'COMMON.SPLITELE'
3262 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3263 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3264 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3265 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3266 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3267 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3269 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3271 double precision scal_el /1.0d0/
3273 double precision scal_el /0.5d0/
3276 C 13-go grudnia roku pamietnego...
3277 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3278 & 0.0d0,1.0d0,0.0d0,
3279 & 0.0d0,0.0d0,1.0d0/
3280 cd write(iout,*) 'In EELEC'
3282 cd write(iout,*) 'Type',i
3283 cd write(iout,*) 'B1',B1(:,i)
3284 cd write(iout,*) 'B2',B2(:,i)
3285 cd write(iout,*) 'CC',CC(:,:,i)
3286 cd write(iout,*) 'DD',DD(:,:,i)
3287 cd write(iout,*) 'EE',EE(:,:,i)
3289 cd call check_vecgrad
3291 if (icheckgrad.eq.1) then
3293 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3295 dc_norm(k,i)=dc(k,i)*fac
3297 c write (iout,*) 'i',i,' fac',fac
3300 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3301 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3302 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3303 c call vec_and_deriv
3309 time_mat=time_mat+MPI_Wtime()-time01
3313 cd write (iout,*) 'i=',i
3315 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3318 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3319 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3332 cd print '(a)','Enter EELEC'
3333 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3335 gel_loc_loc(i)=0.0d0
3340 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3342 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3344 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3345 do i=iturn3_start,iturn3_end
3347 C write(iout,*) "tu jest i",i
3348 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3349 C changes suggested by Ana to avoid out of bounds
3350 & .or.((i+4).gt.nres)
3352 C end of changes by Ana
3353 & .or. itype(i+2).eq.ntyp1
3354 & .or. itype(i+3).eq.ntyp1) cycle
3356 if(itype(i-1).eq.ntyp1)cycle
3359 if (itype(i+4).eq.ntyp1) cycle
3364 dx_normi=dc_norm(1,i)
3365 dy_normi=dc_norm(2,i)
3366 dz_normi=dc_norm(3,i)
3367 xmedi=c(1,i)+0.5d0*dxi
3368 ymedi=c(2,i)+0.5d0*dyi
3369 zmedi=c(3,i)+0.5d0*dzi
3370 xmedi=mod(xmedi,boxxsize)
3371 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3372 ymedi=mod(ymedi,boxysize)
3373 if (ymedi.lt.0) ymedi=ymedi+boxysize
3374 zmedi=mod(zmedi,boxzsize)
3375 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3377 call eelecij(i,i+2,ees,evdw1,eel_loc)
3378 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3379 num_cont_hb(i)=num_conti
3381 do i=iturn4_start,iturn4_end
3383 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3384 C changes suggested by Ana to avoid out of bounds
3385 & .or.((i+5).gt.nres)
3387 C end of changes suggested by Ana
3388 & .or. itype(i+3).eq.ntyp1
3389 & .or. itype(i+4).eq.ntyp1
3390 & .or. itype(i+5).eq.ntyp1
3391 & .or. itype(i).eq.ntyp1
3392 & .or. itype(i-1).eq.ntyp1
3397 dx_normi=dc_norm(1,i)
3398 dy_normi=dc_norm(2,i)
3399 dz_normi=dc_norm(3,i)
3400 xmedi=c(1,i)+0.5d0*dxi
3401 ymedi=c(2,i)+0.5d0*dyi
3402 zmedi=c(3,i)+0.5d0*dzi
3403 C Return atom into box, boxxsize is size of box in x dimension
3405 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3406 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3407 C Condition for being inside the proper box
3408 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3409 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3413 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3414 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3415 C Condition for being inside the proper box
3416 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3417 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3421 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3422 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3423 C Condition for being inside the proper box
3424 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3425 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3428 xmedi=mod(xmedi,boxxsize)
3429 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3430 ymedi=mod(ymedi,boxysize)
3431 if (ymedi.lt.0) ymedi=ymedi+boxysize
3432 zmedi=mod(zmedi,boxzsize)
3433 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3435 num_conti=num_cont_hb(i)
3436 c write(iout,*) "JESTEM W PETLI"
3437 call eelecij(i,i+3,ees,evdw1,eel_loc)
3438 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3439 & call eturn4(i,eello_turn4)
3440 num_cont_hb(i)=num_conti
3442 C Loop over all neighbouring boxes
3447 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3450 do i=iatel_s,iatel_e
3453 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3454 C changes suggested by Ana to avoid out of bounds
3455 & .or.((i+2).gt.nres)
3457 C end of changes by Ana
3458 & .or. itype(i+2).eq.ntyp1
3459 & .or. itype(i-1).eq.ntyp1
3464 dx_normi=dc_norm(1,i)
3465 dy_normi=dc_norm(2,i)
3466 dz_normi=dc_norm(3,i)
3467 xmedi=c(1,i)+0.5d0*dxi
3468 ymedi=c(2,i)+0.5d0*dyi
3469 zmedi=c(3,i)+0.5d0*dzi
3470 xmedi=mod(xmedi,boxxsize)
3471 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3472 ymedi=mod(ymedi,boxysize)
3473 if (ymedi.lt.0) ymedi=ymedi+boxysize
3474 zmedi=mod(zmedi,boxzsize)
3475 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3476 C xmedi=xmedi+xshift*boxxsize
3477 C ymedi=ymedi+yshift*boxysize
3478 C zmedi=zmedi+zshift*boxzsize
3480 C Return tom into box, boxxsize is size of box in x dimension
3482 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3483 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3484 C Condition for being inside the proper box
3485 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3486 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3490 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3491 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3492 C Condition for being inside the proper box
3493 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3494 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3498 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3499 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3500 cC Condition for being inside the proper box
3501 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3502 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3506 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3507 num_conti=num_cont_hb(i)
3509 do j=ielstart(i),ielend(i)
3511 C write (iout,*) i,j
3513 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3514 C changes suggested by Ana to avoid out of bounds
3515 & .or.((j+2).gt.nres)
3517 C end of changes by Ana
3518 & .or.itype(j+2).eq.ntyp1
3519 & .or.itype(j-1).eq.ntyp1
3521 call eelecij(i,j,ees,evdw1,eel_loc)
3523 num_cont_hb(i)=num_conti
3529 c write (iout,*) "Number of loop steps in EELEC:",ind
3531 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3532 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3534 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3535 ccc eel_loc=eel_loc+eello_turn3
3536 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3539 C-------------------------------------------------------------------------------
3540 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3541 implicit real*8 (a-h,o-z)
3542 include 'DIMENSIONS'
3546 include 'COMMON.CONTROL'
3547 include 'COMMON.IOUNITS'
3548 include 'COMMON.GEO'
3549 include 'COMMON.VAR'
3550 include 'COMMON.LOCAL'
3551 include 'COMMON.CHAIN'
3552 include 'COMMON.DERIV'
3553 include 'COMMON.INTERACT'
3554 include 'COMMON.CONTACTS'
3555 include 'COMMON.TORSION'
3556 include 'COMMON.VECTORS'
3557 include 'COMMON.FFIELD'
3558 include 'COMMON.TIME1'
3559 include 'COMMON.SPLITELE'
3560 include 'COMMON.SHIELD'
3561 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3562 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3563 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3564 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3565 & gmuij2(4),gmuji2(4)
3566 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3567 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3569 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3571 double precision scal_el /1.0d0/
3573 double precision scal_el /0.5d0/
3576 C 13-go grudnia roku pamietnego...
3577 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3578 & 0.0d0,1.0d0,0.0d0,
3579 & 0.0d0,0.0d0,1.0d0/
3580 c time00=MPI_Wtime()
3581 cd write (iout,*) "eelecij",i,j
3585 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3586 aaa=app(iteli,itelj)
3587 bbb=bpp(iteli,itelj)
3588 ael6i=ael6(iteli,itelj)
3589 ael3i=ael3(iteli,itelj)
3593 dx_normj=dc_norm(1,j)
3594 dy_normj=dc_norm(2,j)
3595 dz_normj=dc_norm(3,j)
3596 C xj=c(1,j)+0.5D0*dxj-xmedi
3597 C yj=c(2,j)+0.5D0*dyj-ymedi
3598 C zj=c(3,j)+0.5D0*dzj-zmedi
3603 if (xj.lt.0) xj=xj+boxxsize
3605 if (yj.lt.0) yj=yj+boxysize
3607 if (zj.lt.0) zj=zj+boxzsize
3608 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3609 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3617 xj=xj_safe+xshift*boxxsize
3618 yj=yj_safe+yshift*boxysize
3619 zj=zj_safe+zshift*boxzsize
3620 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3621 if(dist_temp.lt.dist_init) then
3631 if (isubchap.eq.1) then
3640 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3642 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3643 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3644 C Condition for being inside the proper box
3645 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3646 c & (xj.lt.((-0.5d0)*boxxsize))) then
3650 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3651 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3652 C Condition for being inside the proper box
3653 c if ((yj.gt.((0.5d0)*boxysize)).or.
3654 c & (yj.lt.((-0.5d0)*boxysize))) then
3658 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3659 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3660 C Condition for being inside the proper box
3661 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3662 c & (zj.lt.((-0.5d0)*boxzsize))) then
3665 C endif !endPBC condintion
3669 rij=xj*xj+yj*yj+zj*zj
3671 sss=sscale(sqrt(rij))
3672 sssgrad=sscagrad(sqrt(rij))
3673 c if (sss.gt.0.0d0) then
3679 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3680 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3681 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3682 fac=cosa-3.0D0*cosb*cosg
3684 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3685 if (j.eq.i+2) ev1=scal_el*ev1
3690 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3694 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3695 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3696 if (shield_mode.gt.0) then
3699 el1=el1*fac_shield(i)*fac_shield(j)
3700 el2=el2*fac_shield(i)*fac_shield(j)
3709 evdw1=evdw1+evdwij*sss
3710 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3711 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3712 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3713 cd & xmedi,ymedi,zmedi,xj,yj,zj
3715 if (energy_dec) then
3716 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3718 &,iteli,itelj,aaa,evdw1
3719 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3723 C Calculate contributions to the Cartesian gradient.
3726 facvdw=-6*rrmij*(ev1+evdwij)*sss
3727 facel=-3*rrmij*(el1+eesij)
3734 * Radial derivatives. First process both termini of the fragment (i,j)
3739 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3740 & (shield_mode.gt.0)) then
3742 do ilist=1,ishield_list(i)
3743 iresshield=shield_list(ilist,i)
3745 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
3746 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3748 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3749 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3750 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3751 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3752 C if (iresshield.gt.i) then
3753 C do ishi=i+1,iresshield-1
3754 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3755 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3759 C do ishi=iresshield,i
3760 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3761 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3767 do ilist=1,ishield_list(j)
3768 iresshield=shield_list(ilist,j)
3770 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
3771 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3773 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3774 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3776 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3777 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3778 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3779 C if (iresshield.gt.j) then
3780 C do ishi=j+1,iresshield-1
3781 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3782 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3786 C do ishi=iresshield,j
3787 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3788 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3795 gshieldc(k,i)=gshieldc(k,i)+
3796 & grad_shield(k,i)*eesij/fac_shield(i)
3797 gshieldc(k,j)=gshieldc(k,j)+
3798 & grad_shield(k,j)*eesij/fac_shield(j)
3799 gshieldc(k,i-1)=gshieldc(k,i-1)+
3800 & grad_shield(k,i)*eesij/fac_shield(i)
3801 gshieldc(k,j-1)=gshieldc(k,j-1)+
3802 & grad_shield(k,j)*eesij/fac_shield(j)
3807 c ghalf=0.5D0*ggg(k)
3808 c gelc(k,i)=gelc(k,i)+ghalf
3809 c gelc(k,j)=gelc(k,j)+ghalf
3811 c 9/28/08 AL Gradient compotents will be summed only at the end
3812 C print *,"before", gelc_long(1,i), gelc_long(1,j)
3814 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3815 C & +grad_shield(k,j)*eesij/fac_shield(j)
3816 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3817 C & +grad_shield(k,i)*eesij/fac_shield(i)
3818 C gelc_long(k,i-1)=gelc_long(k,i-1)
3819 C & +grad_shield(k,i)*eesij/fac_shield(i)
3820 C gelc_long(k,j-1)=gelc_long(k,j-1)
3821 C & +grad_shield(k,j)*eesij/fac_shield(j)
3823 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
3826 * Loop over residues i+1 thru j-1.
3830 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3833 if (sss.gt.0.0) then
3834 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3835 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3836 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3843 c ghalf=0.5D0*ggg(k)
3844 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3845 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3847 c 9/28/08 AL Gradient compotents will be summed only at the end
3849 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3850 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3853 * Loop over residues i+1 thru j-1.
3857 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3862 facvdw=(ev1+evdwij)*sss
3865 fac=-3*rrmij*(facvdw+facvdw+facel)
3870 * Radial derivatives. First process both termini of the fragment (i,j)
3873 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
3875 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
3877 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
3879 c ghalf=0.5D0*ggg(k)
3880 c gelc(k,i)=gelc(k,i)+ghalf
3881 c gelc(k,j)=gelc(k,j)+ghalf
3883 c 9/28/08 AL Gradient compotents will be summed only at the end
3885 gelc_long(k,j)=gelc(k,j)+ggg(k)
3886 gelc_long(k,i)=gelc(k,i)-ggg(k)
3889 * Loop over residues i+1 thru j-1.
3893 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3896 c 9/28/08 AL Gradient compotents will be summed only at the end
3897 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3898 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3899 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3901 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3902 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3908 ecosa=2.0D0*fac3*fac1+fac4
3911 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3912 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3914 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3915 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3917 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3918 cd & (dcosg(k),k=1,3)
3920 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
3921 & fac_shield(i)*fac_shield(j)
3924 c ghalf=0.5D0*ggg(k)
3925 c gelc(k,i)=gelc(k,i)+ghalf
3926 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3927 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3928 c gelc(k,j)=gelc(k,j)+ghalf
3929 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3930 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3934 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3937 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
3940 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3941 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
3942 & *fac_shield(i)*fac_shield(j)
3944 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3945 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
3946 & *fac_shield(i)*fac_shield(j)
3947 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3948 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3950 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
3954 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3955 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3956 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3958 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3959 C energy of a peptide unit is assumed in the form of a second-order
3960 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3961 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3962 C are computed for EVERY pair of non-contiguous peptide groups.
3965 if (j.lt.nres-1) then
3977 muij(kkk)=mu(k,i)*mu(l,j)
3978 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3980 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3981 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3982 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3983 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3984 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3985 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3989 cd write (iout,*) 'EELEC: i',i,' j',j
3990 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3991 cd write(iout,*) 'muij',muij
3992 ury=scalar(uy(1,i),erij)
3993 urz=scalar(uz(1,i),erij)
3994 vry=scalar(uy(1,j),erij)
3995 vrz=scalar(uz(1,j),erij)
3996 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3997 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3998 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3999 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4000 fac=dsqrt(-ael6i)*r3ij
4005 cd write (iout,'(4i5,4f10.5)')
4006 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
4007 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4008 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4009 cd & uy(:,j),uz(:,j)
4010 cd write (iout,'(4f10.5)')
4011 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4012 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4013 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
4014 cd write (iout,'(9f10.5/)')
4015 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4016 C Derivatives of the elements of A in virtual-bond vectors
4017 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4019 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4020 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4021 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4022 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4023 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4024 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4025 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4026 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4027 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4028 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4029 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4030 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4032 C Compute radial contributions to the gradient
4050 C Add the contributions coming from er
4053 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4054 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4055 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4056 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4059 C Derivatives in DC(i)
4060 cgrad ghalf1=0.5d0*agg(k,1)
4061 cgrad ghalf2=0.5d0*agg(k,2)
4062 cgrad ghalf3=0.5d0*agg(k,3)
4063 cgrad ghalf4=0.5d0*agg(k,4)
4064 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
4065 & -3.0d0*uryg(k,2)*vry)!+ghalf1
4066 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
4067 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
4068 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
4069 & -3.0d0*urzg(k,2)*vry)!+ghalf3
4070 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
4071 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
4072 C Derivatives in DC(i+1)
4073 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
4074 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4075 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
4076 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4077 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
4078 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4079 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
4080 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4081 C Derivatives in DC(j)
4082 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
4083 & -3.0d0*vryg(k,2)*ury)!+ghalf1
4084 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4085 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4086 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4087 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4088 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4089 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4090 C Derivatives in DC(j+1) or DC(nres-1)
4091 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4092 & -3.0d0*vryg(k,3)*ury)
4093 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4094 & -3.0d0*vrzg(k,3)*ury)
4095 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4096 & -3.0d0*vryg(k,3)*urz)
4097 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4098 & -3.0d0*vrzg(k,3)*urz)
4099 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4101 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4114 aggi(k,l)=-aggi(k,l)
4115 aggi1(k,l)=-aggi1(k,l)
4116 aggj(k,l)=-aggj(k,l)
4117 aggj1(k,l)=-aggj1(k,l)
4120 if (j.lt.nres-1) then
4126 aggi(k,l)=-aggi(k,l)
4127 aggi1(k,l)=-aggi1(k,l)
4128 aggj(k,l)=-aggj(k,l)
4129 aggj1(k,l)=-aggj1(k,l)
4140 aggi(k,l)=-aggi(k,l)
4141 aggi1(k,l)=-aggi1(k,l)
4142 aggj(k,l)=-aggj(k,l)
4143 aggj1(k,l)=-aggj1(k,l)
4148 IF (wel_loc.gt.0.0d0) THEN
4149 C Contribution to the local-electrostatic energy coming from the i-j pair
4150 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4152 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4153 c & ' eel_loc_ij',eel_loc_ij
4154 c write(iout,*) 'muije=',muij(1),muij(2),muij(3),muij(4)
4155 C Calculate patrial derivative for theta angle
4157 geel_loc_ij=a22*gmuij1(1)
4161 c write(iout,*) "derivative over thatai"
4162 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4164 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4165 & geel_loc_ij*wel_loc
4166 c write(iout,*) "derivative over thatai-1"
4167 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4174 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4175 & geel_loc_ij*wel_loc
4176 c Derivative over j residue
4177 geel_loc_ji=a22*gmuji1(1)
4181 c write(iout,*) "derivative over thataj"
4182 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4185 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4186 & geel_loc_ji*wel_loc
4192 c write(iout,*) "derivative over thataj-1"
4193 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4195 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4196 & geel_loc_ji*wel_loc
4198 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4200 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4201 & 'eelloc',i,j,eel_loc_ij
4202 c if (eel_loc_ij.ne.0)
4203 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4204 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4206 eel_loc=eel_loc+eel_loc_ij
4207 C Partial derivatives in virtual-bond dihedral angles gamma
4209 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4210 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4211 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
4212 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4213 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4214 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
4215 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4217 ggg(l)=agg(l,1)*muij(1)+
4218 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
4219 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4220 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4221 cgrad ghalf=0.5d0*ggg(l)
4222 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4223 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4227 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4230 C Remaining derivatives of eello
4232 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4233 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4234 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4235 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4236 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4237 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4238 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4239 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4242 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4243 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4244 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4245 & .and. num_conti.le.maxconts) then
4246 c write (iout,*) i,j," entered corr"
4248 C Calculate the contact function. The ith column of the array JCONT will
4249 C contain the numbers of atoms that make contacts with the atom I (of numbers
4250 C greater than I). The arrays FACONT and GACONT will contain the values of
4251 C the contact function and its derivative.
4252 c r0ij=1.02D0*rpp(iteli,itelj)
4253 c r0ij=1.11D0*rpp(iteli,itelj)
4254 r0ij=2.20D0*rpp(iteli,itelj)
4255 c r0ij=1.55D0*rpp(iteli,itelj)
4256 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4257 if (fcont.gt.0.0D0) then
4258 num_conti=num_conti+1
4259 if (num_conti.gt.maxconts) then
4260 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4261 & ' will skip next contacts for this conf.'
4263 jcont_hb(num_conti,i)=j
4264 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4265 cd & " jcont_hb",jcont_hb(num_conti,i)
4266 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4267 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4268 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4270 d_cont(num_conti,i)=rij
4271 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4272 C --- Electrostatic-interaction matrix ---
4273 a_chuj(1,1,num_conti,i)=a22
4274 a_chuj(1,2,num_conti,i)=a23
4275 a_chuj(2,1,num_conti,i)=a32
4276 a_chuj(2,2,num_conti,i)=a33
4277 C --- Gradient of rij
4279 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4286 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4287 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4288 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4289 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4290 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4295 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4296 C Calculate contact energies
4298 wij=cosa-3.0D0*cosb*cosg
4301 c fac3=dsqrt(-ael6i)/r0ij**3
4302 fac3=dsqrt(-ael6i)*r3ij
4303 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4304 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4305 if (ees0tmp.gt.0) then
4306 ees0pij=dsqrt(ees0tmp)
4310 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4311 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4312 if (ees0tmp.gt.0) then
4313 ees0mij=dsqrt(ees0tmp)
4318 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4319 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4320 C Diagnostics. Comment out or remove after debugging!
4321 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4322 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4323 c ees0m(num_conti,i)=0.0D0
4325 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4326 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4327 C Angular derivatives of the contact function
4328 ees0pij1=fac3/ees0pij
4329 ees0mij1=fac3/ees0mij
4330 fac3p=-3.0D0*fac3*rrmij
4331 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4332 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4334 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4335 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4336 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4337 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4338 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4339 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4340 ecosap=ecosa1+ecosa2
4341 ecosbp=ecosb1+ecosb2
4342 ecosgp=ecosg1+ecosg2
4343 ecosam=ecosa1-ecosa2
4344 ecosbm=ecosb1-ecosb2
4345 ecosgm=ecosg1-ecosg2
4354 facont_hb(num_conti,i)=fcont
4355 fprimcont=fprimcont/rij
4356 cd facont_hb(num_conti,i)=1.0D0
4357 C Following line is for diagnostics.
4360 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4361 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4364 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4365 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4367 gggp(1)=gggp(1)+ees0pijp*xj
4368 gggp(2)=gggp(2)+ees0pijp*yj
4369 gggp(3)=gggp(3)+ees0pijp*zj
4370 gggm(1)=gggm(1)+ees0mijp*xj
4371 gggm(2)=gggm(2)+ees0mijp*yj
4372 gggm(3)=gggm(3)+ees0mijp*zj
4373 C Derivatives due to the contact function
4374 gacont_hbr(1,num_conti,i)=fprimcont*xj
4375 gacont_hbr(2,num_conti,i)=fprimcont*yj
4376 gacont_hbr(3,num_conti,i)=fprimcont*zj
4379 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4380 c following the change of gradient-summation algorithm.
4382 cgrad ghalfp=0.5D0*gggp(k)
4383 cgrad ghalfm=0.5D0*gggm(k)
4384 gacontp_hb1(k,num_conti,i)=!ghalfp
4385 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4386 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4387 gacontp_hb2(k,num_conti,i)=!ghalfp
4388 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4389 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4390 gacontp_hb3(k,num_conti,i)=gggp(k)
4391 gacontm_hb1(k,num_conti,i)=!ghalfm
4392 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4393 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4394 gacontm_hb2(k,num_conti,i)=!ghalfm
4395 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4396 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4397 gacontm_hb3(k,num_conti,i)=gggm(k)
4399 C Diagnostics. Comment out or remove after debugging!
4401 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4402 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4403 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4404 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4405 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4406 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4409 endif ! num_conti.le.maxconts
4412 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4415 ghalf=0.5d0*agg(l,k)
4416 aggi(l,k)=aggi(l,k)+ghalf
4417 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4418 aggj(l,k)=aggj(l,k)+ghalf
4421 if (j.eq.nres-1 .and. i.lt.j-2) then
4424 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4429 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4432 C-----------------------------------------------------------------------------
4433 subroutine eturn3(i,eello_turn3)
4434 C Third- and fourth-order contributions from turns
4435 implicit real*8 (a-h,o-z)
4436 include 'DIMENSIONS'
4437 include 'COMMON.IOUNITS'
4438 include 'COMMON.GEO'
4439 include 'COMMON.VAR'
4440 include 'COMMON.LOCAL'
4441 include 'COMMON.CHAIN'
4442 include 'COMMON.DERIV'
4443 include 'COMMON.INTERACT'
4444 include 'COMMON.CONTACTS'
4445 include 'COMMON.TORSION'
4446 include 'COMMON.VECTORS'
4447 include 'COMMON.FFIELD'
4448 include 'COMMON.CONTROL'
4450 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4451 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4452 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4453 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4454 & auxgmat2(2,2),auxgmatt2(2,2)
4455 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4456 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4457 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4458 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4461 c write (iout,*) "eturn3",i,j,j1,j2
4466 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4468 C Third-order contributions
4475 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4476 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4477 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4478 c auxalary matices for theta gradient
4479 c auxalary matrix for i+1 and constant i+2
4480 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4481 c auxalary matrix for i+2 and constant i+1
4482 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4483 call transpose2(auxmat(1,1),auxmat1(1,1))
4484 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4485 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4486 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4487 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4488 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4489 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4490 C Derivatives in theta
4491 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4492 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4493 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4494 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4496 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4497 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4498 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4499 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4500 cd & ' eello_turn3_num',4*eello_turn3_num
4501 C Derivatives in gamma(i)
4502 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4503 call transpose2(auxmat2(1,1),auxmat3(1,1))
4504 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4505 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4506 C Derivatives in gamma(i+1)
4507 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4508 call transpose2(auxmat2(1,1),auxmat3(1,1))
4509 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4510 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4511 & +0.5d0*(pizda(1,1)+pizda(2,2))
4512 C Cartesian derivatives
4514 c ghalf1=0.5d0*agg(l,1)
4515 c ghalf2=0.5d0*agg(l,2)
4516 c ghalf3=0.5d0*agg(l,3)
4517 c ghalf4=0.5d0*agg(l,4)
4518 a_temp(1,1)=aggi(l,1)!+ghalf1
4519 a_temp(1,2)=aggi(l,2)!+ghalf2
4520 a_temp(2,1)=aggi(l,3)!+ghalf3
4521 a_temp(2,2)=aggi(l,4)!+ghalf4
4522 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4523 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4524 & +0.5d0*(pizda(1,1)+pizda(2,2))
4525 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4526 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4527 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4528 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4529 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4530 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4531 & +0.5d0*(pizda(1,1)+pizda(2,2))
4532 a_temp(1,1)=aggj(l,1)!+ghalf1
4533 a_temp(1,2)=aggj(l,2)!+ghalf2
4534 a_temp(2,1)=aggj(l,3)!+ghalf3
4535 a_temp(2,2)=aggj(l,4)!+ghalf4
4536 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4537 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4538 & +0.5d0*(pizda(1,1)+pizda(2,2))
4539 a_temp(1,1)=aggj1(l,1)
4540 a_temp(1,2)=aggj1(l,2)
4541 a_temp(2,1)=aggj1(l,3)
4542 a_temp(2,2)=aggj1(l,4)
4543 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4544 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4545 & +0.5d0*(pizda(1,1)+pizda(2,2))
4549 C-------------------------------------------------------------------------------
4550 subroutine eturn4(i,eello_turn4)
4551 C Third- and fourth-order contributions from turns
4552 implicit real*8 (a-h,o-z)
4553 include 'DIMENSIONS'
4554 include 'COMMON.IOUNITS'
4555 include 'COMMON.GEO'
4556 include 'COMMON.VAR'
4557 include 'COMMON.LOCAL'
4558 include 'COMMON.CHAIN'
4559 include 'COMMON.DERIV'
4560 include 'COMMON.INTERACT'
4561 include 'COMMON.CONTACTS'
4562 include 'COMMON.TORSION'
4563 include 'COMMON.VECTORS'
4564 include 'COMMON.FFIELD'
4565 include 'COMMON.CONTROL'
4567 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4568 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4569 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4570 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4571 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4572 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4573 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4574 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4575 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4576 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4577 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4580 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4582 C Fourth-order contributions
4590 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4591 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4592 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4593 c write(iout,*)"WCHODZE W PROGRAM"
4598 iti1=itortyp(itype(i+1))
4599 iti2=itortyp(itype(i+2))
4600 iti3=itortyp(itype(i+3))
4601 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4602 call transpose2(EUg(1,1,i+1),e1t(1,1))
4603 call transpose2(Eug(1,1,i+2),e2t(1,1))
4604 call transpose2(Eug(1,1,i+3),e3t(1,1))
4605 C Ematrix derivative in theta
4606 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4607 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4608 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4609 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4610 c eta1 in derivative theta
4611 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4612 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4613 c auxgvec is derivative of Ub2 so i+3 theta
4614 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4615 c auxalary matrix of E i+1
4616 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4619 s1=scalar2(b1(1,i+2),auxvec(1))
4620 c derivative of theta i+2 with constant i+3
4621 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4622 c derivative of theta i+2 with constant i+2
4623 gs32=scalar2(b1(1,i+2),auxgvec(1))
4624 c derivative of E matix in theta of i+1
4625 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4627 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4628 c ea31 in derivative theta
4629 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4630 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4631 c auxilary matrix auxgvec of Ub2 with constant E matirx
4632 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4633 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4634 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4638 s2=scalar2(b1(1,i+1),auxvec(1))
4639 c derivative of theta i+1 with constant i+3
4640 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4641 c derivative of theta i+2 with constant i+1
4642 gs21=scalar2(b1(1,i+1),auxgvec(1))
4643 c derivative of theta i+3 with constant i+1
4644 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4645 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4647 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4648 c two derivatives over diffetent matrices
4649 c gtae3e2 is derivative over i+3
4650 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4651 c ae3gte2 is derivative over i+2
4652 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4653 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4654 c three possible derivative over theta E matices
4656 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4658 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4660 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4661 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4663 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4664 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4665 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4667 eello_turn4=eello_turn4-(s1+s2+s3)
4668 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4669 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4670 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4671 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4672 cd & ' eello_turn4_num',8*eello_turn4_num
4674 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4675 & -(gs13+gsE13+gsEE1)*wturn4
4676 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4677 & -(gs23+gs21+gsEE2)*wturn4
4678 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4679 & -(gs32+gsE31+gsEE3)*wturn4
4680 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4683 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4684 & 'eturn4',i,j,-(s1+s2+s3)
4685 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4686 c & ' eello_turn4_num',8*eello_turn4_num
4687 C Derivatives in gamma(i)
4688 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4689 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4690 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4691 s1=scalar2(b1(1,i+2),auxvec(1))
4692 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4693 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4694 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4695 C Derivatives in gamma(i+1)
4696 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4697 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4698 s2=scalar2(b1(1,i+1),auxvec(1))
4699 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4700 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4701 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4702 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4703 C Derivatives in gamma(i+2)
4704 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4705 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4706 s1=scalar2(b1(1,i+2),auxvec(1))
4707 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4708 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4709 s2=scalar2(b1(1,i+1),auxvec(1))
4710 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4711 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4712 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4713 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4714 C Cartesian derivatives
4715 C Derivatives of this turn contributions in DC(i+2)
4716 if (j.lt.nres-1) then
4718 a_temp(1,1)=agg(l,1)
4719 a_temp(1,2)=agg(l,2)
4720 a_temp(2,1)=agg(l,3)
4721 a_temp(2,2)=agg(l,4)
4722 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4723 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4724 s1=scalar2(b1(1,i+2),auxvec(1))
4725 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4726 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4727 s2=scalar2(b1(1,i+1),auxvec(1))
4728 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4729 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4730 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4732 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4735 C Remaining derivatives of this turn contribution
4737 a_temp(1,1)=aggi(l,1)
4738 a_temp(1,2)=aggi(l,2)
4739 a_temp(2,1)=aggi(l,3)
4740 a_temp(2,2)=aggi(l,4)
4741 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4742 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4743 s1=scalar2(b1(1,i+2),auxvec(1))
4744 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4745 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4746 s2=scalar2(b1(1,i+1),auxvec(1))
4747 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4748 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4749 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4750 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4751 a_temp(1,1)=aggi1(l,1)
4752 a_temp(1,2)=aggi1(l,2)
4753 a_temp(2,1)=aggi1(l,3)
4754 a_temp(2,2)=aggi1(l,4)
4755 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4756 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4757 s1=scalar2(b1(1,i+2),auxvec(1))
4758 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4759 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4760 s2=scalar2(b1(1,i+1),auxvec(1))
4761 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4762 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4763 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4764 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4765 a_temp(1,1)=aggj(l,1)
4766 a_temp(1,2)=aggj(l,2)
4767 a_temp(2,1)=aggj(l,3)
4768 a_temp(2,2)=aggj(l,4)
4769 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4770 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4771 s1=scalar2(b1(1,i+2),auxvec(1))
4772 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4773 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4774 s2=scalar2(b1(1,i+1),auxvec(1))
4775 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4776 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4777 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4778 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4779 a_temp(1,1)=aggj1(l,1)
4780 a_temp(1,2)=aggj1(l,2)
4781 a_temp(2,1)=aggj1(l,3)
4782 a_temp(2,2)=aggj1(l,4)
4783 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4784 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4785 s1=scalar2(b1(1,i+2),auxvec(1))
4786 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4787 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4788 s2=scalar2(b1(1,i+1),auxvec(1))
4789 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4790 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4791 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4792 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4793 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4797 C-----------------------------------------------------------------------------
4798 subroutine vecpr(u,v,w)
4799 implicit real*8(a-h,o-z)
4800 dimension u(3),v(3),w(3)
4801 w(1)=u(2)*v(3)-u(3)*v(2)
4802 w(2)=-u(1)*v(3)+u(3)*v(1)
4803 w(3)=u(1)*v(2)-u(2)*v(1)
4806 C-----------------------------------------------------------------------------
4807 subroutine unormderiv(u,ugrad,unorm,ungrad)
4808 C This subroutine computes the derivatives of a normalized vector u, given
4809 C the derivatives computed without normalization conditions, ugrad. Returns
4812 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4813 double precision vec(3)
4814 double precision scalar
4816 c write (2,*) 'ugrad',ugrad
4819 vec(i)=scalar(ugrad(1,i),u(1))
4821 c write (2,*) 'vec',vec
4824 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4827 c write (2,*) 'ungrad',ungrad
4830 C-----------------------------------------------------------------------------
4831 subroutine escp_soft_sphere(evdw2,evdw2_14)
4833 C This subroutine calculates the excluded-volume interaction energy between
4834 C peptide-group centers and side chains and its gradient in virtual-bond and
4835 C side-chain vectors.
4837 implicit real*8 (a-h,o-z)
4838 include 'DIMENSIONS'
4839 include 'COMMON.GEO'
4840 include 'COMMON.VAR'
4841 include 'COMMON.LOCAL'
4842 include 'COMMON.CHAIN'
4843 include 'COMMON.DERIV'
4844 include 'COMMON.INTERACT'
4845 include 'COMMON.FFIELD'
4846 include 'COMMON.IOUNITS'
4847 include 'COMMON.CONTROL'
4852 cd print '(a)','Enter ESCP'
4853 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4857 do i=iatscp_s,iatscp_e
4858 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4860 xi=0.5D0*(c(1,i)+c(1,i+1))
4861 yi=0.5D0*(c(2,i)+c(2,i+1))
4862 zi=0.5D0*(c(3,i)+c(3,i+1))
4863 C Return atom into box, boxxsize is size of box in x dimension
4865 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4866 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4867 C Condition for being inside the proper box
4868 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4869 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4873 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4874 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4875 C Condition for being inside the proper box
4876 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4877 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4881 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4882 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4883 cC Condition for being inside the proper box
4884 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4885 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4889 if (xi.lt.0) xi=xi+boxxsize
4891 if (yi.lt.0) yi=yi+boxysize
4893 if (zi.lt.0) zi=zi+boxzsize
4894 C xi=xi+xshift*boxxsize
4895 C yi=yi+yshift*boxysize
4896 C zi=zi+zshift*boxzsize
4897 do iint=1,nscp_gr(i)
4899 do j=iscpstart(i,iint),iscpend(i,iint)
4900 if (itype(j).eq.ntyp1) cycle
4901 itypj=iabs(itype(j))
4902 C Uncomment following three lines for SC-p interactions
4906 C Uncomment following three lines for Ca-p interactions
4911 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4912 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4913 C Condition for being inside the proper box
4914 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4915 c & (xj.lt.((-0.5d0)*boxxsize))) then
4919 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4920 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4921 cC Condition for being inside the proper box
4922 c if ((yj.gt.((0.5d0)*boxysize)).or.
4923 c & (yj.lt.((-0.5d0)*boxysize))) then
4927 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4928 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4929 C Condition for being inside the proper box
4930 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4931 c & (zj.lt.((-0.5d0)*boxzsize))) then
4934 if (xj.lt.0) xj=xj+boxxsize
4936 if (yj.lt.0) yj=yj+boxysize
4938 if (zj.lt.0) zj=zj+boxzsize
4939 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4947 xj=xj_safe+xshift*boxxsize
4948 yj=yj_safe+yshift*boxysize
4949 zj=zj_safe+zshift*boxzsize
4950 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4951 if(dist_temp.lt.dist_init) then
4961 if (subchap.eq.1) then
4974 rij=xj*xj+yj*yj+zj*zj
4978 if (rij.lt.r0ijsq) then
4979 evdwij=0.25d0*(rij-r0ijsq)**2
4987 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4992 cgrad if (j.lt.i) then
4993 cd write (iout,*) 'j<i'
4994 C Uncomment following three lines for SC-p interactions
4996 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4999 cd write (iout,*) 'j>i'
5001 cgrad ggg(k)=-ggg(k)
5002 C Uncomment following line for SC-p interactions
5003 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5007 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5009 cgrad kstart=min0(i+1,j)
5010 cgrad kend=max0(i-1,j-1)
5011 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5012 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5013 cgrad do k=kstart,kend
5015 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5019 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5020 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5031 C-----------------------------------------------------------------------------
5032 subroutine escp(evdw2,evdw2_14)
5034 C This subroutine calculates the excluded-volume interaction energy between
5035 C peptide-group centers and side chains and its gradient in virtual-bond and
5036 C side-chain vectors.
5038 implicit real*8 (a-h,o-z)
5039 include 'DIMENSIONS'
5040 include 'COMMON.GEO'
5041 include 'COMMON.VAR'
5042 include 'COMMON.LOCAL'
5043 include 'COMMON.CHAIN'
5044 include 'COMMON.DERIV'
5045 include 'COMMON.INTERACT'
5046 include 'COMMON.FFIELD'
5047 include 'COMMON.IOUNITS'
5048 include 'COMMON.CONTROL'
5049 include 'COMMON.SPLITELE'
5053 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
5054 cd print '(a)','Enter ESCP'
5055 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5059 do i=iatscp_s,iatscp_e
5060 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5062 xi=0.5D0*(c(1,i)+c(1,i+1))
5063 yi=0.5D0*(c(2,i)+c(2,i+1))
5064 zi=0.5D0*(c(3,i)+c(3,i+1))
5066 if (xi.lt.0) xi=xi+boxxsize
5068 if (yi.lt.0) yi=yi+boxysize
5070 if (zi.lt.0) zi=zi+boxzsize
5071 c xi=xi+xshift*boxxsize
5072 c yi=yi+yshift*boxysize
5073 c zi=zi+zshift*boxzsize
5074 c print *,xi,yi,zi,'polozenie i'
5075 C Return atom into box, boxxsize is size of box in x dimension
5077 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5078 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5079 C Condition for being inside the proper box
5080 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5081 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5085 c print *,xi,boxxsize,"pierwszy"
5087 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5088 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5089 C Condition for being inside the proper box
5090 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5091 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5095 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5096 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5097 C Condition for being inside the proper box
5098 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5099 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5102 do iint=1,nscp_gr(i)
5104 do j=iscpstart(i,iint),iscpend(i,iint)
5105 itypj=iabs(itype(j))
5106 if (itypj.eq.ntyp1) cycle
5107 C Uncomment following three lines for SC-p interactions
5111 C Uncomment following three lines for Ca-p interactions
5116 if (xj.lt.0) xj=xj+boxxsize
5118 if (yj.lt.0) yj=yj+boxysize
5120 if (zj.lt.0) zj=zj+boxzsize
5122 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5123 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5124 C Condition for being inside the proper box
5125 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5126 c & (xj.lt.((-0.5d0)*boxxsize))) then
5130 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5131 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5132 cC Condition for being inside the proper box
5133 c if ((yj.gt.((0.5d0)*boxysize)).or.
5134 c & (yj.lt.((-0.5d0)*boxysize))) then
5138 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5139 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5140 C Condition for being inside the proper box
5141 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5142 c & (zj.lt.((-0.5d0)*boxzsize))) then
5145 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5146 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5154 xj=xj_safe+xshift*boxxsize
5155 yj=yj_safe+yshift*boxysize
5156 zj=zj_safe+zshift*boxzsize
5157 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5158 if(dist_temp.lt.dist_init) then
5168 if (subchap.eq.1) then
5177 c print *,xj,yj,zj,'polozenie j'
5178 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5180 sss=sscale(1.0d0/(dsqrt(rrij)))
5181 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5182 c if (sss.eq.0) print *,'czasem jest OK'
5183 if (sss.le.0.0d0) cycle
5184 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5186 e1=fac*fac*aad(itypj,iteli)
5187 e2=fac*bad(itypj,iteli)
5188 if (iabs(j-i) .le. 2) then
5191 evdw2_14=evdw2_14+(e1+e2)*sss
5194 evdw2=evdw2+evdwij*sss
5195 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5196 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5199 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5201 fac=-(evdwij+e1)*rrij*sss
5202 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5206 cgrad if (j.lt.i) then
5207 cd write (iout,*) 'j<i'
5208 C Uncomment following three lines for SC-p interactions
5210 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5213 cd write (iout,*) 'j>i'
5215 cgrad ggg(k)=-ggg(k)
5216 C Uncomment following line for SC-p interactions
5217 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5218 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5222 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5224 cgrad kstart=min0(i+1,j)
5225 cgrad kend=max0(i-1,j-1)
5226 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5227 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5228 cgrad do k=kstart,kend
5230 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5234 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5235 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5237 c endif !endif for sscale cutoff
5247 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5248 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5249 gradx_scp(j,i)=expon*gradx_scp(j,i)
5252 C******************************************************************************
5256 C To save time the factor EXPON has been extracted from ALL components
5257 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5260 C******************************************************************************
5263 C--------------------------------------------------------------------------
5264 subroutine edis(ehpb)
5266 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5268 implicit real*8 (a-h,o-z)
5269 include 'DIMENSIONS'
5270 include 'COMMON.SBRIDGE'
5271 include 'COMMON.CHAIN'
5272 include 'COMMON.DERIV'
5273 include 'COMMON.VAR'
5274 include 'COMMON.INTERACT'
5275 include 'COMMON.IOUNITS'
5276 include 'COMMON.CONTROL'
5282 C write (iout,*) ,"link_end",link_end,constr_dist
5283 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5284 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5285 if (link_end.eq.0) return
5286 do i=link_start,link_end
5287 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5288 C CA-CA distance used in regularization of structure.
5291 C iii and jjj point to the residues for which the distance is assigned.
5292 if (ii.gt.nres) then
5299 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5300 c & dhpb(i),dhpb1(i),forcon(i)
5301 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5302 C distance and angle dependent SS bond potential.
5303 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5304 C & iabs(itype(jjj)).eq.1) then
5305 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5306 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5307 if (.not.dyn_ss .and. i.le.nss) then
5308 C 15/02/13 CC dynamic SSbond - additional check
5309 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5310 & iabs(itype(jjj)).eq.1) then
5311 call ssbond_ene(iii,jjj,eij)
5314 cd write (iout,*) "eij",eij
5315 cd & ' waga=',waga,' fac=',fac
5316 else if (ii.gt.nres .and. jj.gt.nres) then
5317 c Restraints from contact prediction
5319 if (constr_dist.eq.11) then
5320 ehpb=ehpb+fordepth(i)**4.0d0
5321 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5322 fac=fordepth(i)**4.0d0
5323 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5324 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5325 & ehpb,fordepth(i),dd
5327 if (dhpb1(i).gt.0.0d0) then
5328 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5329 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5330 c write (iout,*) "beta nmr",
5331 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5335 C Get the force constant corresponding to this distance.
5337 C Calculate the contribution to energy.
5338 ehpb=ehpb+waga*rdis*rdis
5339 c write (iout,*) "beta reg",dd,waga*rdis*rdis
5341 C Evaluate gradient.
5347 ggg(j)=fac*(c(j,jj)-c(j,ii))
5350 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5351 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5354 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5355 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5358 C Calculate the distance between the two points and its difference from the
5361 if (constr_dist.eq.11) then
5362 ehpb=ehpb+fordepth(i)**4.0d0
5363 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5364 fac=fordepth(i)**4.0d0
5365 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5366 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5367 & ehpb,fordepth(i),dd
5369 if (dhpb1(i).gt.0.0d0) then
5370 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5371 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5372 c write (iout,*) "alph nmr",
5373 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5376 C Get the force constant corresponding to this distance.
5378 C Calculate the contribution to energy.
5379 ehpb=ehpb+waga*rdis*rdis
5380 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5382 C Evaluate gradient.
5388 ggg(j)=fac*(c(j,jj)-c(j,ii))
5390 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5391 C If this is a SC-SC distance, we need to calculate the contributions to the
5392 C Cartesian gradient in the SC vectors (ghpbx).
5395 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5396 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5399 cgrad do j=iii,jjj-1
5401 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5405 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5406 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5410 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5413 C--------------------------------------------------------------------------
5414 subroutine ssbond_ene(i,j,eij)
5416 C Calculate the distance and angle dependent SS-bond potential energy
5417 C using a free-energy function derived based on RHF/6-31G** ab initio
5418 C calculations of diethyl disulfide.
5420 C A. Liwo and U. Kozlowska, 11/24/03
5422 implicit real*8 (a-h,o-z)
5423 include 'DIMENSIONS'
5424 include 'COMMON.SBRIDGE'
5425 include 'COMMON.CHAIN'
5426 include 'COMMON.DERIV'
5427 include 'COMMON.LOCAL'
5428 include 'COMMON.INTERACT'
5429 include 'COMMON.VAR'
5430 include 'COMMON.IOUNITS'
5431 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5432 itypi=iabs(itype(i))
5436 dxi=dc_norm(1,nres+i)
5437 dyi=dc_norm(2,nres+i)
5438 dzi=dc_norm(3,nres+i)
5439 c dsci_inv=dsc_inv(itypi)
5440 dsci_inv=vbld_inv(nres+i)
5441 itypj=iabs(itype(j))
5442 c dscj_inv=dsc_inv(itypj)
5443 dscj_inv=vbld_inv(nres+j)
5447 dxj=dc_norm(1,nres+j)
5448 dyj=dc_norm(2,nres+j)
5449 dzj=dc_norm(3,nres+j)
5450 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5455 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5456 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5457 om12=dxi*dxj+dyi*dyj+dzi*dzj
5459 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5460 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5466 deltat12=om2-om1+2.0d0
5468 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5469 & +akct*deltad*deltat12
5470 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5471 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5472 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5473 c & " deltat12",deltat12," eij",eij
5474 ed=2*akcm*deltad+akct*deltat12
5476 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5477 eom1=-2*akth*deltat1-pom1-om2*pom2
5478 eom2= 2*akth*deltat2+pom1-om1*pom2
5481 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5482 ghpbx(k,i)=ghpbx(k,i)-ggk
5483 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5484 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5485 ghpbx(k,j)=ghpbx(k,j)+ggk
5486 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5487 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5488 ghpbc(k,i)=ghpbc(k,i)-ggk
5489 ghpbc(k,j)=ghpbc(k,j)+ggk
5492 C Calculate the components of the gradient in DC and X
5496 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5501 C--------------------------------------------------------------------------
5502 subroutine ebond(estr)
5504 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5506 implicit real*8 (a-h,o-z)
5507 include 'DIMENSIONS'
5508 include 'COMMON.LOCAL'
5509 include 'COMMON.GEO'
5510 include 'COMMON.INTERACT'
5511 include 'COMMON.DERIV'
5512 include 'COMMON.VAR'
5513 include 'COMMON.CHAIN'
5514 include 'COMMON.IOUNITS'
5515 include 'COMMON.NAMES'
5516 include 'COMMON.FFIELD'
5517 include 'COMMON.CONTROL'
5518 include 'COMMON.SETUP'
5519 double precision u(3),ud(3)
5522 do i=ibondp_start,ibondp_end
5523 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5524 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5526 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5527 c & *dc(j,i-1)/vbld(i)
5529 c if (energy_dec) write(iout,*)
5530 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5532 C Checking if it involves dummy (NH3+ or COO-) group
5533 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5534 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5535 diff = vbld(i)-vbldpDUM
5537 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5538 diff = vbld(i)-vbldp0
5540 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5541 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5544 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5546 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5549 estr=0.5d0*AKP*estr+estr1
5551 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5553 do i=ibond_start,ibond_end
5555 if (iti.ne.10 .and. iti.ne.ntyp1) then
5558 diff=vbld(i+nres)-vbldsc0(1,iti)
5559 if (energy_dec) write (iout,*)
5560 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5561 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5562 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5564 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5568 diff=vbld(i+nres)-vbldsc0(j,iti)
5569 ud(j)=aksc(j,iti)*diff
5570 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5584 uprod2=uprod2*u(k)*u(k)
5588 usumsqder=usumsqder+ud(j)*uprod2
5590 estr=estr+uprod/usum
5592 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5600 C--------------------------------------------------------------------------
5601 subroutine ebend(etheta,ethetacnstr)
5603 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5604 C angles gamma and its derivatives in consecutive thetas and gammas.
5606 implicit real*8 (a-h,o-z)
5607 include 'DIMENSIONS'
5608 include 'COMMON.LOCAL'
5609 include 'COMMON.GEO'
5610 include 'COMMON.INTERACT'
5611 include 'COMMON.DERIV'
5612 include 'COMMON.VAR'
5613 include 'COMMON.CHAIN'
5614 include 'COMMON.IOUNITS'
5615 include 'COMMON.NAMES'
5616 include 'COMMON.FFIELD'
5617 include 'COMMON.CONTROL'
5618 include 'COMMON.TORCNSTR'
5619 common /calcthet/ term1,term2,termm,diffak,ratak,
5620 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5621 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5622 double precision y(2),z(2)
5624 c time11=dexp(-2*time)
5627 c write (*,'(a,i2)') 'EBEND ICG=',icg
5628 do i=ithet_start,ithet_end
5629 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5630 & .or.itype(i).eq.ntyp1) cycle
5631 C Zero the energy function and its derivative at 0 or pi.
5632 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5634 ichir1=isign(1,itype(i-2))
5635 ichir2=isign(1,itype(i))
5636 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5637 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5638 if (itype(i-1).eq.10) then
5639 itype1=isign(10,itype(i-2))
5640 ichir11=isign(1,itype(i-2))
5641 ichir12=isign(1,itype(i-2))
5642 itype2=isign(10,itype(i))
5643 ichir21=isign(1,itype(i))
5644 ichir22=isign(1,itype(i))
5647 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5650 if (phii.ne.phii) phii=150.0
5660 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5663 if (phii1.ne.phii1) phii1=150.0
5675 C Calculate the "mean" value of theta from the part of the distribution
5676 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5677 C In following comments this theta will be referred to as t_c.
5678 thet_pred_mean=0.0d0
5680 athetk=athet(k,it,ichir1,ichir2)
5681 bthetk=bthet(k,it,ichir1,ichir2)
5683 athetk=athet(k,itype1,ichir11,ichir12)
5684 bthetk=bthet(k,itype2,ichir21,ichir22)
5686 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5687 c write(iout,*) 'chuj tu', y(k),z(k)
5689 dthett=thet_pred_mean*ssd
5690 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5691 C Derivatives of the "mean" values in gamma1 and gamma2.
5692 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5693 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5694 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5695 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5697 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5698 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5699 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5700 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5702 if (theta(i).gt.pi-delta) then
5703 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5705 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5706 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5707 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5709 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5711 else if (theta(i).lt.delta) then
5712 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5713 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5714 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5716 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5717 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5720 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5723 etheta=etheta+ethetai
5724 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5725 & 'ebend',i,ethetai,theta(i),itype(i)
5726 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5727 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5728 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5731 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5732 do i=ithetaconstr_start,ithetaconstr_end
5733 itheta=itheta_constr(i)
5734 thetiii=theta(itheta)
5735 difi=pinorm(thetiii-theta_constr0(i))
5736 if (difi.gt.theta_drange(i)) then
5737 difi=difi-theta_drange(i)
5738 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
5739 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5740 & +for_thet_constr(i)*difi**3
5741 else if (difi.lt.-drange(i)) then
5743 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
5744 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5745 & +for_thet_constr(i)*difi**3
5749 if (energy_dec) then
5750 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
5751 & i,itheta,rad2deg*thetiii,
5752 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
5753 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
5754 & gloc(itheta+nphi-2,icg)
5758 C Ufff.... We've done all this!!!
5761 C---------------------------------------------------------------------------
5762 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5764 implicit real*8 (a-h,o-z)
5765 include 'DIMENSIONS'
5766 include 'COMMON.LOCAL'
5767 include 'COMMON.IOUNITS'
5768 common /calcthet/ term1,term2,termm,diffak,ratak,
5769 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5770 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5771 C Calculate the contributions to both Gaussian lobes.
5772 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5773 C The "polynomial part" of the "standard deviation" of this part of
5774 C the distributioni.
5775 ccc write (iout,*) thetai,thet_pred_mean
5778 sig=sig*thet_pred_mean+polthet(j,it)
5780 C Derivative of the "interior part" of the "standard deviation of the"
5781 C gamma-dependent Gaussian lobe in t_c.
5782 sigtc=3*polthet(3,it)
5784 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5787 C Set the parameters of both Gaussian lobes of the distribution.
5788 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5789 fac=sig*sig+sigc0(it)
5792 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5793 sigsqtc=-4.0D0*sigcsq*sigtc
5794 c print *,i,sig,sigtc,sigsqtc
5795 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5796 sigtc=-sigtc/(fac*fac)
5797 C Following variable is sigma(t_c)**(-2)
5798 sigcsq=sigcsq*sigcsq
5800 sig0inv=1.0D0/sig0i**2
5801 delthec=thetai-thet_pred_mean
5802 delthe0=thetai-theta0i
5803 term1=-0.5D0*sigcsq*delthec*delthec
5804 term2=-0.5D0*sig0inv*delthe0*delthe0
5805 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5806 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5807 C NaNs in taking the logarithm. We extract the largest exponent which is added
5808 C to the energy (this being the log of the distribution) at the end of energy
5809 C term evaluation for this virtual-bond angle.
5810 if (term1.gt.term2) then
5812 term2=dexp(term2-termm)
5816 term1=dexp(term1-termm)
5819 C The ratio between the gamma-independent and gamma-dependent lobes of
5820 C the distribution is a Gaussian function of thet_pred_mean too.
5821 diffak=gthet(2,it)-thet_pred_mean
5822 ratak=diffak/gthet(3,it)**2
5823 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5824 C Let's differentiate it in thet_pred_mean NOW.
5826 C Now put together the distribution terms to make complete distribution.
5827 termexp=term1+ak*term2
5828 termpre=sigc+ak*sig0i
5829 C Contribution of the bending energy from this theta is just the -log of
5830 C the sum of the contributions from the two lobes and the pre-exponential
5831 C factor. Simple enough, isn't it?
5832 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5833 C write (iout,*) 'termexp',termexp,termm,termpre,i
5834 C NOW the derivatives!!!
5835 C 6/6/97 Take into account the deformation.
5836 E_theta=(delthec*sigcsq*term1
5837 & +ak*delthe0*sig0inv*term2)/termexp
5838 E_tc=((sigtc+aktc*sig0i)/termpre
5839 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5840 & aktc*term2)/termexp)
5843 c-----------------------------------------------------------------------------
5844 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5845 implicit real*8 (a-h,o-z)
5846 include 'DIMENSIONS'
5847 include 'COMMON.LOCAL'
5848 include 'COMMON.IOUNITS'
5849 common /calcthet/ term1,term2,termm,diffak,ratak,
5850 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5851 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5852 delthec=thetai-thet_pred_mean
5853 delthe0=thetai-theta0i
5854 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5855 t3 = thetai-thet_pred_mean
5859 t14 = t12+t6*sigsqtc
5861 t21 = thetai-theta0i
5867 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5868 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5869 & *(-t12*t9-ak*sig0inv*t27)
5873 C--------------------------------------------------------------------------
5874 subroutine ebend(etheta,ethetacnstr)
5876 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5877 C angles gamma and its derivatives in consecutive thetas and gammas.
5878 C ab initio-derived potentials from
5879 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5881 implicit real*8 (a-h,o-z)
5882 include 'DIMENSIONS'
5883 include 'COMMON.LOCAL'
5884 include 'COMMON.GEO'
5885 include 'COMMON.INTERACT'
5886 include 'COMMON.DERIV'
5887 include 'COMMON.VAR'
5888 include 'COMMON.CHAIN'
5889 include 'COMMON.IOUNITS'
5890 include 'COMMON.NAMES'
5891 include 'COMMON.FFIELD'
5892 include 'COMMON.CONTROL'
5893 include 'COMMON.TORCNSTR'
5894 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5895 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5896 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5897 & sinph1ph2(maxdouble,maxdouble)
5898 logical lprn /.false./, lprn1 /.false./
5900 do i=ithet_start,ithet_end
5901 c print *,i,itype(i-1),itype(i),itype(i-2)
5902 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5903 & .or.itype(i).eq.ntyp1) cycle
5904 C print *,i,theta(i)
5905 if (iabs(itype(i+1)).eq.20) iblock=2
5906 if (iabs(itype(i+1)).ne.20) iblock=1
5910 theti2=0.5d0*theta(i)
5911 ityp2=ithetyp((itype(i-1)))
5913 coskt(k)=dcos(k*theti2)
5914 sinkt(k)=dsin(k*theti2)
5917 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5920 if (phii.ne.phii) phii=150.0
5924 ityp1=ithetyp((itype(i-2)))
5925 C propagation of chirality for glycine type
5927 cosph1(k)=dcos(k*phii)
5928 sinph1(k)=dsin(k*phii)
5933 ityp1=ithetyp((itype(i-2)))
5938 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5941 if (phii1.ne.phii1) phii1=150.0
5946 ityp3=ithetyp((itype(i)))
5948 cosph2(k)=dcos(k*phii1)
5949 sinph2(k)=dsin(k*phii1)
5953 ityp3=ithetyp((itype(i)))
5959 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5962 ccl=cosph1(l)*cosph2(k-l)
5963 ssl=sinph1(l)*sinph2(k-l)
5964 scl=sinph1(l)*cosph2(k-l)
5965 csl=cosph1(l)*sinph2(k-l)
5966 cosph1ph2(l,k)=ccl-ssl
5967 cosph1ph2(k,l)=ccl+ssl
5968 sinph1ph2(l,k)=scl+csl
5969 sinph1ph2(k,l)=scl-csl
5973 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5974 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5975 write (iout,*) "coskt and sinkt"
5977 write (iout,*) k,coskt(k),sinkt(k)
5981 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5982 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5985 & write (iout,*) "k",k,"
5986 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5987 & " ethetai",ethetai
5990 write (iout,*) "cosph and sinph"
5992 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5994 write (iout,*) "cosph1ph2 and sinph2ph2"
5997 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5998 & sinph1ph2(l,k),sinph1ph2(k,l)
6001 write(iout,*) "ethetai",ethetai
6006 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
6007 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
6008 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
6009 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6010 ethetai=ethetai+sinkt(m)*aux
6011 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6012 dephii=dephii+k*sinkt(m)*(
6013 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
6014 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6015 dephii1=dephii1+k*sinkt(m)*(
6016 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
6017 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6019 & write (iout,*) "m",m," k",k," bbthet",
6020 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
6021 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
6022 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
6023 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6024 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6027 C print *,"cosph1", (cosph1(k), k=1,nsingle)
6028 C print *,"cosph2", (cosph2(k), k=1,nsingle)
6029 C print *,"sinph1", (sinph1(k), k=1,nsingle)
6030 C print *,"sinph2", (sinph2(k), k=1,nsingle)
6032 & write(iout,*) "ethetai",ethetai
6033 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6037 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6038 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
6039 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6040 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6041 ethetai=ethetai+sinkt(m)*aux
6042 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6043 dephii=dephii+l*sinkt(m)*(
6044 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
6045 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6046 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6047 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6048 dephii1=dephii1+(k-l)*sinkt(m)*(
6049 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6050 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6051 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
6052 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6054 write (iout,*) "m",m," k",k," l",l," ffthet",
6055 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6056 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
6057 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6058 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
6059 & " ethetai",ethetai
6060 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6061 & cosph1ph2(k,l)*sinkt(m),
6062 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6071 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6072 & i,theta(i)*rad2deg,phii*rad2deg,
6073 & phii1*rad2deg,ethetai
6075 etheta=etheta+ethetai
6076 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6077 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6078 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
6082 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6083 do i=ithetaconstr_start,ithetaconstr_end
6084 itheta=itheta_constr(i)
6085 thetiii=theta(itheta)
6086 difi=pinorm(thetiii-theta_constr0(i))
6087 if (difi.gt.theta_drange(i)) then
6088 difi=difi-theta_drange(i)
6089 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6090 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6091 & +for_thet_constr(i)*difi**3
6092 else if (difi.lt.-drange(i)) then
6094 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6095 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6096 & +for_thet_constr(i)*difi**3
6100 if (energy_dec) then
6101 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6102 & i,itheta,rad2deg*thetiii,
6103 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6104 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6105 & gloc(itheta+nphi-2,icg)
6113 c-----------------------------------------------------------------------------
6114 subroutine esc(escloc)
6115 C Calculate the local energy of a side chain and its derivatives in the
6116 C corresponding virtual-bond valence angles THETA and the spherical angles
6118 implicit real*8 (a-h,o-z)
6119 include 'DIMENSIONS'
6120 include 'COMMON.GEO'
6121 include 'COMMON.LOCAL'
6122 include 'COMMON.VAR'
6123 include 'COMMON.INTERACT'
6124 include 'COMMON.DERIV'
6125 include 'COMMON.CHAIN'
6126 include 'COMMON.IOUNITS'
6127 include 'COMMON.NAMES'
6128 include 'COMMON.FFIELD'
6129 include 'COMMON.CONTROL'
6130 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6131 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6132 common /sccalc/ time11,time12,time112,theti,it,nlobit
6135 c write (iout,'(a)') 'ESC'
6136 do i=loc_start,loc_end
6138 if (it.eq.ntyp1) cycle
6139 if (it.eq.10) goto 1
6140 nlobit=nlob(iabs(it))
6141 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6142 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6143 theti=theta(i+1)-pipol
6148 if (x(2).gt.pi-delta) then
6152 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6154 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6155 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6157 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6158 & ddersc0(1),dersc(1))
6159 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6160 & ddersc0(3),dersc(3))
6162 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6164 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6165 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6166 & dersc0(2),esclocbi,dersc02)
6167 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6169 call splinthet(x(2),0.5d0*delta,ss,ssd)
6174 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6176 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6177 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6179 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6181 c write (iout,*) escloci
6182 else if (x(2).lt.delta) then
6186 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6188 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6189 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6191 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6192 & ddersc0(1),dersc(1))
6193 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6194 & ddersc0(3),dersc(3))
6196 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6198 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6199 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6200 & dersc0(2),esclocbi,dersc02)
6201 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6206 call splinthet(x(2),0.5d0*delta,ss,ssd)
6208 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6210 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6211 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6213 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6214 c write (iout,*) escloci
6216 call enesc(x,escloci,dersc,ddummy,.false.)
6219 escloc=escloc+escloci
6220 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6221 & 'escloc',i,escloci
6222 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6224 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6226 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6227 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6232 C---------------------------------------------------------------------------
6233 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6234 implicit real*8 (a-h,o-z)
6235 include 'DIMENSIONS'
6236 include 'COMMON.GEO'
6237 include 'COMMON.LOCAL'
6238 include 'COMMON.IOUNITS'
6239 common /sccalc/ time11,time12,time112,theti,it,nlobit
6240 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6241 double precision contr(maxlob,-1:1)
6243 c write (iout,*) 'it=',it,' nlobit=',nlobit
6247 if (mixed) ddersc(j)=0.0d0
6251 C Because of periodicity of the dependence of the SC energy in omega we have
6252 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6253 C To avoid underflows, first compute & store the exponents.
6261 z(k)=x(k)-censc(k,j,it)
6266 Axk=Axk+gaussc(l,k,j,it)*z(l)
6272 expfac=expfac+Ax(k,j,iii)*z(k)
6280 C As in the case of ebend, we want to avoid underflows in exponentiation and
6281 C subsequent NaNs and INFs in energy calculation.
6282 C Find the largest exponent
6286 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6290 cd print *,'it=',it,' emin=',emin
6292 C Compute the contribution to SC energy and derivatives
6297 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6298 if(adexp.ne.adexp) adexp=1.0
6301 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6303 cd print *,'j=',j,' expfac=',expfac
6304 escloc_i=escloc_i+expfac
6306 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6310 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6311 & +gaussc(k,2,j,it))*expfac
6318 dersc(1)=dersc(1)/cos(theti)**2
6319 ddersc(1)=ddersc(1)/cos(theti)**2
6322 escloci=-(dlog(escloc_i)-emin)
6324 dersc(j)=dersc(j)/escloc_i
6328 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6333 C------------------------------------------------------------------------------
6334 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6335 implicit real*8 (a-h,o-z)
6336 include 'DIMENSIONS'
6337 include 'COMMON.GEO'
6338 include 'COMMON.LOCAL'
6339 include 'COMMON.IOUNITS'
6340 common /sccalc/ time11,time12,time112,theti,it,nlobit
6341 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6342 double precision contr(maxlob)
6353 z(k)=x(k)-censc(k,j,it)
6359 Axk=Axk+gaussc(l,k,j,it)*z(l)
6365 expfac=expfac+Ax(k,j)*z(k)
6370 C As in the case of ebend, we want to avoid underflows in exponentiation and
6371 C subsequent NaNs and INFs in energy calculation.
6372 C Find the largest exponent
6375 if (emin.gt.contr(j)) emin=contr(j)
6379 C Compute the contribution to SC energy and derivatives
6383 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6384 escloc_i=escloc_i+expfac
6386 dersc(k)=dersc(k)+Ax(k,j)*expfac
6388 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6389 & +gaussc(1,2,j,it))*expfac
6393 dersc(1)=dersc(1)/cos(theti)**2
6394 dersc12=dersc12/cos(theti)**2
6395 escloci=-(dlog(escloc_i)-emin)
6397 dersc(j)=dersc(j)/escloc_i
6399 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6403 c----------------------------------------------------------------------------------
6404 subroutine esc(escloc)
6405 C Calculate the local energy of a side chain and its derivatives in the
6406 C corresponding virtual-bond valence angles THETA and the spherical angles
6407 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6408 C added by Urszula Kozlowska. 07/11/2007
6410 implicit real*8 (a-h,o-z)
6411 include 'DIMENSIONS'
6412 include 'COMMON.GEO'
6413 include 'COMMON.LOCAL'
6414 include 'COMMON.VAR'
6415 include 'COMMON.SCROT'
6416 include 'COMMON.INTERACT'
6417 include 'COMMON.DERIV'
6418 include 'COMMON.CHAIN'
6419 include 'COMMON.IOUNITS'
6420 include 'COMMON.NAMES'
6421 include 'COMMON.FFIELD'
6422 include 'COMMON.CONTROL'
6423 include 'COMMON.VECTORS'
6424 double precision x_prime(3),y_prime(3),z_prime(3)
6425 & , sumene,dsc_i,dp2_i,x(65),
6426 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6427 & de_dxx,de_dyy,de_dzz,de_dt
6428 double precision s1_t,s1_6_t,s2_t,s2_6_t
6430 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6431 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6432 & dt_dCi(3),dt_dCi1(3)
6433 common /sccalc/ time11,time12,time112,theti,it,nlobit
6436 do i=loc_start,loc_end
6437 if (itype(i).eq.ntyp1) cycle
6438 costtab(i+1) =dcos(theta(i+1))
6439 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6440 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6441 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6442 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6443 cosfac=dsqrt(cosfac2)
6444 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6445 sinfac=dsqrt(sinfac2)
6447 if (it.eq.10) goto 1
6449 C Compute the axes of tghe local cartesian coordinates system; store in
6450 c x_prime, y_prime and z_prime
6457 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6458 C & dc_norm(3,i+nres)
6460 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6461 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6464 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6467 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6468 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6469 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6470 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6471 c & " xy",scalar(x_prime(1),y_prime(1)),
6472 c & " xz",scalar(x_prime(1),z_prime(1)),
6473 c & " yy",scalar(y_prime(1),y_prime(1)),
6474 c & " yz",scalar(y_prime(1),z_prime(1)),
6475 c & " zz",scalar(z_prime(1),z_prime(1))
6477 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6478 C to local coordinate system. Store in xx, yy, zz.
6484 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6485 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6486 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6493 C Compute the energy of the ith side cbain
6495 c write (2,*) "xx",xx," yy",yy," zz",zz
6498 x(j) = sc_parmin(j,it)
6501 Cc diagnostics - remove later
6503 yy1 = dsin(alph(2))*dcos(omeg(2))
6504 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6505 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6506 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6508 C," --- ", xx_w,yy_w,zz_w
6511 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6512 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6514 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6515 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6517 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6518 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6519 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6520 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6521 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6523 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6524 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6525 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6526 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6527 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6529 dsc_i = 0.743d0+x(61)
6531 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6532 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6533 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6534 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6535 s1=(1+x(63))/(0.1d0 + dscp1)
6536 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6537 s2=(1+x(65))/(0.1d0 + dscp2)
6538 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6539 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6540 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6541 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6543 c & dscp1,dscp2,sumene
6544 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6545 escloc = escloc + sumene
6546 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6551 C This section to check the numerical derivatives of the energy of ith side
6552 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6553 C #define DEBUG in the code to turn it on.
6555 write (2,*) "sumene =",sumene
6559 write (2,*) xx,yy,zz
6560 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6561 de_dxx_num=(sumenep-sumene)/aincr
6563 write (2,*) "xx+ sumene from enesc=",sumenep
6566 write (2,*) xx,yy,zz
6567 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6568 de_dyy_num=(sumenep-sumene)/aincr
6570 write (2,*) "yy+ sumene from enesc=",sumenep
6573 write (2,*) xx,yy,zz
6574 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6575 de_dzz_num=(sumenep-sumene)/aincr
6577 write (2,*) "zz+ sumene from enesc=",sumenep
6578 costsave=cost2tab(i+1)
6579 sintsave=sint2tab(i+1)
6580 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6581 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6582 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6583 de_dt_num=(sumenep-sumene)/aincr
6584 write (2,*) " t+ sumene from enesc=",sumenep
6585 cost2tab(i+1)=costsave
6586 sint2tab(i+1)=sintsave
6587 C End of diagnostics section.
6590 C Compute the gradient of esc
6592 c zz=zz*dsign(1.0,dfloat(itype(i)))
6593 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6594 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6595 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6596 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6597 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6598 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6599 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6600 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6601 pom1=(sumene3*sint2tab(i+1)+sumene1)
6602 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6603 pom2=(sumene4*cost2tab(i+1)+sumene2)
6604 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6605 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6606 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6607 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6609 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6610 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6611 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6613 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6614 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6615 & +(pom1+pom2)*pom_dx
6617 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6620 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6621 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6622 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6624 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6625 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6626 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6627 & +x(59)*zz**2 +x(60)*xx*zz
6628 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6629 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6630 & +(pom1-pom2)*pom_dy
6632 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6635 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6636 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6637 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6638 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6639 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6640 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6641 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6642 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6644 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6647 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6648 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6649 & +pom1*pom_dt1+pom2*pom_dt2
6651 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6656 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6657 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6658 cosfac2xx=cosfac2*xx
6659 sinfac2yy=sinfac2*yy
6661 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6663 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6665 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6666 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6667 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6668 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6669 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6670 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6671 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6672 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6673 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6674 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6678 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6679 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6680 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6681 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6684 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6685 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6686 dZZ_XYZ(k)=vbld_inv(i+nres)*
6687 & (z_prime(k)-zz*dC_norm(k,i+nres))
6689 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6690 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6694 dXX_Ctab(k,i)=dXX_Ci(k)
6695 dXX_C1tab(k,i)=dXX_Ci1(k)
6696 dYY_Ctab(k,i)=dYY_Ci(k)
6697 dYY_C1tab(k,i)=dYY_Ci1(k)
6698 dZZ_Ctab(k,i)=dZZ_Ci(k)
6699 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6700 dXX_XYZtab(k,i)=dXX_XYZ(k)
6701 dYY_XYZtab(k,i)=dYY_XYZ(k)
6702 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6706 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6707 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6708 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6709 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6710 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6712 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6713 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6714 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6715 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6716 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6717 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6718 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6719 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6721 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6722 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6724 C to check gradient call subroutine check_grad
6730 c------------------------------------------------------------------------------
6731 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6733 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6734 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6735 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6736 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6738 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6739 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6741 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6742 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6743 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6744 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6745 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6747 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6748 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6749 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6750 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6751 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6753 dsc_i = 0.743d0+x(61)
6755 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6756 & *(xx*cost2+yy*sint2))
6757 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6758 & *(xx*cost2-yy*sint2))
6759 s1=(1+x(63))/(0.1d0 + dscp1)
6760 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6761 s2=(1+x(65))/(0.1d0 + dscp2)
6762 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6763 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6764 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6769 c------------------------------------------------------------------------------
6770 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6772 C This procedure calculates two-body contact function g(rij) and its derivative:
6775 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6778 C where x=(rij-r0ij)/delta
6780 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6783 double precision rij,r0ij,eps0ij,fcont,fprimcont
6784 double precision x,x2,x4,delta
6788 if (x.lt.-1.0D0) then
6791 else if (x.le.1.0D0) then
6794 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6795 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6802 c------------------------------------------------------------------------------
6803 subroutine splinthet(theti,delta,ss,ssder)
6804 implicit real*8 (a-h,o-z)
6805 include 'DIMENSIONS'
6806 include 'COMMON.VAR'
6807 include 'COMMON.GEO'
6810 if (theti.gt.pipol) then
6811 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6813 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6818 c------------------------------------------------------------------------------
6819 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6821 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6822 double precision ksi,ksi2,ksi3,a1,a2,a3
6823 a1=fprim0*delta/(f1-f0)
6829 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6830 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6833 c------------------------------------------------------------------------------
6834 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6836 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6837 double precision ksi,ksi2,ksi3,a1,a2,a3
6842 a2=3*(f1x-f0x)-2*fprim0x*delta
6843 a3=fprim0x*delta-2*(f1x-f0x)
6844 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6847 C-----------------------------------------------------------------------------
6849 C-----------------------------------------------------------------------------
6850 subroutine etor(etors,edihcnstr)
6851 implicit real*8 (a-h,o-z)
6852 include 'DIMENSIONS'
6853 include 'COMMON.VAR'
6854 include 'COMMON.GEO'
6855 include 'COMMON.LOCAL'
6856 include 'COMMON.TORSION'
6857 include 'COMMON.INTERACT'
6858 include 'COMMON.DERIV'
6859 include 'COMMON.CHAIN'
6860 include 'COMMON.NAMES'
6861 include 'COMMON.IOUNITS'
6862 include 'COMMON.FFIELD'
6863 include 'COMMON.TORCNSTR'
6864 include 'COMMON.CONTROL'
6866 C Set lprn=.true. for debugging
6870 do i=iphi_start,iphi_end
6872 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6873 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6874 itori=itortyp(itype(i-2))
6875 itori1=itortyp(itype(i-1))
6878 C Proline-Proline pair is a special case...
6879 if (itori.eq.3 .and. itori1.eq.3) then
6880 if (phii.gt.-dwapi3) then
6882 fac=1.0D0/(1.0D0-cosphi)
6883 etorsi=v1(1,3,3)*fac
6884 etorsi=etorsi+etorsi
6885 etors=etors+etorsi-v1(1,3,3)
6886 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6887 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6890 v1ij=v1(j+1,itori,itori1)
6891 v2ij=v2(j+1,itori,itori1)
6894 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6895 if (energy_dec) etors_ii=etors_ii+
6896 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6897 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6901 v1ij=v1(j,itori,itori1)
6902 v2ij=v2(j,itori,itori1)
6905 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6906 if (energy_dec) etors_ii=etors_ii+
6907 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6908 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6911 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6914 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6915 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6916 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6917 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6918 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6920 ! 6/20/98 - dihedral angle constraints
6923 itori=idih_constr(i)
6926 if (difi.gt.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
6930 else if (difi.lt.-drange(i)) then
6932 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
6933 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6935 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6936 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6938 ! write (iout,*) 'edihcnstr',edihcnstr
6941 c------------------------------------------------------------------------------
6942 subroutine etor_d(etors_d)
6946 c----------------------------------------------------------------------------
6948 subroutine etor(etors,edihcnstr)
6949 implicit real*8 (a-h,o-z)
6950 include 'DIMENSIONS'
6951 include 'COMMON.VAR'
6952 include 'COMMON.GEO'
6953 include 'COMMON.LOCAL'
6954 include 'COMMON.TORSION'
6955 include 'COMMON.INTERACT'
6956 include 'COMMON.DERIV'
6957 include 'COMMON.CHAIN'
6958 include 'COMMON.NAMES'
6959 include 'COMMON.IOUNITS'
6960 include 'COMMON.FFIELD'
6961 include 'COMMON.TORCNSTR'
6962 include 'COMMON.CONTROL'
6964 C Set lprn=.true. for debugging
6968 do i=iphi_start,iphi_end
6969 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6970 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6971 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6972 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6973 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6974 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6975 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6976 C For introducing the NH3+ and COO- group please check the etor_d for reference
6979 if (iabs(itype(i)).eq.20) then
6984 itori=itortyp(itype(i-2))
6985 itori1=itortyp(itype(i-1))
6988 C Regular cosine and sine terms
6989 do j=1,nterm(itori,itori1,iblock)
6990 v1ij=v1(j,itori,itori1,iblock)
6991 v2ij=v2(j,itori,itori1,iblock)
6994 etors=etors+v1ij*cosphi+v2ij*sinphi
6995 if (energy_dec) etors_ii=etors_ii+
6996 & v1ij*cosphi+v2ij*sinphi
6997 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7001 C E = SUM ----------------------------------- - v1
7002 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7004 cosphi=dcos(0.5d0*phii)
7005 sinphi=dsin(0.5d0*phii)
7006 do j=1,nlor(itori,itori1,iblock)
7007 vl1ij=vlor1(j,itori,itori1)
7008 vl2ij=vlor2(j,itori,itori1)
7009 vl3ij=vlor3(j,itori,itori1)
7010 pom=vl2ij*cosphi+vl3ij*sinphi
7011 pom1=1.0d0/(pom*pom+1.0d0)
7012 etors=etors+vl1ij*pom1
7013 if (energy_dec) etors_ii=etors_ii+
7016 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7018 C Subtract the constant term
7019 etors=etors-v0(itori,itori1,iblock)
7020 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7021 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
7023 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7024 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7025 & (v1(j,itori,itori1,iblock),j=1,6),
7026 & (v2(j,itori,itori1,iblock),j=1,6)
7027 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7028 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7030 ! 6/20/98 - dihedral angle constraints
7032 c do i=1,ndih_constr
7033 do i=idihconstr_start,idihconstr_end
7034 itori=idih_constr(i)
7036 difi=pinorm(phii-phi0(i))
7037 if (difi.gt.drange(i)) then
7039 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7040 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7041 else if (difi.lt.-drange(i)) then
7043 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7044 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7048 if (energy_dec) then
7049 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
7050 & i,itori,rad2deg*phii,
7051 & rad2deg*phi0(i), rad2deg*drange(i),
7052 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
7055 cd write (iout,*) 'edihcnstr',edihcnstr
7058 c----------------------------------------------------------------------------
7059 subroutine etor_d(etors_d)
7060 C 6/23/01 Compute double torsional energy
7061 implicit real*8 (a-h,o-z)
7062 include 'DIMENSIONS'
7063 include 'COMMON.VAR'
7064 include 'COMMON.GEO'
7065 include 'COMMON.LOCAL'
7066 include 'COMMON.TORSION'
7067 include 'COMMON.INTERACT'
7068 include 'COMMON.DERIV'
7069 include 'COMMON.CHAIN'
7070 include 'COMMON.NAMES'
7071 include 'COMMON.IOUNITS'
7072 include 'COMMON.FFIELD'
7073 include 'COMMON.TORCNSTR'
7075 C Set lprn=.true. for debugging
7079 c write(iout,*) "a tu??"
7080 do i=iphid_start,iphid_end
7081 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7082 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7083 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7084 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7085 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7086 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7087 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7088 & (itype(i+1).eq.ntyp1)) cycle
7089 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7090 itori=itortyp(itype(i-2))
7091 itori1=itortyp(itype(i-1))
7092 itori2=itortyp(itype(i))
7098 if (iabs(itype(i+1)).eq.20) iblock=2
7099 C Iblock=2 Proline type
7100 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7101 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7102 C if (itype(i+1).eq.ntyp1) iblock=3
7103 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7104 C IS or IS NOT need for this
7105 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7106 C is (itype(i-3).eq.ntyp1) ntblock=2
7107 C ntblock is N-terminal blocking group
7109 C Regular cosine and sine terms
7110 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7111 C Example of changes for NH3+ blocking group
7112 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7113 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7114 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7115 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7116 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7117 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7118 cosphi1=dcos(j*phii)
7119 sinphi1=dsin(j*phii)
7120 cosphi2=dcos(j*phii1)
7121 sinphi2=dsin(j*phii1)
7122 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7123 & v2cij*cosphi2+v2sij*sinphi2
7124 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7125 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7127 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7129 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7130 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7131 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7132 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7133 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7134 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7135 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7136 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7137 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7138 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7139 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7140 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7141 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7142 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7145 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7146 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7151 c------------------------------------------------------------------------------
7152 subroutine eback_sc_corr(esccor)
7153 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7154 c conformational states; temporarily implemented as differences
7155 c between UNRES torsional potentials (dependent on three types of
7156 c residues) and the torsional potentials dependent on all 20 types
7157 c of residues computed from AM1 energy surfaces of terminally-blocked
7158 c amino-acid residues.
7159 implicit real*8 (a-h,o-z)
7160 include 'DIMENSIONS'
7161 include 'COMMON.VAR'
7162 include 'COMMON.GEO'
7163 include 'COMMON.LOCAL'
7164 include 'COMMON.TORSION'
7165 include 'COMMON.SCCOR'
7166 include 'COMMON.INTERACT'
7167 include 'COMMON.DERIV'
7168 include 'COMMON.CHAIN'
7169 include 'COMMON.NAMES'
7170 include 'COMMON.IOUNITS'
7171 include 'COMMON.FFIELD'
7172 include 'COMMON.CONTROL'
7174 C Set lprn=.true. for debugging
7177 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7179 do i=itau_start,itau_end
7180 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7182 isccori=isccortyp(itype(i-2))
7183 isccori1=isccortyp(itype(i-1))
7184 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7186 do intertyp=1,3 !intertyp
7187 cc Added 09 May 2012 (Adasko)
7188 cc Intertyp means interaction type of backbone mainchain correlation:
7189 c 1 = SC...Ca...Ca...Ca
7190 c 2 = Ca...Ca...Ca...SC
7191 c 3 = SC...Ca...Ca...SCi
7193 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7194 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7195 & (itype(i-1).eq.ntyp1)))
7196 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7197 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7198 & .or.(itype(i).eq.ntyp1)))
7199 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7200 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7201 & (itype(i-3).eq.ntyp1)))) cycle
7202 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7203 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7205 do j=1,nterm_sccor(isccori,isccori1)
7206 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7207 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7208 cosphi=dcos(j*tauangle(intertyp,i))
7209 sinphi=dsin(j*tauangle(intertyp,i))
7210 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7211 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7213 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7214 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7216 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7217 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
7218 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
7219 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7220 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7226 c----------------------------------------------------------------------------
7227 subroutine multibody(ecorr)
7228 C This subroutine calculates multi-body contributions to energy following
7229 C the idea of Skolnick et al. If side chains I and J make a contact and
7230 C at the same time side chains I+1 and J+1 make a contact, an extra
7231 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7232 implicit real*8 (a-h,o-z)
7233 include 'DIMENSIONS'
7234 include 'COMMON.IOUNITS'
7235 include 'COMMON.DERIV'
7236 include 'COMMON.INTERACT'
7237 include 'COMMON.CONTACTS'
7238 double precision gx(3),gx1(3)
7241 C Set lprn=.true. for debugging
7245 write (iout,'(a)') 'Contact function values:'
7247 write (iout,'(i2,20(1x,i2,f10.5))')
7248 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7263 num_conti=num_cont(i)
7264 num_conti1=num_cont(i1)
7269 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7270 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7271 cd & ' ishift=',ishift
7272 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7273 C The system gains extra energy.
7274 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7275 endif ! j1==j+-ishift
7284 c------------------------------------------------------------------------------
7285 double precision function esccorr(i,j,k,l,jj,kk)
7286 implicit real*8 (a-h,o-z)
7287 include 'DIMENSIONS'
7288 include 'COMMON.IOUNITS'
7289 include 'COMMON.DERIV'
7290 include 'COMMON.INTERACT'
7291 include 'COMMON.CONTACTS'
7292 double precision gx(3),gx1(3)
7297 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7298 C Calculate the multi-body contribution to energy.
7299 C Calculate multi-body contributions to the gradient.
7300 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7301 cd & k,l,(gacont(m,kk,k),m=1,3)
7303 gx(m) =ekl*gacont(m,jj,i)
7304 gx1(m)=eij*gacont(m,kk,k)
7305 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7306 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7307 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7308 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7312 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7317 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7323 c------------------------------------------------------------------------------
7324 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7325 C This subroutine calculates multi-body contributions to hydrogen-bonding
7326 implicit real*8 (a-h,o-z)
7327 include 'DIMENSIONS'
7328 include 'COMMON.IOUNITS'
7331 parameter (max_cont=maxconts)
7332 parameter (max_dim=26)
7333 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7334 double precision zapas(max_dim,maxconts,max_fg_procs),
7335 & zapas_recv(max_dim,maxconts,max_fg_procs)
7336 common /przechowalnia/ zapas
7337 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7338 & status_array(MPI_STATUS_SIZE,maxconts*2)
7340 include 'COMMON.SETUP'
7341 include 'COMMON.FFIELD'
7342 include 'COMMON.DERIV'
7343 include 'COMMON.INTERACT'
7344 include 'COMMON.CONTACTS'
7345 include 'COMMON.CONTROL'
7346 include 'COMMON.LOCAL'
7347 double precision gx(3),gx1(3),time00
7350 C Set lprn=.true. for debugging
7355 if (nfgtasks.le.1) goto 30
7357 write (iout,'(a)') 'Contact function values before RECEIVE:'
7359 write (iout,'(2i3,50(1x,i2,f5.2))')
7360 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7361 & j=1,num_cont_hb(i))
7365 do i=1,ntask_cont_from
7368 do i=1,ntask_cont_to
7371 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7373 C Make the list of contacts to send to send to other procesors
7374 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7376 do i=iturn3_start,iturn3_end
7377 c write (iout,*) "make contact list turn3",i," num_cont",
7379 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7381 do i=iturn4_start,iturn4_end
7382 c write (iout,*) "make contact list turn4",i," num_cont",
7384 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7388 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7390 do j=1,num_cont_hb(i)
7393 iproc=iint_sent_local(k,jjc,ii)
7394 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7395 if (iproc.gt.0) then
7396 ncont_sent(iproc)=ncont_sent(iproc)+1
7397 nn=ncont_sent(iproc)
7399 zapas(2,nn,iproc)=jjc
7400 zapas(3,nn,iproc)=facont_hb(j,i)
7401 zapas(4,nn,iproc)=ees0p(j,i)
7402 zapas(5,nn,iproc)=ees0m(j,i)
7403 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7404 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7405 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7406 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7407 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7408 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7409 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7410 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7411 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7412 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7413 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7414 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7415 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7416 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7417 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7418 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7419 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7420 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7421 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7422 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7423 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7430 & "Numbers of contacts to be sent to other processors",
7431 & (ncont_sent(i),i=1,ntask_cont_to)
7432 write (iout,*) "Contacts sent"
7433 do ii=1,ntask_cont_to
7435 iproc=itask_cont_to(ii)
7436 write (iout,*) nn," contacts to processor",iproc,
7437 & " of CONT_TO_COMM group"
7439 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7447 CorrelID1=nfgtasks+fg_rank+1
7449 C Receive the numbers of needed contacts from other processors
7450 do ii=1,ntask_cont_from
7451 iproc=itask_cont_from(ii)
7453 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7454 & FG_COMM,req(ireq),IERR)
7456 c write (iout,*) "IRECV ended"
7458 C Send the number of contacts needed by other processors
7459 do ii=1,ntask_cont_to
7460 iproc=itask_cont_to(ii)
7462 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7463 & FG_COMM,req(ireq),IERR)
7465 c write (iout,*) "ISEND ended"
7466 c write (iout,*) "number of requests (nn)",ireq
7469 & call MPI_Waitall(ireq,req,status_array,ierr)
7471 c & "Numbers of contacts to be received from other processors",
7472 c & (ncont_recv(i),i=1,ntask_cont_from)
7476 do ii=1,ntask_cont_from
7477 iproc=itask_cont_from(ii)
7479 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7480 c & " of CONT_TO_COMM group"
7484 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7485 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7486 c write (iout,*) "ireq,req",ireq,req(ireq)
7489 C Send the contacts to processors that need them
7490 do ii=1,ntask_cont_to
7491 iproc=itask_cont_to(ii)
7493 c write (iout,*) nn," contacts to processor",iproc,
7494 c & " of CONT_TO_COMM group"
7497 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7498 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7499 c write (iout,*) "ireq,req",ireq,req(ireq)
7501 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7505 c write (iout,*) "number of requests (contacts)",ireq
7506 c write (iout,*) "req",(req(i),i=1,4)
7509 & call MPI_Waitall(ireq,req,status_array,ierr)
7510 do iii=1,ntask_cont_from
7511 iproc=itask_cont_from(iii)
7514 write (iout,*) "Received",nn," contacts from processor",iproc,
7515 & " of CONT_FROM_COMM group"
7518 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7523 ii=zapas_recv(1,i,iii)
7524 c Flag the received contacts to prevent double-counting
7525 jj=-zapas_recv(2,i,iii)
7526 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7528 nnn=num_cont_hb(ii)+1
7531 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7532 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7533 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7534 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7535 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7536 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7537 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7538 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7539 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7540 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7541 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7542 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7543 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7544 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7545 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7546 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7547 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7548 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7549 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7550 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7551 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7552 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7553 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7554 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7559 write (iout,'(a)') 'Contact function values after receive:'
7561 write (iout,'(2i3,50(1x,i3,f5.2))')
7562 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7563 & j=1,num_cont_hb(i))
7570 write (iout,'(a)') 'Contact function values:'
7572 write (iout,'(2i3,50(1x,i3,f5.2))')
7573 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7574 & j=1,num_cont_hb(i))
7578 C Remove the loop below after debugging !!!
7585 C Calculate the local-electrostatic correlation terms
7586 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7588 num_conti=num_cont_hb(i)
7589 num_conti1=num_cont_hb(i+1)
7596 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7597 c & ' jj=',jj,' kk=',kk
7598 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7599 & .or. j.lt.0 .and. j1.gt.0) .and.
7600 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7601 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7602 C The system gains extra energy.
7603 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7604 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7605 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7607 else if (j1.eq.j) then
7608 C Contacts I-J and I-(J+1) occur simultaneously.
7609 C The system loses extra energy.
7610 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7615 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7616 c & ' jj=',jj,' kk=',kk
7618 C Contacts I-J and (I+1)-J occur simultaneously.
7619 C The system loses extra energy.
7620 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7627 c------------------------------------------------------------------------------
7628 subroutine add_hb_contact(ii,jj,itask)
7629 implicit real*8 (a-h,o-z)
7630 include "DIMENSIONS"
7631 include "COMMON.IOUNITS"
7634 parameter (max_cont=maxconts)
7635 parameter (max_dim=26)
7636 include "COMMON.CONTACTS"
7637 double precision zapas(max_dim,maxconts,max_fg_procs),
7638 & zapas_recv(max_dim,maxconts,max_fg_procs)
7639 common /przechowalnia/ zapas
7640 integer i,j,ii,jj,iproc,itask(4),nn
7641 c write (iout,*) "itask",itask
7644 if (iproc.gt.0) then
7645 do j=1,num_cont_hb(ii)
7647 c write (iout,*) "i",ii," j",jj," jjc",jjc
7649 ncont_sent(iproc)=ncont_sent(iproc)+1
7650 nn=ncont_sent(iproc)
7651 zapas(1,nn,iproc)=ii
7652 zapas(2,nn,iproc)=jjc
7653 zapas(3,nn,iproc)=facont_hb(j,ii)
7654 zapas(4,nn,iproc)=ees0p(j,ii)
7655 zapas(5,nn,iproc)=ees0m(j,ii)
7656 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7657 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7658 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7659 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7660 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7661 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7662 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7663 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7664 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7665 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7666 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7667 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7668 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7669 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7670 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7671 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7672 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7673 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7674 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7675 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7676 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7684 c------------------------------------------------------------------------------
7685 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7687 C This subroutine calculates multi-body contributions to hydrogen-bonding
7688 implicit real*8 (a-h,o-z)
7689 include 'DIMENSIONS'
7690 include 'COMMON.IOUNITS'
7693 parameter (max_cont=maxconts)
7694 parameter (max_dim=70)
7695 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7696 double precision zapas(max_dim,maxconts,max_fg_procs),
7697 & zapas_recv(max_dim,maxconts,max_fg_procs)
7698 common /przechowalnia/ zapas
7699 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7700 & status_array(MPI_STATUS_SIZE,maxconts*2)
7702 include 'COMMON.SETUP'
7703 include 'COMMON.FFIELD'
7704 include 'COMMON.DERIV'
7705 include 'COMMON.LOCAL'
7706 include 'COMMON.INTERACT'
7707 include 'COMMON.CONTACTS'
7708 include 'COMMON.CHAIN'
7709 include 'COMMON.CONTROL'
7710 double precision gx(3),gx1(3)
7711 integer num_cont_hb_old(maxres)
7713 double precision eello4,eello5,eelo6,eello_turn6
7714 external eello4,eello5,eello6,eello_turn6
7715 C Set lprn=.true. for debugging
7720 num_cont_hb_old(i)=num_cont_hb(i)
7724 if (nfgtasks.le.1) goto 30
7726 write (iout,'(a)') 'Contact function values before RECEIVE:'
7728 write (iout,'(2i3,50(1x,i2,f5.2))')
7729 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7730 & j=1,num_cont_hb(i))
7734 do i=1,ntask_cont_from
7737 do i=1,ntask_cont_to
7740 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7742 C Make the list of contacts to send to send to other procesors
7743 do i=iturn3_start,iturn3_end
7744 c write (iout,*) "make contact list turn3",i," num_cont",
7746 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7748 do i=iturn4_start,iturn4_end
7749 c write (iout,*) "make contact list turn4",i," num_cont",
7751 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7755 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7757 do j=1,num_cont_hb(i)
7760 iproc=iint_sent_local(k,jjc,ii)
7761 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7762 if (iproc.ne.0) then
7763 ncont_sent(iproc)=ncont_sent(iproc)+1
7764 nn=ncont_sent(iproc)
7766 zapas(2,nn,iproc)=jjc
7767 zapas(3,nn,iproc)=d_cont(j,i)
7771 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7776 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7784 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7795 & "Numbers of contacts to be sent to other processors",
7796 & (ncont_sent(i),i=1,ntask_cont_to)
7797 write (iout,*) "Contacts sent"
7798 do ii=1,ntask_cont_to
7800 iproc=itask_cont_to(ii)
7801 write (iout,*) nn," contacts to processor",iproc,
7802 & " of CONT_TO_COMM group"
7804 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7812 CorrelID1=nfgtasks+fg_rank+1
7814 C Receive the numbers of needed contacts from other processors
7815 do ii=1,ntask_cont_from
7816 iproc=itask_cont_from(ii)
7818 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7819 & FG_COMM,req(ireq),IERR)
7821 c write (iout,*) "IRECV ended"
7823 C Send the number of contacts needed by other processors
7824 do ii=1,ntask_cont_to
7825 iproc=itask_cont_to(ii)
7827 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7828 & FG_COMM,req(ireq),IERR)
7830 c write (iout,*) "ISEND ended"
7831 c write (iout,*) "number of requests (nn)",ireq
7834 & call MPI_Waitall(ireq,req,status_array,ierr)
7836 c & "Numbers of contacts to be received from other processors",
7837 c & (ncont_recv(i),i=1,ntask_cont_from)
7841 do ii=1,ntask_cont_from
7842 iproc=itask_cont_from(ii)
7844 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7845 c & " of CONT_TO_COMM group"
7849 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7850 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7851 c write (iout,*) "ireq,req",ireq,req(ireq)
7854 C Send the contacts to processors that need them
7855 do ii=1,ntask_cont_to
7856 iproc=itask_cont_to(ii)
7858 c write (iout,*) nn," contacts to processor",iproc,
7859 c & " of CONT_TO_COMM group"
7862 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7863 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7864 c write (iout,*) "ireq,req",ireq,req(ireq)
7866 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7870 c write (iout,*) "number of requests (contacts)",ireq
7871 c write (iout,*) "req",(req(i),i=1,4)
7874 & call MPI_Waitall(ireq,req,status_array,ierr)
7875 do iii=1,ntask_cont_from
7876 iproc=itask_cont_from(iii)
7879 write (iout,*) "Received",nn," contacts from processor",iproc,
7880 & " of CONT_FROM_COMM group"
7883 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7888 ii=zapas_recv(1,i,iii)
7889 c Flag the received contacts to prevent double-counting
7890 jj=-zapas_recv(2,i,iii)
7891 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7893 nnn=num_cont_hb(ii)+1
7896 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7900 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7905 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7913 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7922 write (iout,'(a)') 'Contact function values after receive:'
7924 write (iout,'(2i3,50(1x,i3,5f6.3))')
7925 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7926 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7933 write (iout,'(a)') 'Contact function values:'
7935 write (iout,'(2i3,50(1x,i2,5f6.3))')
7936 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7937 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7943 C Remove the loop below after debugging !!!
7950 C Calculate the dipole-dipole interaction energies
7951 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7952 do i=iatel_s,iatel_e+1
7953 num_conti=num_cont_hb(i)
7962 C Calculate the local-electrostatic correlation terms
7963 c write (iout,*) "gradcorr5 in eello5 before loop"
7965 c write (iout,'(i5,3f10.5)')
7966 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7968 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7969 c write (iout,*) "corr loop i",i
7971 num_conti=num_cont_hb(i)
7972 num_conti1=num_cont_hb(i+1)
7979 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7980 c & ' jj=',jj,' kk=',kk
7981 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7982 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7983 & .or. j.lt.0 .and. j1.gt.0) .and.
7984 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7985 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7986 C The system gains extra energy.
7988 sqd1=dsqrt(d_cont(jj,i))
7989 sqd2=dsqrt(d_cont(kk,i1))
7990 sred_geom = sqd1*sqd2
7991 IF (sred_geom.lt.cutoff_corr) THEN
7992 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7994 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7995 cd & ' jj=',jj,' kk=',kk
7996 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7997 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7999 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8000 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8003 cd write (iout,*) 'sred_geom=',sred_geom,
8004 cd & ' ekont=',ekont,' fprim=',fprimcont,
8005 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8006 cd write (iout,*) "g_contij",g_contij
8007 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8008 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8009 call calc_eello(i,jp,i+1,jp1,jj,kk)
8010 if (wcorr4.gt.0.0d0)
8011 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8012 if (energy_dec.and.wcorr4.gt.0.0d0)
8013 1 write (iout,'(a6,4i5,0pf7.3)')
8014 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8015 c write (iout,*) "gradcorr5 before eello5"
8017 c write (iout,'(i5,3f10.5)')
8018 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8020 if (wcorr5.gt.0.0d0)
8021 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8022 c write (iout,*) "gradcorr5 after eello5"
8024 c write (iout,'(i5,3f10.5)')
8025 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8027 if (energy_dec.and.wcorr5.gt.0.0d0)
8028 1 write (iout,'(a6,4i5,0pf7.3)')
8029 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8030 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8031 cd write(2,*)'ijkl',i,jp,i+1,jp1
8032 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
8033 & .or. wturn6.eq.0.0d0))then
8034 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8035 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8036 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8037 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8038 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8039 cd & 'ecorr6=',ecorr6
8040 cd write (iout,'(4e15.5)') sred_geom,
8041 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8042 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8043 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8044 else if (wturn6.gt.0.0d0
8045 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8046 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8047 eturn6=eturn6+eello_turn6(i,jj,kk)
8048 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8049 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8050 cd write (2,*) 'multibody_eello:eturn6',eturn6
8059 num_cont_hb(i)=num_cont_hb_old(i)
8061 c write (iout,*) "gradcorr5 in eello5"
8063 c write (iout,'(i5,3f10.5)')
8064 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8068 c------------------------------------------------------------------------------
8069 subroutine add_hb_contact_eello(ii,jj,itask)
8070 implicit real*8 (a-h,o-z)
8071 include "DIMENSIONS"
8072 include "COMMON.IOUNITS"
8075 parameter (max_cont=maxconts)
8076 parameter (max_dim=70)
8077 include "COMMON.CONTACTS"
8078 double precision zapas(max_dim,maxconts,max_fg_procs),
8079 & zapas_recv(max_dim,maxconts,max_fg_procs)
8080 common /przechowalnia/ zapas
8081 integer i,j,ii,jj,iproc,itask(4),nn
8082 c write (iout,*) "itask",itask
8085 if (iproc.gt.0) then
8086 do j=1,num_cont_hb(ii)
8088 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8090 ncont_sent(iproc)=ncont_sent(iproc)+1
8091 nn=ncont_sent(iproc)
8092 zapas(1,nn,iproc)=ii
8093 zapas(2,nn,iproc)=jjc
8094 zapas(3,nn,iproc)=d_cont(j,ii)
8098 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8103 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8111 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8123 c------------------------------------------------------------------------------
8124 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8125 implicit real*8 (a-h,o-z)
8126 include 'DIMENSIONS'
8127 include 'COMMON.IOUNITS'
8128 include 'COMMON.DERIV'
8129 include 'COMMON.INTERACT'
8130 include 'COMMON.CONTACTS'
8131 double precision gx(3),gx1(3)
8141 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8142 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8143 C Following 4 lines for diagnostics.
8148 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8149 c & 'Contacts ',i,j,
8150 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8151 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8153 C Calculate the multi-body contribution to energy.
8154 c ecorr=ecorr+ekont*ees
8155 C Calculate multi-body contributions to the gradient.
8156 coeffpees0pij=coeffp*ees0pij
8157 coeffmees0mij=coeffm*ees0mij
8158 coeffpees0pkl=coeffp*ees0pkl
8159 coeffmees0mkl=coeffm*ees0mkl
8161 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8162 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8163 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8164 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8165 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8166 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8167 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8168 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8169 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8170 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8171 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8172 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8173 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8174 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8175 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8176 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8177 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8178 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8179 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8180 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8181 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8182 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8183 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8184 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8185 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8190 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8191 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8192 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8193 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8198 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8199 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8200 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8201 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8204 c write (iout,*) "ehbcorr",ekont*ees
8209 C---------------------------------------------------------------------------
8210 subroutine dipole(i,j,jj)
8211 implicit real*8 (a-h,o-z)
8212 include 'DIMENSIONS'
8213 include 'COMMON.IOUNITS'
8214 include 'COMMON.CHAIN'
8215 include 'COMMON.FFIELD'
8216 include 'COMMON.DERIV'
8217 include 'COMMON.INTERACT'
8218 include 'COMMON.CONTACTS'
8219 include 'COMMON.TORSION'
8220 include 'COMMON.VAR'
8221 include 'COMMON.GEO'
8222 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8224 iti1 = itortyp(itype(i+1))
8225 if (j.lt.nres-1) then
8226 itj1 = itortyp(itype(j+1))
8231 dipi(iii,1)=Ub2(iii,i)
8232 dipderi(iii)=Ub2der(iii,i)
8233 dipi(iii,2)=b1(iii,i+1)
8234 dipj(iii,1)=Ub2(iii,j)
8235 dipderj(iii)=Ub2der(iii,j)
8236 dipj(iii,2)=b1(iii,j+1)
8240 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8243 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8250 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8254 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8259 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8260 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8262 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8264 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8266 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8271 C---------------------------------------------------------------------------
8272 subroutine calc_eello(i,j,k,l,jj,kk)
8274 C This subroutine computes matrices and vectors needed to calculate
8275 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8277 implicit real*8 (a-h,o-z)
8278 include 'DIMENSIONS'
8279 include 'COMMON.IOUNITS'
8280 include 'COMMON.CHAIN'
8281 include 'COMMON.DERIV'
8282 include 'COMMON.INTERACT'
8283 include 'COMMON.CONTACTS'
8284 include 'COMMON.TORSION'
8285 include 'COMMON.VAR'
8286 include 'COMMON.GEO'
8287 include 'COMMON.FFIELD'
8288 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8289 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8292 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8293 cd & ' jj=',jj,' kk=',kk
8294 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8295 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8296 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8299 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8300 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8303 call transpose2(aa1(1,1),aa1t(1,1))
8304 call transpose2(aa2(1,1),aa2t(1,1))
8307 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8308 & aa1tder(1,1,lll,kkk))
8309 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8310 & aa2tder(1,1,lll,kkk))
8314 C parallel orientation of the two CA-CA-CA frames.
8316 iti=itortyp(itype(i))
8320 itk1=itortyp(itype(k+1))
8321 itj=itortyp(itype(j))
8322 if (l.lt.nres-1) then
8323 itl1=itortyp(itype(l+1))
8327 C A1 kernel(j+1) A2T
8329 cd write (iout,'(3f10.5,5x,3f10.5)')
8330 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8332 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8333 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8334 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8335 C Following matrices are needed only for 6-th order cumulants
8336 IF (wcorr6.gt.0.0d0) THEN
8337 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8338 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8339 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8340 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8341 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8342 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8343 & ADtEAderx(1,1,1,1,1,1))
8345 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8346 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8347 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8348 & ADtEA1derx(1,1,1,1,1,1))
8350 C End 6-th order cumulants
8353 cd write (2,*) 'In calc_eello6'
8355 cd write (2,*) 'iii=',iii
8357 cd write (2,*) 'kkk=',kkk
8359 cd write (2,'(3(2f10.5),5x)')
8360 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8365 call transpose2(EUgder(1,1,k),auxmat(1,1))
8366 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8367 call transpose2(EUg(1,1,k),auxmat(1,1))
8368 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8369 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8373 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8374 & EAEAderx(1,1,lll,kkk,iii,1))
8378 C A1T kernel(i+1) A2
8379 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8380 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8381 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8382 C Following matrices are needed only for 6-th order cumulants
8383 IF (wcorr6.gt.0.0d0) THEN
8384 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8385 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8386 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8387 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8388 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8389 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8390 & ADtEAderx(1,1,1,1,1,2))
8391 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8392 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8393 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8394 & ADtEA1derx(1,1,1,1,1,2))
8396 C End 6-th order cumulants
8397 call transpose2(EUgder(1,1,l),auxmat(1,1))
8398 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8399 call transpose2(EUg(1,1,l),auxmat(1,1))
8400 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8401 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8405 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8406 & EAEAderx(1,1,lll,kkk,iii,2))
8411 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8412 C They are needed only when the fifth- or the sixth-order cumulants are
8414 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8415 call transpose2(AEA(1,1,1),auxmat(1,1))
8416 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8417 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8418 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8419 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8420 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8421 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8422 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8423 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8424 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8425 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8426 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8427 call transpose2(AEA(1,1,2),auxmat(1,1))
8428 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8429 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8430 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8431 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8432 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8433 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8434 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8435 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8436 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8437 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8438 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8439 C Calculate the Cartesian derivatives of the vectors.
8443 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8444 call matvec2(auxmat(1,1),b1(1,i),
8445 & AEAb1derx(1,lll,kkk,iii,1,1))
8446 call matvec2(auxmat(1,1),Ub2(1,i),
8447 & AEAb2derx(1,lll,kkk,iii,1,1))
8448 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8449 & AEAb1derx(1,lll,kkk,iii,2,1))
8450 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8451 & AEAb2derx(1,lll,kkk,iii,2,1))
8452 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8453 call matvec2(auxmat(1,1),b1(1,j),
8454 & AEAb1derx(1,lll,kkk,iii,1,2))
8455 call matvec2(auxmat(1,1),Ub2(1,j),
8456 & AEAb2derx(1,lll,kkk,iii,1,2))
8457 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8458 & AEAb1derx(1,lll,kkk,iii,2,2))
8459 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8460 & AEAb2derx(1,lll,kkk,iii,2,2))
8467 C Antiparallel orientation of the two CA-CA-CA frames.
8469 iti=itortyp(itype(i))
8473 itk1=itortyp(itype(k+1))
8474 itl=itortyp(itype(l))
8475 itj=itortyp(itype(j))
8476 if (j.lt.nres-1) then
8477 itj1=itortyp(itype(j+1))
8481 C A2 kernel(j-1)T A1T
8482 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8483 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8484 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8485 C Following matrices are needed only for 6-th order cumulants
8486 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8487 & j.eq.i+4 .and. l.eq.i+3)) THEN
8488 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8489 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8490 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8491 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8492 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8493 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8494 & ADtEAderx(1,1,1,1,1,1))
8495 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8496 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8497 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8498 & ADtEA1derx(1,1,1,1,1,1))
8500 C End 6-th order cumulants
8501 call transpose2(EUgder(1,1,k),auxmat(1,1))
8502 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8503 call transpose2(EUg(1,1,k),auxmat(1,1))
8504 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8505 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8509 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8510 & EAEAderx(1,1,lll,kkk,iii,1))
8514 C A2T kernel(i+1)T A1
8515 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8516 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8517 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8518 C Following matrices are needed only for 6-th order cumulants
8519 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8520 & j.eq.i+4 .and. l.eq.i+3)) THEN
8521 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8522 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8523 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8524 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8525 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8526 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8527 & ADtEAderx(1,1,1,1,1,2))
8528 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8529 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8530 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8531 & ADtEA1derx(1,1,1,1,1,2))
8533 C End 6-th order cumulants
8534 call transpose2(EUgder(1,1,j),auxmat(1,1))
8535 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8536 call transpose2(EUg(1,1,j),auxmat(1,1))
8537 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8538 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8542 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8543 & EAEAderx(1,1,lll,kkk,iii,2))
8548 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8549 C They are needed only when the fifth- or the sixth-order cumulants are
8551 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8552 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8553 call transpose2(AEA(1,1,1),auxmat(1,1))
8554 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8555 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8556 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8557 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8558 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8559 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8560 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8561 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8562 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8563 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8564 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8565 call transpose2(AEA(1,1,2),auxmat(1,1))
8566 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8567 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8568 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8569 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8570 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8571 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8572 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8573 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8574 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8575 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8576 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8577 C Calculate the Cartesian derivatives of the vectors.
8581 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8582 call matvec2(auxmat(1,1),b1(1,i),
8583 & AEAb1derx(1,lll,kkk,iii,1,1))
8584 call matvec2(auxmat(1,1),Ub2(1,i),
8585 & AEAb2derx(1,lll,kkk,iii,1,1))
8586 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8587 & AEAb1derx(1,lll,kkk,iii,2,1))
8588 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8589 & AEAb2derx(1,lll,kkk,iii,2,1))
8590 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8591 call matvec2(auxmat(1,1),b1(1,l),
8592 & AEAb1derx(1,lll,kkk,iii,1,2))
8593 call matvec2(auxmat(1,1),Ub2(1,l),
8594 & AEAb2derx(1,lll,kkk,iii,1,2))
8595 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8596 & AEAb1derx(1,lll,kkk,iii,2,2))
8597 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8598 & AEAb2derx(1,lll,kkk,iii,2,2))
8607 C---------------------------------------------------------------------------
8608 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8609 & KK,KKderg,AKA,AKAderg,AKAderx)
8613 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8614 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8615 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8620 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8622 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8625 cd if (lprn) write (2,*) 'In kernel'
8627 cd if (lprn) write (2,*) 'kkk=',kkk
8629 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8630 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8632 cd write (2,*) 'lll=',lll
8633 cd write (2,*) 'iii=1'
8635 cd write (2,'(3(2f10.5),5x)')
8636 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8639 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8640 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8642 cd write (2,*) 'lll=',lll
8643 cd write (2,*) 'iii=2'
8645 cd write (2,'(3(2f10.5),5x)')
8646 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8653 C---------------------------------------------------------------------------
8654 double precision function eello4(i,j,k,l,jj,kk)
8655 implicit real*8 (a-h,o-z)
8656 include 'DIMENSIONS'
8657 include 'COMMON.IOUNITS'
8658 include 'COMMON.CHAIN'
8659 include 'COMMON.DERIV'
8660 include 'COMMON.INTERACT'
8661 include 'COMMON.CONTACTS'
8662 include 'COMMON.TORSION'
8663 include 'COMMON.VAR'
8664 include 'COMMON.GEO'
8665 double precision pizda(2,2),ggg1(3),ggg2(3)
8666 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8670 cd print *,'eello4:',i,j,k,l,jj,kk
8671 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8672 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8673 cold eij=facont_hb(jj,i)
8674 cold ekl=facont_hb(kk,k)
8676 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8677 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8678 gcorr_loc(k-1)=gcorr_loc(k-1)
8679 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8681 gcorr_loc(l-1)=gcorr_loc(l-1)
8682 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8684 gcorr_loc(j-1)=gcorr_loc(j-1)
8685 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8690 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8691 & -EAEAderx(2,2,lll,kkk,iii,1)
8692 cd derx(lll,kkk,iii)=0.0d0
8696 cd gcorr_loc(l-1)=0.0d0
8697 cd gcorr_loc(j-1)=0.0d0
8698 cd gcorr_loc(k-1)=0.0d0
8700 cd write (iout,*)'Contacts have occurred for peptide groups',
8701 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8702 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8703 if (j.lt.nres-1) then
8710 if (l.lt.nres-1) then
8718 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8719 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8720 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8721 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8722 cgrad ghalf=0.5d0*ggg1(ll)
8723 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8724 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8725 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8726 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8727 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8728 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8729 cgrad ghalf=0.5d0*ggg2(ll)
8730 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8731 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8732 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8733 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8734 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8735 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8739 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8744 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8749 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8754 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8758 cd write (2,*) iii,gcorr_loc(iii)
8761 cd write (2,*) 'ekont',ekont
8762 cd write (iout,*) 'eello4',ekont*eel4
8765 C---------------------------------------------------------------------------
8766 double precision function eello5(i,j,k,l,jj,kk)
8767 implicit real*8 (a-h,o-z)
8768 include 'DIMENSIONS'
8769 include 'COMMON.IOUNITS'
8770 include 'COMMON.CHAIN'
8771 include 'COMMON.DERIV'
8772 include 'COMMON.INTERACT'
8773 include 'COMMON.CONTACTS'
8774 include 'COMMON.TORSION'
8775 include 'COMMON.VAR'
8776 include 'COMMON.GEO'
8777 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8778 double precision ggg1(3),ggg2(3)
8779 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8784 C /l\ / \ \ / \ / \ / C
8785 C / \ / \ \ / \ / \ / C
8786 C j| o |l1 | o | o| o | | o |o C
8787 C \ |/k\| |/ \| / |/ \| |/ \| C
8788 C \i/ \ / \ / / \ / \ C
8790 C (I) (II) (III) (IV) C
8792 C eello5_1 eello5_2 eello5_3 eello5_4 C
8794 C Antiparallel chains C
8797 C /j\ / \ \ / \ / \ / C
8798 C / \ / \ \ / \ / \ / C
8799 C j1| o |l | o | o| o | | o |o C
8800 C \ |/k\| |/ \| / |/ \| |/ \| C
8801 C \i/ \ / \ / / \ / \ C
8803 C (I) (II) (III) (IV) C
8805 C eello5_1 eello5_2 eello5_3 eello5_4 C
8807 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8809 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8810 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8815 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8817 itk=itortyp(itype(k))
8818 itl=itortyp(itype(l))
8819 itj=itortyp(itype(j))
8824 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8825 cd & eel5_3_num,eel5_4_num)
8829 derx(lll,kkk,iii)=0.0d0
8833 cd eij=facont_hb(jj,i)
8834 cd ekl=facont_hb(kk,k)
8836 cd write (iout,*)'Contacts have occurred for peptide groups',
8837 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8839 C Contribution from the graph I.
8840 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8841 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8842 call transpose2(EUg(1,1,k),auxmat(1,1))
8843 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8844 vv(1)=pizda(1,1)-pizda(2,2)
8845 vv(2)=pizda(1,2)+pizda(2,1)
8846 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8847 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8848 C Explicit gradient in virtual-dihedral angles.
8849 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8850 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8851 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8852 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8853 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8854 vv(1)=pizda(1,1)-pizda(2,2)
8855 vv(2)=pizda(1,2)+pizda(2,1)
8856 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8857 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8858 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8859 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8860 vv(1)=pizda(1,1)-pizda(2,2)
8861 vv(2)=pizda(1,2)+pizda(2,1)
8863 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8864 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8865 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8867 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8868 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8869 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8871 C Cartesian gradient
8875 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8877 vv(1)=pizda(1,1)-pizda(2,2)
8878 vv(2)=pizda(1,2)+pizda(2,1)
8879 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8880 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8881 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8887 C Contribution from graph II
8888 call transpose2(EE(1,1,itk),auxmat(1,1))
8889 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8890 vv(1)=pizda(1,1)+pizda(2,2)
8891 vv(2)=pizda(2,1)-pizda(1,2)
8892 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8893 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8894 C Explicit gradient in virtual-dihedral angles.
8895 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8896 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8897 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8898 vv(1)=pizda(1,1)+pizda(2,2)
8899 vv(2)=pizda(2,1)-pizda(1,2)
8901 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8902 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8903 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8905 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8906 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8907 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8909 C Cartesian gradient
8913 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8915 vv(1)=pizda(1,1)+pizda(2,2)
8916 vv(2)=pizda(2,1)-pizda(1,2)
8917 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8918 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8919 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8927 C Parallel orientation
8928 C Contribution from graph III
8929 call transpose2(EUg(1,1,l),auxmat(1,1))
8930 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8931 vv(1)=pizda(1,1)-pizda(2,2)
8932 vv(2)=pizda(1,2)+pizda(2,1)
8933 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8934 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8935 C Explicit gradient in virtual-dihedral angles.
8936 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8937 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8938 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8939 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8940 vv(1)=pizda(1,1)-pizda(2,2)
8941 vv(2)=pizda(1,2)+pizda(2,1)
8942 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8943 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8944 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8945 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8946 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8947 vv(1)=pizda(1,1)-pizda(2,2)
8948 vv(2)=pizda(1,2)+pizda(2,1)
8949 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8950 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8951 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8952 C Cartesian gradient
8956 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8958 vv(1)=pizda(1,1)-pizda(2,2)
8959 vv(2)=pizda(1,2)+pizda(2,1)
8960 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8961 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8962 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8967 C Contribution from graph IV
8969 call transpose2(EE(1,1,itl),auxmat(1,1))
8970 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8971 vv(1)=pizda(1,1)+pizda(2,2)
8972 vv(2)=pizda(2,1)-pizda(1,2)
8973 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8974 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8975 C Explicit gradient in virtual-dihedral angles.
8976 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8977 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8978 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8979 vv(1)=pizda(1,1)+pizda(2,2)
8980 vv(2)=pizda(2,1)-pizda(1,2)
8981 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8982 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8983 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8984 C Cartesian gradient
8988 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8990 vv(1)=pizda(1,1)+pizda(2,2)
8991 vv(2)=pizda(2,1)-pizda(1,2)
8992 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8993 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8994 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8999 C Antiparallel orientation
9000 C Contribution from graph III
9002 call transpose2(EUg(1,1,j),auxmat(1,1))
9003 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9004 vv(1)=pizda(1,1)-pizda(2,2)
9005 vv(2)=pizda(1,2)+pizda(2,1)
9006 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9007 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9008 C Explicit gradient in virtual-dihedral angles.
9009 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9010 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9011 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9012 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9013 vv(1)=pizda(1,1)-pizda(2,2)
9014 vv(2)=pizda(1,2)+pizda(2,1)
9015 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9016 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9017 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9018 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9019 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9020 vv(1)=pizda(1,1)-pizda(2,2)
9021 vv(2)=pizda(1,2)+pizda(2,1)
9022 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9023 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9024 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9025 C Cartesian gradient
9029 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9031 vv(1)=pizda(1,1)-pizda(2,2)
9032 vv(2)=pizda(1,2)+pizda(2,1)
9033 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9034 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9035 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9040 C Contribution from graph IV
9042 call transpose2(EE(1,1,itj),auxmat(1,1))
9043 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9044 vv(1)=pizda(1,1)+pizda(2,2)
9045 vv(2)=pizda(2,1)-pizda(1,2)
9046 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9047 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9048 C Explicit gradient in virtual-dihedral angles.
9049 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9050 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9051 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9052 vv(1)=pizda(1,1)+pizda(2,2)
9053 vv(2)=pizda(2,1)-pizda(1,2)
9054 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9055 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9056 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9057 C Cartesian gradient
9061 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9063 vv(1)=pizda(1,1)+pizda(2,2)
9064 vv(2)=pizda(2,1)-pizda(1,2)
9065 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9066 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9067 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9073 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9074 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9075 cd write (2,*) 'ijkl',i,j,k,l
9076 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9077 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9079 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9080 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9081 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9082 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9083 if (j.lt.nres-1) then
9090 if (l.lt.nres-1) then
9100 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9101 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9102 C summed up outside the subrouine as for the other subroutines
9103 C handling long-range interactions. The old code is commented out
9104 C with "cgrad" to keep track of changes.
9106 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9107 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9108 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9109 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9110 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9111 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9112 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9113 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9114 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9115 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9117 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9118 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9119 cgrad ghalf=0.5d0*ggg1(ll)
9121 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9122 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9123 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9124 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9125 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9126 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9127 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9128 cgrad ghalf=0.5d0*ggg2(ll)
9130 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
9131 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9132 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
9133 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9134 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9135 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9140 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9141 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9146 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9147 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9153 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9158 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9162 cd write (2,*) iii,g_corr5_loc(iii)
9165 cd write (2,*) 'ekont',ekont
9166 cd write (iout,*) 'eello5',ekont*eel5
9169 c--------------------------------------------------------------------------
9170 double precision function eello6(i,j,k,l,jj,kk)
9171 implicit real*8 (a-h,o-z)
9172 include 'DIMENSIONS'
9173 include 'COMMON.IOUNITS'
9174 include 'COMMON.CHAIN'
9175 include 'COMMON.DERIV'
9176 include 'COMMON.INTERACT'
9177 include 'COMMON.CONTACTS'
9178 include 'COMMON.TORSION'
9179 include 'COMMON.VAR'
9180 include 'COMMON.GEO'
9181 include 'COMMON.FFIELD'
9182 double precision ggg1(3),ggg2(3)
9183 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9188 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9196 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9197 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9201 derx(lll,kkk,iii)=0.0d0
9205 cd eij=facont_hb(jj,i)
9206 cd ekl=facont_hb(kk,k)
9212 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9213 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9214 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9215 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9216 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9217 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9219 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9220 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9221 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9222 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9223 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9224 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9228 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9230 C If turn contributions are considered, they will be handled separately.
9231 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9232 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9233 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9234 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9235 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9236 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9237 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9239 if (j.lt.nres-1) then
9246 if (l.lt.nres-1) then
9254 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9255 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9256 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9257 cgrad ghalf=0.5d0*ggg1(ll)
9259 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9260 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9261 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9262 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9263 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9264 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9265 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9266 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9267 cgrad ghalf=0.5d0*ggg2(ll)
9268 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9270 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9271 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9272 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9273 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9274 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9275 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9280 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9281 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9286 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9287 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9293 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9298 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9302 cd write (2,*) iii,g_corr6_loc(iii)
9305 cd write (2,*) 'ekont',ekont
9306 cd write (iout,*) 'eello6',ekont*eel6
9309 c--------------------------------------------------------------------------
9310 double precision function eello6_graph1(i,j,k,l,imat,swap)
9311 implicit real*8 (a-h,o-z)
9312 include 'DIMENSIONS'
9313 include 'COMMON.IOUNITS'
9314 include 'COMMON.CHAIN'
9315 include 'COMMON.DERIV'
9316 include 'COMMON.INTERACT'
9317 include 'COMMON.CONTACTS'
9318 include 'COMMON.TORSION'
9319 include 'COMMON.VAR'
9320 include 'COMMON.GEO'
9321 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9325 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9327 C Parallel Antiparallel C
9333 C \ j|/k\| / \ |/k\|l / C
9338 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9339 itk=itortyp(itype(k))
9340 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9341 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9342 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9343 call transpose2(EUgC(1,1,k),auxmat(1,1))
9344 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9345 vv1(1)=pizda1(1,1)-pizda1(2,2)
9346 vv1(2)=pizda1(1,2)+pizda1(2,1)
9347 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9348 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9349 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9350 s5=scalar2(vv(1),Dtobr2(1,i))
9351 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9352 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9353 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9354 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9355 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9356 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9357 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9358 & +scalar2(vv(1),Dtobr2der(1,i)))
9359 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9360 vv1(1)=pizda1(1,1)-pizda1(2,2)
9361 vv1(2)=pizda1(1,2)+pizda1(2,1)
9362 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9363 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9365 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9366 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9367 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9368 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9369 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9371 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9372 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9373 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9374 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9375 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9377 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9378 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9379 vv1(1)=pizda1(1,1)-pizda1(2,2)
9380 vv1(2)=pizda1(1,2)+pizda1(2,1)
9381 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9382 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9383 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9384 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9393 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9394 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9395 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9396 call transpose2(EUgC(1,1,k),auxmat(1,1))
9397 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9399 vv1(1)=pizda1(1,1)-pizda1(2,2)
9400 vv1(2)=pizda1(1,2)+pizda1(2,1)
9401 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9402 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9403 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9404 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9405 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9406 s5=scalar2(vv(1),Dtobr2(1,i))
9407 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9413 c----------------------------------------------------------------------------
9414 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9415 implicit real*8 (a-h,o-z)
9416 include 'DIMENSIONS'
9417 include 'COMMON.IOUNITS'
9418 include 'COMMON.CHAIN'
9419 include 'COMMON.DERIV'
9420 include 'COMMON.INTERACT'
9421 include 'COMMON.CONTACTS'
9422 include 'COMMON.TORSION'
9423 include 'COMMON.VAR'
9424 include 'COMMON.GEO'
9426 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9427 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9430 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9432 C Parallel Antiparallel C
9438 C \ j|/k\| \ |/k\|l C
9443 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9444 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9445 C AL 7/4/01 s1 would occur in the sixth-order moment,
9446 C but not in a cluster cumulant
9448 s1=dip(1,jj,i)*dip(1,kk,k)
9450 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9451 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9452 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9453 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9454 call transpose2(EUg(1,1,k),auxmat(1,1))
9455 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9456 vv(1)=pizda(1,1)-pizda(2,2)
9457 vv(2)=pizda(1,2)+pizda(2,1)
9458 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9459 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9461 eello6_graph2=-(s1+s2+s3+s4)
9463 eello6_graph2=-(s2+s3+s4)
9466 C Derivatives in gamma(i-1)
9469 s1=dipderg(1,jj,i)*dip(1,kk,k)
9471 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9472 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9473 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9474 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9476 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9478 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9480 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9482 C Derivatives in gamma(k-1)
9484 s1=dip(1,jj,i)*dipderg(1,kk,k)
9486 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9487 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9488 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9489 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9490 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9491 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9492 vv(1)=pizda(1,1)-pizda(2,2)
9493 vv(2)=pizda(1,2)+pizda(2,1)
9494 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9496 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9498 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9500 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9501 C Derivatives in gamma(j-1) or gamma(l-1)
9504 s1=dipderg(3,jj,i)*dip(1,kk,k)
9506 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9507 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9508 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9509 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9510 vv(1)=pizda(1,1)-pizda(2,2)
9511 vv(2)=pizda(1,2)+pizda(2,1)
9512 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9515 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9517 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9520 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9521 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9523 C Derivatives in gamma(l-1) or gamma(j-1)
9526 s1=dip(1,jj,i)*dipderg(3,kk,k)
9528 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9529 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9530 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9531 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9532 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9533 vv(1)=pizda(1,1)-pizda(2,2)
9534 vv(2)=pizda(1,2)+pizda(2,1)
9535 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9538 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9540 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9543 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9544 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9546 C Cartesian derivatives.
9548 write (2,*) 'In eello6_graph2'
9550 write (2,*) 'iii=',iii
9552 write (2,*) 'kkk=',kkk
9554 write (2,'(3(2f10.5),5x)')
9555 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9565 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9567 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9570 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9572 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9573 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9575 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9576 call transpose2(EUg(1,1,k),auxmat(1,1))
9577 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9579 vv(1)=pizda(1,1)-pizda(2,2)
9580 vv(2)=pizda(1,2)+pizda(2,1)
9581 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9582 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9584 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9586 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9589 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9591 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9598 c----------------------------------------------------------------------------
9599 double precision function eello6_graph3(i,j,k,l,jj,kk,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 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9612 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9614 C Parallel Antiparallel C
9620 C j|/k\| / |/k\|l / C
9625 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9627 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9628 C energy moment and not to the cluster cumulant.
9629 iti=itortyp(itype(i))
9630 if (j.lt.nres-1) then
9631 itj1=itortyp(itype(j+1))
9635 itk=itortyp(itype(k))
9636 itk1=itortyp(itype(k+1))
9637 if (l.lt.nres-1) then
9638 itl1=itortyp(itype(l+1))
9643 s1=dip(4,jj,i)*dip(4,kk,k)
9645 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9646 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9647 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9648 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9649 call transpose2(EE(1,1,itk),auxmat(1,1))
9650 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9651 vv(1)=pizda(1,1)+pizda(2,2)
9652 vv(2)=pizda(2,1)-pizda(1,2)
9653 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9654 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9655 cd & "sum",-(s2+s3+s4)
9657 eello6_graph3=-(s1+s2+s3+s4)
9659 eello6_graph3=-(s2+s3+s4)
9662 C Derivatives in gamma(k-1)
9663 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9664 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9665 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9666 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9667 C Derivatives in gamma(l-1)
9668 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9669 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9670 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9671 vv(1)=pizda(1,1)+pizda(2,2)
9672 vv(2)=pizda(2,1)-pizda(1,2)
9673 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9674 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9675 C Cartesian derivatives.
9681 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9683 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9686 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9688 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9689 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9691 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9692 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9694 vv(1)=pizda(1,1)+pizda(2,2)
9695 vv(2)=pizda(2,1)-pizda(1,2)
9696 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9698 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9700 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9703 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9705 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9707 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9713 c----------------------------------------------------------------------------
9714 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9715 implicit real*8 (a-h,o-z)
9716 include 'DIMENSIONS'
9717 include 'COMMON.IOUNITS'
9718 include 'COMMON.CHAIN'
9719 include 'COMMON.DERIV'
9720 include 'COMMON.INTERACT'
9721 include 'COMMON.CONTACTS'
9722 include 'COMMON.TORSION'
9723 include 'COMMON.VAR'
9724 include 'COMMON.GEO'
9725 include 'COMMON.FFIELD'
9726 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9727 & auxvec1(2),auxmat1(2,2)
9729 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9731 C Parallel Antiparallel C
9737 C \ j|/k\| \ |/k\|l C
9742 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9744 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9745 C energy moment and not to the cluster cumulant.
9746 cd write (2,*) 'eello_graph4: wturn6',wturn6
9747 iti=itortyp(itype(i))
9748 itj=itortyp(itype(j))
9749 if (j.lt.nres-1) then
9750 itj1=itortyp(itype(j+1))
9754 itk=itortyp(itype(k))
9755 if (k.lt.nres-1) then
9756 itk1=itortyp(itype(k+1))
9760 itl=itortyp(itype(l))
9761 if (l.lt.nres-1) then
9762 itl1=itortyp(itype(l+1))
9766 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9767 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9768 cd & ' itl',itl,' itl1',itl1
9771 s1=dip(3,jj,i)*dip(3,kk,k)
9773 s1=dip(2,jj,j)*dip(2,kk,l)
9776 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9777 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9779 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9780 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9782 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9783 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9785 call transpose2(EUg(1,1,k),auxmat(1,1))
9786 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9787 vv(1)=pizda(1,1)-pizda(2,2)
9788 vv(2)=pizda(2,1)+pizda(1,2)
9789 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9790 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9792 eello6_graph4=-(s1+s2+s3+s4)
9794 eello6_graph4=-(s2+s3+s4)
9796 C Derivatives in gamma(i-1)
9800 s1=dipderg(2,jj,i)*dip(3,kk,k)
9802 s1=dipderg(4,jj,j)*dip(2,kk,l)
9805 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9807 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9808 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9810 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9811 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9813 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9814 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9815 cd write (2,*) 'turn6 derivatives'
9817 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9819 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9823 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9825 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9829 C Derivatives in gamma(k-1)
9832 s1=dip(3,jj,i)*dipderg(2,kk,k)
9834 s1=dip(2,jj,j)*dipderg(4,kk,l)
9837 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9838 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9840 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9841 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9843 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9844 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9846 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9847 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9848 vv(1)=pizda(1,1)-pizda(2,2)
9849 vv(2)=pizda(2,1)+pizda(1,2)
9850 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9851 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9853 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9855 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9859 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9861 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9864 C Derivatives in gamma(j-1) or gamma(l-1)
9865 if (l.eq.j+1 .and. l.gt.1) then
9866 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9867 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9868 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9869 vv(1)=pizda(1,1)-pizda(2,2)
9870 vv(2)=pizda(2,1)+pizda(1,2)
9871 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9872 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9873 else if (j.gt.1) then
9874 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9875 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9876 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9877 vv(1)=pizda(1,1)-pizda(2,2)
9878 vv(2)=pizda(2,1)+pizda(1,2)
9879 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9880 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9881 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9883 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9886 C Cartesian derivatives.
9893 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9895 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9899 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9901 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9905 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9907 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9909 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9910 & b1(1,j+1),auxvec(1))
9911 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9913 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9914 & b1(1,l+1),auxvec(1))
9915 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9917 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9919 vv(1)=pizda(1,1)-pizda(2,2)
9920 vv(2)=pizda(2,1)+pizda(1,2)
9921 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9923 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9925 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9928 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9931 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9934 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9936 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9938 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9942 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9944 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9947 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9949 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9957 c----------------------------------------------------------------------------
9958 double precision function eello_turn6(i,jj,kk)
9959 implicit real*8 (a-h,o-z)
9960 include 'DIMENSIONS'
9961 include 'COMMON.IOUNITS'
9962 include 'COMMON.CHAIN'
9963 include 'COMMON.DERIV'
9964 include 'COMMON.INTERACT'
9965 include 'COMMON.CONTACTS'
9966 include 'COMMON.TORSION'
9967 include 'COMMON.VAR'
9968 include 'COMMON.GEO'
9969 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9970 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9972 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9973 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9974 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9975 C the respective energy moment and not to the cluster cumulant.
9984 iti=itortyp(itype(i))
9985 itk=itortyp(itype(k))
9986 itk1=itortyp(itype(k+1))
9987 itl=itortyp(itype(l))
9988 itj=itortyp(itype(j))
9989 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9990 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9991 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9996 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9998 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10002 derx_turn(lll,kkk,iii)=0.0d0
10009 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10011 cd write (2,*) 'eello6_5',eello6_5
10013 call transpose2(AEA(1,1,1),auxmat(1,1))
10014 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10015 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10016 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10018 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10019 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10020 s2 = scalar2(b1(1,k),vtemp1(1))
10022 call transpose2(AEA(1,1,2),atemp(1,1))
10023 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10024 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10025 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10027 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10028 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10029 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10031 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10032 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10033 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10034 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10035 ss13 = scalar2(b1(1,k),vtemp4(1))
10036 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10038 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10044 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10045 C Derivatives in gamma(i+2)
10049 call transpose2(AEA(1,1,1),auxmatd(1,1))
10050 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10051 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10052 call transpose2(AEAderg(1,1,2),atempd(1,1))
10053 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10054 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10056 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10057 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10058 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10064 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10065 C Derivatives in gamma(i+3)
10067 call transpose2(AEA(1,1,1),auxmatd(1,1))
10068 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10069 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10070 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10072 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10073 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10074 s2d = scalar2(b1(1,k),vtemp1d(1))
10076 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10077 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10079 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10081 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10082 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10083 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10091 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10092 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10094 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10095 & -0.5d0*ekont*(s2d+s12d)
10097 C Derivatives in gamma(i+4)
10098 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10099 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10100 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10102 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10103 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10104 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10112 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10114 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10116 C Derivatives in gamma(i+5)
10118 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10119 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10120 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10122 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10123 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10124 s2d = scalar2(b1(1,k),vtemp1d(1))
10126 call transpose2(AEA(1,1,2),atempd(1,1))
10127 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10128 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10130 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10131 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10133 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10134 ss13d = scalar2(b1(1,k),vtemp4d(1))
10135 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10143 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10144 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10146 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10147 & -0.5d0*ekont*(s2d+s12d)
10149 C Cartesian derivatives
10154 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10155 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10156 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10158 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10159 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10161 s2d = scalar2(b1(1,k),vtemp1d(1))
10163 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10164 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10165 s8d = -(atempd(1,1)+atempd(2,2))*
10166 & scalar2(cc(1,1,itl),vtemp2(1))
10168 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10170 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10171 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10178 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10179 & - 0.5d0*(s1d+s2d)
10181 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10185 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10186 & - 0.5d0*(s8d+s12d)
10188 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10197 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10198 & achuj_tempd(1,1))
10199 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10200 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10201 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10202 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10203 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10205 ss13d = scalar2(b1(1,k),vtemp4d(1))
10206 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10207 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10211 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10212 cd & 16*eel_turn6_num
10214 if (j.lt.nres-1) then
10221 if (l.lt.nres-1) then
10229 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10230 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10231 cgrad ghalf=0.5d0*ggg1(ll)
10233 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10234 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10235 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10236 & +ekont*derx_turn(ll,2,1)
10237 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10238 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10239 & +ekont*derx_turn(ll,4,1)
10240 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10241 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10242 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10243 cgrad ghalf=0.5d0*ggg2(ll)
10245 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10246 & +ekont*derx_turn(ll,2,2)
10247 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10248 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10249 & +ekont*derx_turn(ll,4,2)
10250 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10251 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10252 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10257 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10262 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10268 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10273 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10277 cd write (2,*) iii,g_corr6_loc(iii)
10279 eello_turn6=ekont*eel_turn6
10280 cd write (2,*) 'ekont',ekont
10281 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10285 C-----------------------------------------------------------------------------
10286 double precision function scalar(u,v)
10287 !DIR$ INLINEALWAYS scalar
10289 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10292 double precision u(3),v(3)
10293 cd double precision sc
10301 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10304 crc-------------------------------------------------
10305 SUBROUTINE MATVEC2(A1,V1,V2)
10306 !DIR$ INLINEALWAYS MATVEC2
10308 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10310 implicit real*8 (a-h,o-z)
10311 include 'DIMENSIONS'
10312 DIMENSION A1(2,2),V1(2),V2(2)
10316 c 3 VI=VI+A1(I,K)*V1(K)
10320 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10321 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10326 C---------------------------------------
10327 SUBROUTINE MATMAT2(A1,A2,A3)
10329 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10331 implicit real*8 (a-h,o-z)
10332 include 'DIMENSIONS'
10333 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10334 c DIMENSION AI3(2,2)
10338 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10344 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10345 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10346 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10347 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10355 c-------------------------------------------------------------------------
10356 double precision function scalar2(u,v)
10357 !DIR$ INLINEALWAYS scalar2
10359 double precision u(2),v(2)
10360 double precision sc
10362 scalar2=u(1)*v(1)+u(2)*v(2)
10366 C-----------------------------------------------------------------------------
10368 subroutine transpose2(a,at)
10369 !DIR$ INLINEALWAYS transpose2
10371 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10374 double precision a(2,2),at(2,2)
10381 c--------------------------------------------------------------------------
10382 subroutine transpose(n,a,at)
10385 double precision a(n,n),at(n,n)
10393 C---------------------------------------------------------------------------
10394 subroutine prodmat3(a1,a2,kk,transp,prod)
10395 !DIR$ INLINEALWAYS prodmat3
10397 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10401 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10403 crc double precision auxmat(2,2),prod_(2,2)
10406 crc call transpose2(kk(1,1),auxmat(1,1))
10407 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10408 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10410 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10411 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10412 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10413 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10414 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10415 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10416 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10417 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10420 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10421 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10423 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10424 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10425 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10426 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10427 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10428 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10429 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10430 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10433 c call transpose2(a2(1,1),a2t(1,1))
10436 crc print *,((prod_(i,j),i=1,2),j=1,2)
10437 crc print *,((prod(i,j),i=1,2),j=1,2)
10441 CCC----------------------------------------------
10442 subroutine Eliptransfer(eliptran)
10443 implicit real*8 (a-h,o-z)
10444 include 'DIMENSIONS'
10445 include 'COMMON.GEO'
10446 include 'COMMON.VAR'
10447 include 'COMMON.LOCAL'
10448 include 'COMMON.CHAIN'
10449 include 'COMMON.DERIV'
10450 include 'COMMON.NAMES'
10451 include 'COMMON.INTERACT'
10452 include 'COMMON.IOUNITS'
10453 include 'COMMON.CALC'
10454 include 'COMMON.CONTROL'
10455 include 'COMMON.SPLITELE'
10456 include 'COMMON.SBRIDGE'
10457 C this is done by Adasko
10458 C print *,"wchodze"
10459 C structure of box:
10461 C--bordliptop-- buffore starts
10462 C--bufliptop--- here true lipid starts
10464 C--buflipbot--- lipid ends buffore starts
10465 C--bordlipbot--buffore ends
10467 do i=ilip_start,ilip_end
10469 if (itype(i).eq.ntyp1) cycle
10471 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10472 if (positi.le.0) positi=positi+boxzsize
10474 C first for peptide groups
10475 c for each residue check if it is in lipid or lipid water border area
10476 if ((positi.gt.bordlipbot)
10477 &.and.(positi.lt.bordliptop)) then
10478 C the energy transfer exist
10479 if (positi.lt.buflipbot) then
10480 C what fraction I am in
10482 & ((positi-bordlipbot)/lipbufthick)
10483 C lipbufthick is thickenes of lipid buffore
10484 sslip=sscalelip(fracinbuf)
10485 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10486 eliptran=eliptran+sslip*pepliptran
10487 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10488 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10489 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10491 C print *,"doing sccale for lower part"
10492 C print *,i,sslip,fracinbuf,ssgradlip
10493 elseif (positi.gt.bufliptop) then
10494 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10495 sslip=sscalelip(fracinbuf)
10496 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10497 eliptran=eliptran+sslip*pepliptran
10498 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10499 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10500 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10501 C print *, "doing sscalefor top part"
10502 C print *,i,sslip,fracinbuf,ssgradlip
10504 eliptran=eliptran+pepliptran
10505 C print *,"I am in true lipid"
10508 C eliptran=elpitran+0.0 ! I am in water
10511 C print *, "nic nie bylo w lipidzie?"
10512 C now multiply all by the peptide group transfer factor
10513 C eliptran=eliptran*pepliptran
10514 C now the same for side chains
10516 do i=ilip_start,ilip_end
10517 if (itype(i).eq.ntyp1) cycle
10518 positi=(mod(c(3,i+nres),boxzsize))
10519 if (positi.le.0) positi=positi+boxzsize
10520 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10521 c for each residue check if it is in lipid or lipid water border area
10522 C respos=mod(c(3,i+nres),boxzsize)
10523 C print *,positi,bordlipbot,buflipbot
10524 if ((positi.gt.bordlipbot)
10525 & .and.(positi.lt.bordliptop)) then
10526 C the energy transfer exist
10527 if (positi.lt.buflipbot) then
10529 & ((positi-bordlipbot)/lipbufthick)
10530 C lipbufthick is thickenes of lipid buffore
10531 sslip=sscalelip(fracinbuf)
10532 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10533 eliptran=eliptran+sslip*liptranene(itype(i))
10534 gliptranx(3,i)=gliptranx(3,i)
10535 &+ssgradlip*liptranene(itype(i))
10536 gliptranc(3,i-1)= gliptranc(3,i-1)
10537 &+ssgradlip*liptranene(itype(i))
10538 C print *,"doing sccale for lower part"
10539 elseif (positi.gt.bufliptop) then
10541 &((bordliptop-positi)/lipbufthick)
10542 sslip=sscalelip(fracinbuf)
10543 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10544 eliptran=eliptran+sslip*liptranene(itype(i))
10545 gliptranx(3,i)=gliptranx(3,i)
10546 &+ssgradlip*liptranene(itype(i))
10547 gliptranc(3,i-1)= gliptranc(3,i-1)
10548 &+ssgradlip*liptranene(itype(i))
10549 C print *, "doing sscalefor top part",sslip,fracinbuf
10551 eliptran=eliptran+liptranene(itype(i))
10552 C print *,"I am in true lipid"
10554 endif ! if in lipid or buffor
10556 C eliptran=elpitran+0.0 ! I am in water
10560 C---------------------------------------------------------
10561 C AFM soubroutine for constant force
10562 subroutine AFMforce(Eafmforce)
10563 implicit real*8 (a-h,o-z)
10564 include 'DIMENSIONS'
10565 include 'COMMON.GEO'
10566 include 'COMMON.VAR'
10567 include 'COMMON.LOCAL'
10568 include 'COMMON.CHAIN'
10569 include 'COMMON.DERIV'
10570 include 'COMMON.NAMES'
10571 include 'COMMON.INTERACT'
10572 include 'COMMON.IOUNITS'
10573 include 'COMMON.CALC'
10574 include 'COMMON.CONTROL'
10575 include 'COMMON.SPLITELE'
10576 include 'COMMON.SBRIDGE'
10581 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10582 dist=dist+diffafm(i)**2
10585 Eafmforce=-forceAFMconst*(dist-distafminit)
10587 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
10588 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
10590 C print *,'AFM',Eafmforce
10593 C---------------------------------------------------------
10594 C AFM subroutine with pseudoconstant velocity
10595 subroutine AFMvel(Eafmforce)
10596 implicit real*8 (a-h,o-z)
10597 include 'DIMENSIONS'
10598 include 'COMMON.GEO'
10599 include 'COMMON.VAR'
10600 include 'COMMON.LOCAL'
10601 include 'COMMON.CHAIN'
10602 include 'COMMON.DERIV'
10603 include 'COMMON.NAMES'
10604 include 'COMMON.INTERACT'
10605 include 'COMMON.IOUNITS'
10606 include 'COMMON.CALC'
10607 include 'COMMON.CONTROL'
10608 include 'COMMON.SPLITELE'
10609 include 'COMMON.SBRIDGE'
10611 C Only for check grad COMMENT if not used for checkgrad
10613 C--------------------------------------------------------
10614 C print *,"wchodze"
10618 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10619 dist=dist+diffafm(i)**2
10622 Eafmforce=0.5d0*forceAFMconst
10623 & *(distafminit+totTafm*velAFMconst-dist)**2
10624 C Eafmforce=-forceAFMconst*(dist-distafminit)
10626 gradafm(i,afmend-1)=-forceAFMconst*
10627 &(distafminit+totTafm*velAFMconst-dist)
10629 gradafm(i,afmbeg-1)=forceAFMconst*
10630 &(distafminit+totTafm*velAFMconst-dist)
10633 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
10636 C-----------------------------------------------------------
10637 C first for shielding is setting of function of side-chains
10638 subroutine set_shield_fac
10639 implicit real*8 (a-h,o-z)
10640 include 'DIMENSIONS'
10641 include 'COMMON.CHAIN'
10642 include 'COMMON.DERIV'
10643 include 'COMMON.IOUNITS'
10644 include 'COMMON.SHIELD'
10645 include 'COMMON.INTERACT'
10646 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10647 double precision div77_81/0.974996043d0/,
10648 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10650 C the vector between center of side_chain and peptide group
10651 double precision pep_side(3),long,side_calf(3),
10652 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10653 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10654 C the line belowe needs to be changed for FGPROC>1
10656 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10658 Cif there two consequtive dummy atoms there is no peptide group between them
10659 C the line below has to be changed for FGPROC>1
10662 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10666 C first lets set vector conecting the ithe side-chain with kth side-chain
10667 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10668 C pep_side(j)=2.0d0
10669 C and vector conecting the side-chain with its proper calfa
10670 side_calf(j)=c(j,k+nres)-c(j,k)
10671 C side_calf(j)=2.0d0
10672 pept_group(j)=c(j,i)-c(j,i+1)
10673 C lets have their lenght
10674 dist_pep_side=pep_side(j)**2+dist_pep_side
10675 dist_side_calf=dist_side_calf+side_calf(j)**2
10676 dist_pept_group=dist_pept_group+pept_group(j)**2
10678 dist_pep_side=dsqrt(dist_pep_side)
10679 dist_pept_group=dsqrt(dist_pept_group)
10680 dist_side_calf=dsqrt(dist_side_calf)
10682 pep_side_norm(j)=pep_side(j)/dist_pep_side
10683 side_calf_norm(j)=dist_side_calf
10685 C now sscale fraction
10686 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10687 C print *,buff_shield,"buff"
10689 if (sh_frac_dist.le.0.0) cycle
10690 C If we reach here it means that this side chain reaches the shielding sphere
10691 C Lets add him to the list for gradient
10692 ishield_list(i)=ishield_list(i)+1
10693 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10694 C this list is essential otherwise problem would be O3
10695 shield_list(ishield_list(i),i)=k
10696 C Lets have the sscale value
10697 if (sh_frac_dist.gt.1.0) then
10698 scale_fac_dist=1.0d0
10700 sh_frac_dist_grad(j)=0.0d0
10703 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10704 & *(2.0*sh_frac_dist-3.0d0)
10705 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
10706 & /dist_pep_side/buff_shield*0.5
10707 C remember for the final gradient multiply sh_frac_dist_grad(j)
10708 C for side_chain by factor -2 !
10710 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10711 C print *,"jestem",scale_fac_dist,fac_help_scale,
10712 C & sh_frac_dist_grad(j)
10715 C if ((i.eq.3).and.(k.eq.2)) then
10716 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
10720 C this is what is now we have the distance scaling now volume...
10721 short=short_r_sidechain(itype(k))
10722 long=long_r_sidechain(itype(k))
10723 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
10726 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
10727 C costhet_fac=0.0d0
10729 costhet_grad(j)=costhet_fac*pep_side(j)
10731 C remember for the final gradient multiply costhet_grad(j)
10732 C for side_chain by factor -2 !
10733 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10734 C pep_side0pept_group is vector multiplication
10735 pep_side0pept_group=0.0
10737 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10739 cosalfa=(pep_side0pept_group/
10740 & (dist_pep_side*dist_side_calf))
10741 fac_alfa_sin=1.0-cosalfa**2
10742 fac_alfa_sin=dsqrt(fac_alfa_sin)
10743 rkprim=fac_alfa_sin*(long-short)+short
10745 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
10746 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
10749 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10750 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10751 &*(long-short)/fac_alfa_sin*cosalfa/
10752 &((dist_pep_side*dist_side_calf))*
10753 &((side_calf(j))-cosalfa*
10754 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10756 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10757 &*(long-short)/fac_alfa_sin*cosalfa
10758 &/((dist_pep_side*dist_side_calf))*
10760 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10763 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
10765 C now the gradient...
10766 C grad_shield is gradient of Calfa for peptide groups
10768 grad_shield(j,i)=grad_shield(j,i)
10769 C gradient po skalowaniu
10770 & +(sh_frac_dist_grad(j)
10771 C gradient po costhet
10772 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
10773 &-scale_fac_dist*(cosphi_grad_long(j))
10774 &/(1.0-cosphi) )*div77_81
10776 C grad_shield_side is Cbeta sidechain gradient
10777 grad_shield_side(j,ishield_list(i),i)=
10778 & (sh_frac_dist_grad(j)*-2.0d0
10779 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
10780 & +scale_fac_dist*(cosphi_grad_long(j))
10781 & *2.0d0/(1.0-cosphi))
10782 & *div77_81*VofOverlap
10784 grad_shield_loc(j,ishield_list(i),i)=
10785 & scale_fac_dist*cosphi_grad_loc(j)
10786 & *2.0d0/(1.0-cosphi)
10787 & *div77_81*VofOverlap
10789 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10791 fac_shield(i)=VolumeTotal*div77_81+div4_81
10792 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)