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)
2783 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2784 iti = itortyp(itype(i-2))
2788 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2789 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2790 iti1 = itortyp(itype(i-1))
2798 b1tilde(1,i-2)=b1(1,i-2)
2799 b1tilde(2,i-2)=-b1(2,i-2)
2800 b2tilde(1,i-2)=b2(1,i-2)
2801 b2tilde(2,i-2)=-b2(2,i-2)
2802 EE(1,2,i-2)=eeold(1,2,iti)
2803 EE(2,1,i-2)=eeold(2,1,iti)
2804 EE(2,2,i-2)=eeold(2,2,iti)
2805 EE(1,1,i-2)=eeold(1,1,iti)
2809 do i=ivec_start+2,ivec_end+2
2813 if (i .lt. nres+1) then
2850 if (i .gt. 3 .and. i .lt. nres+1) then
2851 obrot_der(1,i-2)=-sin1
2852 obrot_der(2,i-2)= cos1
2853 Ugder(1,1,i-2)= sin1
2854 Ugder(1,2,i-2)=-cos1
2855 Ugder(2,1,i-2)=-cos1
2856 Ugder(2,2,i-2)=-sin1
2859 obrot2_der(1,i-2)=-dwasin2
2860 obrot2_der(2,i-2)= dwacos2
2861 Ug2der(1,1,i-2)= dwasin2
2862 Ug2der(1,2,i-2)=-dwacos2
2863 Ug2der(2,1,i-2)=-dwacos2
2864 Ug2der(2,2,i-2)=-dwasin2
2866 obrot_der(1,i-2)=0.0d0
2867 obrot_der(2,i-2)=0.0d0
2868 Ugder(1,1,i-2)=0.0d0
2869 Ugder(1,2,i-2)=0.0d0
2870 Ugder(2,1,i-2)=0.0d0
2871 Ugder(2,2,i-2)=0.0d0
2872 obrot2_der(1,i-2)=0.0d0
2873 obrot2_der(2,i-2)=0.0d0
2874 Ug2der(1,1,i-2)=0.0d0
2875 Ug2der(1,2,i-2)=0.0d0
2876 Ug2der(2,1,i-2)=0.0d0
2877 Ug2der(2,2,i-2)=0.0d0
2879 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2880 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2881 iti = itortyp(itype(i-2))
2885 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2886 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2887 iti1 = itortyp(itype(i-1))
2891 cd write (iout,*) '*******i',i,' iti1',iti
2892 cd write (iout,*) 'b1',b1(:,iti)
2893 cd write (iout,*) 'b2',b2(:,iti)
2894 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2895 c if (i .gt. iatel_s+2) then
2896 if (i .gt. nnt+2) then
2897 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2899 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2900 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2902 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2903 c & EE(1,2,iti),EE(2,2,iti)
2904 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2905 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2906 c write(iout,*) "Macierz EUG",
2907 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2909 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2911 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2912 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2913 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2914 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2915 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2926 DtUg2(l,k,i-2)=0.0d0
2930 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2931 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2933 muder(k,i-2)=Ub2der(k,i-2)
2935 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2936 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2937 if (itype(i-1).le.ntyp) then
2938 iti1 = itortyp(itype(i-1))
2946 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2948 C write (iout,*) 'mumu',i,b1(1,i-1),Ub2(1,i-2)
2949 c write (iout,*) 'mu ',mu(:,i-2),i-2
2950 cd write (iout,*) 'mu1',mu1(:,i-2)
2951 cd write (iout,*) 'mu2',mu2(:,i-2)
2952 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2954 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2955 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2956 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2957 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2958 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2959 C Vectors and matrices dependent on a single virtual-bond dihedral.
2960 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2961 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2962 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2963 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2964 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2965 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2966 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2967 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2968 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2971 C Matrices dependent on two consecutive virtual-bond dihedrals.
2972 C The order of matrices is from left to right.
2973 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2975 c do i=max0(ivec_start,2),ivec_end
2977 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2978 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2979 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2980 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2981 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2982 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2983 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2984 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2987 #if defined(MPI) && defined(PARMAT)
2989 c if (fg_rank.eq.0) then
2990 write (iout,*) "Arrays UG and UGDER before GATHER"
2992 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2993 & ((ug(l,k,i),l=1,2),k=1,2),
2994 & ((ugder(l,k,i),l=1,2),k=1,2)
2996 write (iout,*) "Arrays UG2 and UG2DER"
2998 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2999 & ((ug2(l,k,i),l=1,2),k=1,2),
3000 & ((ug2der(l,k,i),l=1,2),k=1,2)
3002 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3004 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3005 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3006 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3008 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3010 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3011 & costab(i),sintab(i),costab2(i),sintab2(i)
3013 write (iout,*) "Array MUDER"
3015 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3019 if (nfgtasks.gt.1) then
3021 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
3022 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
3023 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
3025 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
3026 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3028 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
3029 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3031 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
3032 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3034 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
3035 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3037 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
3038 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3040 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
3041 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3043 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
3044 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
3045 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3046 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
3047 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
3048 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3049 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
3050 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
3051 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3052 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
3053 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
3054 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3055 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3057 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
3058 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3060 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
3061 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3063 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
3064 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3066 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3067 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3069 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3070 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3072 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3073 & ivec_count(fg_rank1),
3074 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3076 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3077 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3079 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3080 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3082 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3083 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3085 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3086 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3088 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3089 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3091 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3092 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3094 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3095 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3097 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3098 & ivec_count(fg_rank1),
3099 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3101 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3102 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3104 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3105 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3107 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3108 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3110 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3111 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3113 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3114 & ivec_count(fg_rank1),
3115 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3117 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3118 & ivec_count(fg_rank1),
3119 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3121 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3122 & ivec_count(fg_rank1),
3123 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3124 & MPI_MAT2,FG_COMM1,IERR)
3125 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3126 & ivec_count(fg_rank1),
3127 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3128 & MPI_MAT2,FG_COMM1,IERR)
3131 c Passes matrix info through the ring
3134 if (irecv.lt.0) irecv=nfgtasks1-1
3137 if (inext.ge.nfgtasks1) inext=0
3139 c write (iout,*) "isend",isend," irecv",irecv
3141 lensend=lentyp(isend)
3142 lenrecv=lentyp(irecv)
3143 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3144 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3145 c & MPI_ROTAT1(lensend),inext,2200+isend,
3146 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3147 c & iprev,2200+irecv,FG_COMM,status,IERR)
3148 c write (iout,*) "Gather ROTAT1"
3150 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3151 c & MPI_ROTAT2(lensend),inext,3300+isend,
3152 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3153 c & iprev,3300+irecv,FG_COMM,status,IERR)
3154 c write (iout,*) "Gather ROTAT2"
3156 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3157 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3158 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3159 & iprev,4400+irecv,FG_COMM,status,IERR)
3160 c write (iout,*) "Gather ROTAT_OLD"
3162 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3163 & MPI_PRECOMP11(lensend),inext,5500+isend,
3164 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3165 & iprev,5500+irecv,FG_COMM,status,IERR)
3166 c write (iout,*) "Gather PRECOMP11"
3168 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3169 & MPI_PRECOMP12(lensend),inext,6600+isend,
3170 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3171 & iprev,6600+irecv,FG_COMM,status,IERR)
3172 c write (iout,*) "Gather PRECOMP12"
3174 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3176 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3177 & MPI_ROTAT2(lensend),inext,7700+isend,
3178 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3179 & iprev,7700+irecv,FG_COMM,status,IERR)
3180 c write (iout,*) "Gather PRECOMP21"
3182 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3183 & MPI_PRECOMP22(lensend),inext,8800+isend,
3184 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3185 & iprev,8800+irecv,FG_COMM,status,IERR)
3186 c write (iout,*) "Gather PRECOMP22"
3188 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3189 & MPI_PRECOMP23(lensend),inext,9900+isend,
3190 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3191 & MPI_PRECOMP23(lenrecv),
3192 & iprev,9900+irecv,FG_COMM,status,IERR)
3193 c write (iout,*) "Gather PRECOMP23"
3198 if (irecv.lt.0) irecv=nfgtasks1-1
3201 time_gather=time_gather+MPI_Wtime()-time00
3204 c if (fg_rank.eq.0) then
3205 write (iout,*) "Arrays UG and UGDER"
3207 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3208 & ((ug(l,k,i),l=1,2),k=1,2),
3209 & ((ugder(l,k,i),l=1,2),k=1,2)
3211 write (iout,*) "Arrays UG2 and UG2DER"
3213 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3214 & ((ug2(l,k,i),l=1,2),k=1,2),
3215 & ((ug2der(l,k,i),l=1,2),k=1,2)
3217 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3219 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3220 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3221 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3223 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3225 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3226 & costab(i),sintab(i),costab2(i),sintab2(i)
3228 write (iout,*) "Array MUDER"
3230 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3236 cd iti = itortyp(itype(i))
3239 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3240 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3245 C--------------------------------------------------------------------------
3246 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3248 C This subroutine calculates the average interaction energy and its gradient
3249 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3250 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3251 C The potential depends both on the distance of peptide-group centers and on
3252 C the orientation of the CA-CA virtual bonds.
3254 implicit real*8 (a-h,o-z)
3258 include 'DIMENSIONS'
3259 include 'COMMON.CONTROL'
3260 include 'COMMON.SETUP'
3261 include 'COMMON.IOUNITS'
3262 include 'COMMON.GEO'
3263 include 'COMMON.VAR'
3264 include 'COMMON.LOCAL'
3265 include 'COMMON.CHAIN'
3266 include 'COMMON.DERIV'
3267 include 'COMMON.INTERACT'
3268 include 'COMMON.CONTACTS'
3269 include 'COMMON.TORSION'
3270 include 'COMMON.VECTORS'
3271 include 'COMMON.FFIELD'
3272 include 'COMMON.TIME1'
3273 include 'COMMON.SPLITELE'
3274 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3275 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3276 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3277 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3278 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3279 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3281 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3283 double precision scal_el /1.0d0/
3285 double precision scal_el /0.5d0/
3288 C 13-go grudnia roku pamietnego...
3289 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3290 & 0.0d0,1.0d0,0.0d0,
3291 & 0.0d0,0.0d0,1.0d0/
3292 cd write(iout,*) 'In EELEC'
3294 cd write(iout,*) 'Type',i
3295 cd write(iout,*) 'B1',B1(:,i)
3296 cd write(iout,*) 'B2',B2(:,i)
3297 cd write(iout,*) 'CC',CC(:,:,i)
3298 cd write(iout,*) 'DD',DD(:,:,i)
3299 cd write(iout,*) 'EE',EE(:,:,i)
3301 cd call check_vecgrad
3303 if (icheckgrad.eq.1) then
3305 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3307 dc_norm(k,i)=dc(k,i)*fac
3309 c write (iout,*) 'i',i,' fac',fac
3312 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3313 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3314 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3315 c call vec_and_deriv
3321 time_mat=time_mat+MPI_Wtime()-time01
3325 cd write (iout,*) 'i=',i
3327 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3330 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3331 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3344 cd print '(a)','Enter EELEC'
3345 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3347 gel_loc_loc(i)=0.0d0
3352 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3354 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3356 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3357 do i=iturn3_start,iturn3_end
3359 C write(iout,*) "tu jest i",i
3360 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3361 C changes suggested by Ana to avoid out of bounds
3362 & .or.((i+4).gt.nres)
3364 C end of changes by Ana
3365 & .or. itype(i+2).eq.ntyp1
3366 & .or. itype(i+3).eq.ntyp1) cycle
3368 if(itype(i-1).eq.ntyp1)cycle
3371 if (itype(i+4).eq.ntyp1) cycle
3376 dx_normi=dc_norm(1,i)
3377 dy_normi=dc_norm(2,i)
3378 dz_normi=dc_norm(3,i)
3379 xmedi=c(1,i)+0.5d0*dxi
3380 ymedi=c(2,i)+0.5d0*dyi
3381 zmedi=c(3,i)+0.5d0*dzi
3382 xmedi=mod(xmedi,boxxsize)
3383 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3384 ymedi=mod(ymedi,boxysize)
3385 if (ymedi.lt.0) ymedi=ymedi+boxysize
3386 zmedi=mod(zmedi,boxzsize)
3387 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3389 call eelecij(i,i+2,ees,evdw1,eel_loc)
3390 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3391 num_cont_hb(i)=num_conti
3393 do i=iturn4_start,iturn4_end
3395 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3396 C changes suggested by Ana to avoid out of bounds
3397 & .or.((i+5).gt.nres)
3399 C end of changes suggested by Ana
3400 & .or. itype(i+3).eq.ntyp1
3401 & .or. itype(i+4).eq.ntyp1
3402 & .or. itype(i+5).eq.ntyp1
3403 & .or. itype(i).eq.ntyp1
3404 & .or. itype(i-1).eq.ntyp1
3409 dx_normi=dc_norm(1,i)
3410 dy_normi=dc_norm(2,i)
3411 dz_normi=dc_norm(3,i)
3412 xmedi=c(1,i)+0.5d0*dxi
3413 ymedi=c(2,i)+0.5d0*dyi
3414 zmedi=c(3,i)+0.5d0*dzi
3415 C Return atom into box, boxxsize is size of box in x dimension
3417 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3418 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3419 C Condition for being inside the proper box
3420 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3421 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3425 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3426 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3427 C Condition for being inside the proper box
3428 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3429 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3433 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3434 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3435 C Condition for being inside the proper box
3436 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3437 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3440 xmedi=mod(xmedi,boxxsize)
3441 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3442 ymedi=mod(ymedi,boxysize)
3443 if (ymedi.lt.0) ymedi=ymedi+boxysize
3444 zmedi=mod(zmedi,boxzsize)
3445 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3447 num_conti=num_cont_hb(i)
3448 c write(iout,*) "JESTEM W PETLI"
3449 call eelecij(i,i+3,ees,evdw1,eel_loc)
3450 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3451 & call eturn4(i,eello_turn4)
3452 num_cont_hb(i)=num_conti
3454 C Loop over all neighbouring boxes
3459 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3462 do i=iatel_s,iatel_e
3465 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3466 C changes suggested by Ana to avoid out of bounds
3467 & .or.((i+2).gt.nres)
3469 C end of changes by Ana
3470 & .or. itype(i+2).eq.ntyp1
3471 & .or. itype(i-1).eq.ntyp1
3476 dx_normi=dc_norm(1,i)
3477 dy_normi=dc_norm(2,i)
3478 dz_normi=dc_norm(3,i)
3479 xmedi=c(1,i)+0.5d0*dxi
3480 ymedi=c(2,i)+0.5d0*dyi
3481 zmedi=c(3,i)+0.5d0*dzi
3482 xmedi=mod(xmedi,boxxsize)
3483 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3484 ymedi=mod(ymedi,boxysize)
3485 if (ymedi.lt.0) ymedi=ymedi+boxysize
3486 zmedi=mod(zmedi,boxzsize)
3487 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3488 C xmedi=xmedi+xshift*boxxsize
3489 C ymedi=ymedi+yshift*boxysize
3490 C zmedi=zmedi+zshift*boxzsize
3492 C Return tom into box, boxxsize is size of box in x dimension
3494 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3495 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3496 C Condition for being inside the proper box
3497 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3498 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3502 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3503 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3504 C Condition for being inside the proper box
3505 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3506 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3510 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3511 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3512 cC Condition for being inside the proper box
3513 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3514 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3518 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3519 num_conti=num_cont_hb(i)
3521 do j=ielstart(i),ielend(i)
3523 C write (iout,*) i,j
3525 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3526 C changes suggested by Ana to avoid out of bounds
3527 & .or.((j+2).gt.nres)
3529 C end of changes by Ana
3530 & .or.itype(j+2).eq.ntyp1
3531 & .or.itype(j-1).eq.ntyp1
3533 call eelecij(i,j,ees,evdw1,eel_loc)
3535 num_cont_hb(i)=num_conti
3541 c write (iout,*) "Number of loop steps in EELEC:",ind
3543 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3544 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3546 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3547 ccc eel_loc=eel_loc+eello_turn3
3548 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3551 C-------------------------------------------------------------------------------
3552 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3553 implicit real*8 (a-h,o-z)
3554 include 'DIMENSIONS'
3558 include 'COMMON.CONTROL'
3559 include 'COMMON.IOUNITS'
3560 include 'COMMON.GEO'
3561 include 'COMMON.VAR'
3562 include 'COMMON.LOCAL'
3563 include 'COMMON.CHAIN'
3564 include 'COMMON.DERIV'
3565 include 'COMMON.INTERACT'
3566 include 'COMMON.CONTACTS'
3567 include 'COMMON.TORSION'
3568 include 'COMMON.VECTORS'
3569 include 'COMMON.FFIELD'
3570 include 'COMMON.TIME1'
3571 include 'COMMON.SPLITELE'
3572 include 'COMMON.SHIELD'
3573 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3574 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3575 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3576 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3577 & gmuij2(4),gmuji2(4)
3578 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3579 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3581 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3583 double precision scal_el /1.0d0/
3585 double precision scal_el /0.5d0/
3588 C 13-go grudnia roku pamietnego...
3589 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3590 & 0.0d0,1.0d0,0.0d0,
3591 & 0.0d0,0.0d0,1.0d0/
3592 c time00=MPI_Wtime()
3593 cd write (iout,*) "eelecij",i,j
3597 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3598 aaa=app(iteli,itelj)
3599 bbb=bpp(iteli,itelj)
3600 ael6i=ael6(iteli,itelj)
3601 ael3i=ael3(iteli,itelj)
3605 dx_normj=dc_norm(1,j)
3606 dy_normj=dc_norm(2,j)
3607 dz_normj=dc_norm(3,j)
3608 C xj=c(1,j)+0.5D0*dxj-xmedi
3609 C yj=c(2,j)+0.5D0*dyj-ymedi
3610 C zj=c(3,j)+0.5D0*dzj-zmedi
3615 if (xj.lt.0) xj=xj+boxxsize
3617 if (yj.lt.0) yj=yj+boxysize
3619 if (zj.lt.0) zj=zj+boxzsize
3620 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3621 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3629 xj=xj_safe+xshift*boxxsize
3630 yj=yj_safe+yshift*boxysize
3631 zj=zj_safe+zshift*boxzsize
3632 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3633 if(dist_temp.lt.dist_init) then
3643 if (isubchap.eq.1) then
3652 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3654 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3655 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3656 C Condition for being inside the proper box
3657 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3658 c & (xj.lt.((-0.5d0)*boxxsize))) then
3662 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3663 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3664 C Condition for being inside the proper box
3665 c if ((yj.gt.((0.5d0)*boxysize)).or.
3666 c & (yj.lt.((-0.5d0)*boxysize))) then
3670 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3671 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3672 C Condition for being inside the proper box
3673 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3674 c & (zj.lt.((-0.5d0)*boxzsize))) then
3677 C endif !endPBC condintion
3681 rij=xj*xj+yj*yj+zj*zj
3683 sss=sscale(sqrt(rij))
3684 sssgrad=sscagrad(sqrt(rij))
3685 c if (sss.gt.0.0d0) then
3691 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3692 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3693 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3694 fac=cosa-3.0D0*cosb*cosg
3696 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3697 if (j.eq.i+2) ev1=scal_el*ev1
3702 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3706 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3707 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3708 if (shield_mode.gt.0) then
3711 el1=el1*fac_shield(i)*fac_shield(j)
3712 el2=el2*fac_shield(i)*fac_shield(j)
3721 evdw1=evdw1+evdwij*sss
3722 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3723 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3724 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3725 cd & xmedi,ymedi,zmedi,xj,yj,zj
3727 if (energy_dec) then
3728 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3730 &,iteli,itelj,aaa,evdw1
3731 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3735 C Calculate contributions to the Cartesian gradient.
3738 facvdw=-6*rrmij*(ev1+evdwij)*sss
3739 facel=-3*rrmij*(el1+eesij)
3746 * Radial derivatives. First process both termini of the fragment (i,j)
3751 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3752 & (shield_mode.gt.0)) then
3754 do ilist=1,ishield_list(i)
3755 iresshield=shield_list(ilist,i)
3757 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
3758 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3760 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3761 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3762 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3763 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3764 C if (iresshield.gt.i) then
3765 C do ishi=i+1,iresshield-1
3766 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3767 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3771 C do ishi=iresshield,i
3772 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3773 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3779 do ilist=1,ishield_list(j)
3780 iresshield=shield_list(ilist,j)
3782 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
3783 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3785 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3786 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3788 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3789 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3790 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3791 C if (iresshield.gt.j) then
3792 C do ishi=j+1,iresshield-1
3793 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3794 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3798 C do ishi=iresshield,j
3799 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3800 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3807 gshieldc(k,i)=gshieldc(k,i)+
3808 & grad_shield(k,i)*eesij/fac_shield(i)
3809 gshieldc(k,j)=gshieldc(k,j)+
3810 & grad_shield(k,j)*eesij/fac_shield(j)
3811 gshieldc(k,i-1)=gshieldc(k,i-1)+
3812 & grad_shield(k,i)*eesij/fac_shield(i)
3813 gshieldc(k,j-1)=gshieldc(k,j-1)+
3814 & grad_shield(k,j)*eesij/fac_shield(j)
3819 c ghalf=0.5D0*ggg(k)
3820 c gelc(k,i)=gelc(k,i)+ghalf
3821 c gelc(k,j)=gelc(k,j)+ghalf
3823 c 9/28/08 AL Gradient compotents will be summed only at the end
3824 C print *,"before", gelc_long(1,i), gelc_long(1,j)
3826 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3827 C & +grad_shield(k,j)*eesij/fac_shield(j)
3828 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3829 C & +grad_shield(k,i)*eesij/fac_shield(i)
3830 C gelc_long(k,i-1)=gelc_long(k,i-1)
3831 C & +grad_shield(k,i)*eesij/fac_shield(i)
3832 C gelc_long(k,j-1)=gelc_long(k,j-1)
3833 C & +grad_shield(k,j)*eesij/fac_shield(j)
3835 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
3838 * Loop over residues i+1 thru j-1.
3842 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3845 if (sss.gt.0.0) then
3846 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3847 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3848 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3855 c ghalf=0.5D0*ggg(k)
3856 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3857 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3859 c 9/28/08 AL Gradient compotents will be summed only at the end
3861 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3862 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3865 * Loop over residues i+1 thru j-1.
3869 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3874 facvdw=(ev1+evdwij)*sss
3877 fac=-3*rrmij*(facvdw+facvdw+facel)
3882 * Radial derivatives. First process both termini of the fragment (i,j)
3885 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
3887 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
3889 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
3891 c ghalf=0.5D0*ggg(k)
3892 c gelc(k,i)=gelc(k,i)+ghalf
3893 c gelc(k,j)=gelc(k,j)+ghalf
3895 c 9/28/08 AL Gradient compotents will be summed only at the end
3897 gelc_long(k,j)=gelc(k,j)+ggg(k)
3898 gelc_long(k,i)=gelc(k,i)-ggg(k)
3901 * Loop over residues i+1 thru j-1.
3905 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3908 c 9/28/08 AL Gradient compotents will be summed only at the end
3909 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3910 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3911 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3913 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3914 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3920 ecosa=2.0D0*fac3*fac1+fac4
3923 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3924 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3926 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3927 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3929 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3930 cd & (dcosg(k),k=1,3)
3932 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
3933 & fac_shield(i)*fac_shield(j)
3936 c ghalf=0.5D0*ggg(k)
3937 c gelc(k,i)=gelc(k,i)+ghalf
3938 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3939 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3940 c gelc(k,j)=gelc(k,j)+ghalf
3941 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3942 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3946 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3949 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
3952 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3953 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
3954 & *fac_shield(i)*fac_shield(j)
3956 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3957 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
3958 & *fac_shield(i)*fac_shield(j)
3959 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3960 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3962 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
3966 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3967 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3968 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3970 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3971 C energy of a peptide unit is assumed in the form of a second-order
3972 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3973 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3974 C are computed for EVERY pair of non-contiguous peptide groups.
3977 if (j.lt.nres-1) then
3989 muij(kkk)=mu(k,i)*mu(l,j)
3990 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3992 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3993 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3994 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3995 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3996 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3997 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4001 cd write (iout,*) 'EELEC: i',i,' j',j
4002 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
4003 cd write(iout,*) 'muij',muij
4004 ury=scalar(uy(1,i),erij)
4005 urz=scalar(uz(1,i),erij)
4006 vry=scalar(uy(1,j),erij)
4007 vrz=scalar(uz(1,j),erij)
4008 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4009 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4010 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4011 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4012 fac=dsqrt(-ael6i)*r3ij
4017 cd write (iout,'(4i5,4f10.5)')
4018 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
4019 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4020 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4021 cd & uy(:,j),uz(:,j)
4022 cd write (iout,'(4f10.5)')
4023 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4024 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4025 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
4026 cd write (iout,'(9f10.5/)')
4027 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4028 C Derivatives of the elements of A in virtual-bond vectors
4029 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4031 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4032 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4033 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4034 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4035 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4036 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4037 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4038 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4039 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4040 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4041 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4042 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4044 C Compute radial contributions to the gradient
4062 C Add the contributions coming from er
4065 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4066 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4067 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4068 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4071 C Derivatives in DC(i)
4072 cgrad ghalf1=0.5d0*agg(k,1)
4073 cgrad ghalf2=0.5d0*agg(k,2)
4074 cgrad ghalf3=0.5d0*agg(k,3)
4075 cgrad ghalf4=0.5d0*agg(k,4)
4076 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
4077 & -3.0d0*uryg(k,2)*vry)!+ghalf1
4078 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
4079 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
4080 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
4081 & -3.0d0*urzg(k,2)*vry)!+ghalf3
4082 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
4083 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
4084 C Derivatives in DC(i+1)
4085 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
4086 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4087 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
4088 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4089 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
4090 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4091 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
4092 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4093 C Derivatives in DC(j)
4094 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
4095 & -3.0d0*vryg(k,2)*ury)!+ghalf1
4096 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4097 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4098 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4099 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4100 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4101 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4102 C Derivatives in DC(j+1) or DC(nres-1)
4103 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4104 & -3.0d0*vryg(k,3)*ury)
4105 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4106 & -3.0d0*vrzg(k,3)*ury)
4107 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4108 & -3.0d0*vryg(k,3)*urz)
4109 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4110 & -3.0d0*vrzg(k,3)*urz)
4111 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4113 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
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)
4132 if (j.lt.nres-1) then
4138 aggi(k,l)=-aggi(k,l)
4139 aggi1(k,l)=-aggi1(k,l)
4140 aggj(k,l)=-aggj(k,l)
4141 aggj1(k,l)=-aggj1(k,l)
4152 aggi(k,l)=-aggi(k,l)
4153 aggi1(k,l)=-aggi1(k,l)
4154 aggj(k,l)=-aggj(k,l)
4155 aggj1(k,l)=-aggj1(k,l)
4160 IF (wel_loc.gt.0.0d0) THEN
4161 C Contribution to the local-electrostatic energy coming from the i-j pair
4162 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4164 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4165 c & ' eel_loc_ij',eel_loc_ij
4166 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4167 C Calculate patrial derivative for theta angle
4169 geel_loc_ij=a22*gmuij1(1)
4173 c write(iout,*) "derivative over thatai"
4174 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4176 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4177 & geel_loc_ij*wel_loc
4178 c write(iout,*) "derivative over thatai-1"
4179 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4186 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4187 & geel_loc_ij*wel_loc
4188 c Derivative over j residue
4189 geel_loc_ji=a22*gmuji1(1)
4193 c write(iout,*) "derivative over thataj"
4194 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4197 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4198 & geel_loc_ji*wel_loc
4204 c write(iout,*) "derivative over thataj-1"
4205 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4207 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4208 & geel_loc_ji*wel_loc
4210 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4212 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4213 & 'eelloc',i,j,eel_loc_ij
4214 c if (eel_loc_ij.ne.0)
4215 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4216 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4218 eel_loc=eel_loc+eel_loc_ij
4219 C Partial derivatives in virtual-bond dihedral angles gamma
4221 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4222 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4223 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
4224 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4225 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4226 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
4227 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4229 ggg(l)=agg(l,1)*muij(1)+
4230 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
4231 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4232 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4233 cgrad ghalf=0.5d0*ggg(l)
4234 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4235 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4239 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4242 C Remaining derivatives of eello
4244 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4245 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4246 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4247 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4248 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4249 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4250 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4251 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4254 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4255 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4256 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4257 & .and. num_conti.le.maxconts) then
4258 c write (iout,*) i,j," entered corr"
4260 C Calculate the contact function. The ith column of the array JCONT will
4261 C contain the numbers of atoms that make contacts with the atom I (of numbers
4262 C greater than I). The arrays FACONT and GACONT will contain the values of
4263 C the contact function and its derivative.
4264 c r0ij=1.02D0*rpp(iteli,itelj)
4265 c r0ij=1.11D0*rpp(iteli,itelj)
4266 r0ij=2.20D0*rpp(iteli,itelj)
4267 c r0ij=1.55D0*rpp(iteli,itelj)
4268 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4269 if (fcont.gt.0.0D0) then
4270 num_conti=num_conti+1
4271 if (num_conti.gt.maxconts) then
4272 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4273 & ' will skip next contacts for this conf.'
4275 jcont_hb(num_conti,i)=j
4276 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4277 cd & " jcont_hb",jcont_hb(num_conti,i)
4278 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4279 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4280 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4282 d_cont(num_conti,i)=rij
4283 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4284 C --- Electrostatic-interaction matrix ---
4285 a_chuj(1,1,num_conti,i)=a22
4286 a_chuj(1,2,num_conti,i)=a23
4287 a_chuj(2,1,num_conti,i)=a32
4288 a_chuj(2,2,num_conti,i)=a33
4289 C --- Gradient of rij
4291 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4298 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4299 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4300 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4301 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4302 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4307 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4308 C Calculate contact energies
4310 wij=cosa-3.0D0*cosb*cosg
4313 c fac3=dsqrt(-ael6i)/r0ij**3
4314 fac3=dsqrt(-ael6i)*r3ij
4315 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4316 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4317 if (ees0tmp.gt.0) then
4318 ees0pij=dsqrt(ees0tmp)
4322 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4323 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4324 if (ees0tmp.gt.0) then
4325 ees0mij=dsqrt(ees0tmp)
4330 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4331 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4332 C Diagnostics. Comment out or remove after debugging!
4333 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4334 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4335 c ees0m(num_conti,i)=0.0D0
4337 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4338 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4339 C Angular derivatives of the contact function
4340 ees0pij1=fac3/ees0pij
4341 ees0mij1=fac3/ees0mij
4342 fac3p=-3.0D0*fac3*rrmij
4343 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4344 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4346 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4347 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4348 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4349 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4350 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4351 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4352 ecosap=ecosa1+ecosa2
4353 ecosbp=ecosb1+ecosb2
4354 ecosgp=ecosg1+ecosg2
4355 ecosam=ecosa1-ecosa2
4356 ecosbm=ecosb1-ecosb2
4357 ecosgm=ecosg1-ecosg2
4366 facont_hb(num_conti,i)=fcont
4367 fprimcont=fprimcont/rij
4368 cd facont_hb(num_conti,i)=1.0D0
4369 C Following line is for diagnostics.
4372 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4373 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4376 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4377 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4379 gggp(1)=gggp(1)+ees0pijp*xj
4380 gggp(2)=gggp(2)+ees0pijp*yj
4381 gggp(3)=gggp(3)+ees0pijp*zj
4382 gggm(1)=gggm(1)+ees0mijp*xj
4383 gggm(2)=gggm(2)+ees0mijp*yj
4384 gggm(3)=gggm(3)+ees0mijp*zj
4385 C Derivatives due to the contact function
4386 gacont_hbr(1,num_conti,i)=fprimcont*xj
4387 gacont_hbr(2,num_conti,i)=fprimcont*yj
4388 gacont_hbr(3,num_conti,i)=fprimcont*zj
4391 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4392 c following the change of gradient-summation algorithm.
4394 cgrad ghalfp=0.5D0*gggp(k)
4395 cgrad ghalfm=0.5D0*gggm(k)
4396 gacontp_hb1(k,num_conti,i)=!ghalfp
4397 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4398 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4399 gacontp_hb2(k,num_conti,i)=!ghalfp
4400 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4401 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4402 gacontp_hb3(k,num_conti,i)=gggp(k)
4403 gacontm_hb1(k,num_conti,i)=!ghalfm
4404 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4405 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4406 gacontm_hb2(k,num_conti,i)=!ghalfm
4407 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4408 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4409 gacontm_hb3(k,num_conti,i)=gggm(k)
4411 C Diagnostics. Comment out or remove after debugging!
4413 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4414 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4415 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4416 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4417 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4418 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4421 endif ! num_conti.le.maxconts
4424 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4427 ghalf=0.5d0*agg(l,k)
4428 aggi(l,k)=aggi(l,k)+ghalf
4429 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4430 aggj(l,k)=aggj(l,k)+ghalf
4433 if (j.eq.nres-1 .and. i.lt.j-2) then
4436 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4441 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4444 C-----------------------------------------------------------------------------
4445 subroutine eturn3(i,eello_turn3)
4446 C Third- and fourth-order contributions from turns
4447 implicit real*8 (a-h,o-z)
4448 include 'DIMENSIONS'
4449 include 'COMMON.IOUNITS'
4450 include 'COMMON.GEO'
4451 include 'COMMON.VAR'
4452 include 'COMMON.LOCAL'
4453 include 'COMMON.CHAIN'
4454 include 'COMMON.DERIV'
4455 include 'COMMON.INTERACT'
4456 include 'COMMON.CONTACTS'
4457 include 'COMMON.TORSION'
4458 include 'COMMON.VECTORS'
4459 include 'COMMON.FFIELD'
4460 include 'COMMON.CONTROL'
4462 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4463 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4464 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4465 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4466 & auxgmat2(2,2),auxgmatt2(2,2)
4467 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4468 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4469 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4470 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4473 c write (iout,*) "eturn3",i,j,j1,j2
4478 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4480 C Third-order contributions
4487 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4488 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4489 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4490 c auxalary matices for theta gradient
4491 c auxalary matrix for i+1 and constant i+2
4492 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4493 c auxalary matrix for i+2 and constant i+1
4494 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4495 call transpose2(auxmat(1,1),auxmat1(1,1))
4496 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4497 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4498 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4499 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4500 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4501 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4502 C Derivatives in theta
4503 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4504 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4505 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4506 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4508 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4509 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4510 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4511 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4512 cd & ' eello_turn3_num',4*eello_turn3_num
4513 C Derivatives in gamma(i)
4514 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4515 call transpose2(auxmat2(1,1),auxmat3(1,1))
4516 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4517 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4518 C Derivatives in gamma(i+1)
4519 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4520 call transpose2(auxmat2(1,1),auxmat3(1,1))
4521 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4522 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4523 & +0.5d0*(pizda(1,1)+pizda(2,2))
4524 C Cartesian derivatives
4526 c ghalf1=0.5d0*agg(l,1)
4527 c ghalf2=0.5d0*agg(l,2)
4528 c ghalf3=0.5d0*agg(l,3)
4529 c ghalf4=0.5d0*agg(l,4)
4530 a_temp(1,1)=aggi(l,1)!+ghalf1
4531 a_temp(1,2)=aggi(l,2)!+ghalf2
4532 a_temp(2,1)=aggi(l,3)!+ghalf3
4533 a_temp(2,2)=aggi(l,4)!+ghalf4
4534 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4535 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4536 & +0.5d0*(pizda(1,1)+pizda(2,2))
4537 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4538 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4539 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4540 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4541 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4542 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4543 & +0.5d0*(pizda(1,1)+pizda(2,2))
4544 a_temp(1,1)=aggj(l,1)!+ghalf1
4545 a_temp(1,2)=aggj(l,2)!+ghalf2
4546 a_temp(2,1)=aggj(l,3)!+ghalf3
4547 a_temp(2,2)=aggj(l,4)!+ghalf4
4548 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4549 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4550 & +0.5d0*(pizda(1,1)+pizda(2,2))
4551 a_temp(1,1)=aggj1(l,1)
4552 a_temp(1,2)=aggj1(l,2)
4553 a_temp(2,1)=aggj1(l,3)
4554 a_temp(2,2)=aggj1(l,4)
4555 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4556 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4557 & +0.5d0*(pizda(1,1)+pizda(2,2))
4561 C-------------------------------------------------------------------------------
4562 subroutine eturn4(i,eello_turn4)
4563 C Third- and fourth-order contributions from turns
4564 implicit real*8 (a-h,o-z)
4565 include 'DIMENSIONS'
4566 include 'COMMON.IOUNITS'
4567 include 'COMMON.GEO'
4568 include 'COMMON.VAR'
4569 include 'COMMON.LOCAL'
4570 include 'COMMON.CHAIN'
4571 include 'COMMON.DERIV'
4572 include 'COMMON.INTERACT'
4573 include 'COMMON.CONTACTS'
4574 include 'COMMON.TORSION'
4575 include 'COMMON.VECTORS'
4576 include 'COMMON.FFIELD'
4577 include 'COMMON.CONTROL'
4579 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4580 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4581 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4582 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4583 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4584 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4585 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4586 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4587 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4588 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4589 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4592 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4594 C Fourth-order contributions
4602 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4603 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4604 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4605 c write(iout,*)"WCHODZE W PROGRAM"
4610 iti1=itortyp(itype(i+1))
4611 iti2=itortyp(itype(i+2))
4612 iti3=itortyp(itype(i+3))
4613 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4614 call transpose2(EUg(1,1,i+1),e1t(1,1))
4615 call transpose2(Eug(1,1,i+2),e2t(1,1))
4616 call transpose2(Eug(1,1,i+3),e3t(1,1))
4617 C Ematrix derivative in theta
4618 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4619 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4620 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4621 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4622 c eta1 in derivative theta
4623 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4624 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4625 c auxgvec is derivative of Ub2 so i+3 theta
4626 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4627 c auxalary matrix of E i+1
4628 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4631 s1=scalar2(b1(1,i+2),auxvec(1))
4632 c derivative of theta i+2 with constant i+3
4633 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4634 c derivative of theta i+2 with constant i+2
4635 gs32=scalar2(b1(1,i+2),auxgvec(1))
4636 c derivative of E matix in theta of i+1
4637 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4639 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4640 c ea31 in derivative theta
4641 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4642 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4643 c auxilary matrix auxgvec of Ub2 with constant E matirx
4644 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4645 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4646 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4650 s2=scalar2(b1(1,i+1),auxvec(1))
4651 c derivative of theta i+1 with constant i+3
4652 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4653 c derivative of theta i+2 with constant i+1
4654 gs21=scalar2(b1(1,i+1),auxgvec(1))
4655 c derivative of theta i+3 with constant i+1
4656 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4657 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4659 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4660 c two derivatives over diffetent matrices
4661 c gtae3e2 is derivative over i+3
4662 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4663 c ae3gte2 is derivative over i+2
4664 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4665 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4666 c three possible derivative over theta E matices
4668 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4670 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4672 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4673 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4675 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4676 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4677 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4679 eello_turn4=eello_turn4-(s1+s2+s3)
4680 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4681 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4682 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4683 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4684 cd & ' eello_turn4_num',8*eello_turn4_num
4686 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4687 & -(gs13+gsE13+gsEE1)*wturn4
4688 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4689 & -(gs23+gs21+gsEE2)*wturn4
4690 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4691 & -(gs32+gsE31+gsEE3)*wturn4
4692 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4695 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4696 & 'eturn4',i,j,-(s1+s2+s3)
4697 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4698 c & ' eello_turn4_num',8*eello_turn4_num
4699 C Derivatives in gamma(i)
4700 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4701 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4702 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4703 s1=scalar2(b1(1,i+2),auxvec(1))
4704 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4705 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4706 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4707 C Derivatives in gamma(i+1)
4708 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4709 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4710 s2=scalar2(b1(1,i+1),auxvec(1))
4711 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4712 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4713 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4714 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4715 C Derivatives in gamma(i+2)
4716 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4717 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4718 s1=scalar2(b1(1,i+2),auxvec(1))
4719 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4720 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4721 s2=scalar2(b1(1,i+1),auxvec(1))
4722 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4723 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4724 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4725 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4726 C Cartesian derivatives
4727 C Derivatives of this turn contributions in DC(i+2)
4728 if (j.lt.nres-1) then
4730 a_temp(1,1)=agg(l,1)
4731 a_temp(1,2)=agg(l,2)
4732 a_temp(2,1)=agg(l,3)
4733 a_temp(2,2)=agg(l,4)
4734 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4735 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4736 s1=scalar2(b1(1,i+2),auxvec(1))
4737 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4738 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4739 s2=scalar2(b1(1,i+1),auxvec(1))
4740 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4741 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4742 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4744 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4747 C Remaining derivatives of this turn contribution
4749 a_temp(1,1)=aggi(l,1)
4750 a_temp(1,2)=aggi(l,2)
4751 a_temp(2,1)=aggi(l,3)
4752 a_temp(2,2)=aggi(l,4)
4753 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4754 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4755 s1=scalar2(b1(1,i+2),auxvec(1))
4756 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4757 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4758 s2=scalar2(b1(1,i+1),auxvec(1))
4759 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4760 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4761 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4762 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4763 a_temp(1,1)=aggi1(l,1)
4764 a_temp(1,2)=aggi1(l,2)
4765 a_temp(2,1)=aggi1(l,3)
4766 a_temp(2,2)=aggi1(l,4)
4767 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4768 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4769 s1=scalar2(b1(1,i+2),auxvec(1))
4770 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4771 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4772 s2=scalar2(b1(1,i+1),auxvec(1))
4773 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4774 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4775 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4776 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4777 a_temp(1,1)=aggj(l,1)
4778 a_temp(1,2)=aggj(l,2)
4779 a_temp(2,1)=aggj(l,3)
4780 a_temp(2,2)=aggj(l,4)
4781 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4782 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4783 s1=scalar2(b1(1,i+2),auxvec(1))
4784 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4785 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4786 s2=scalar2(b1(1,i+1),auxvec(1))
4787 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4788 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4789 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4790 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4791 a_temp(1,1)=aggj1(l,1)
4792 a_temp(1,2)=aggj1(l,2)
4793 a_temp(2,1)=aggj1(l,3)
4794 a_temp(2,2)=aggj1(l,4)
4795 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4796 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4797 s1=scalar2(b1(1,i+2),auxvec(1))
4798 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4799 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4800 s2=scalar2(b1(1,i+1),auxvec(1))
4801 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4802 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4803 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4804 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4805 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4809 C-----------------------------------------------------------------------------
4810 subroutine vecpr(u,v,w)
4811 implicit real*8(a-h,o-z)
4812 dimension u(3),v(3),w(3)
4813 w(1)=u(2)*v(3)-u(3)*v(2)
4814 w(2)=-u(1)*v(3)+u(3)*v(1)
4815 w(3)=u(1)*v(2)-u(2)*v(1)
4818 C-----------------------------------------------------------------------------
4819 subroutine unormderiv(u,ugrad,unorm,ungrad)
4820 C This subroutine computes the derivatives of a normalized vector u, given
4821 C the derivatives computed without normalization conditions, ugrad. Returns
4824 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4825 double precision vec(3)
4826 double precision scalar
4828 c write (2,*) 'ugrad',ugrad
4831 vec(i)=scalar(ugrad(1,i),u(1))
4833 c write (2,*) 'vec',vec
4836 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4839 c write (2,*) 'ungrad',ungrad
4842 C-----------------------------------------------------------------------------
4843 subroutine escp_soft_sphere(evdw2,evdw2_14)
4845 C This subroutine calculates the excluded-volume interaction energy between
4846 C peptide-group centers and side chains and its gradient in virtual-bond and
4847 C side-chain vectors.
4849 implicit real*8 (a-h,o-z)
4850 include 'DIMENSIONS'
4851 include 'COMMON.GEO'
4852 include 'COMMON.VAR'
4853 include 'COMMON.LOCAL'
4854 include 'COMMON.CHAIN'
4855 include 'COMMON.DERIV'
4856 include 'COMMON.INTERACT'
4857 include 'COMMON.FFIELD'
4858 include 'COMMON.IOUNITS'
4859 include 'COMMON.CONTROL'
4864 cd print '(a)','Enter ESCP'
4865 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4869 do i=iatscp_s,iatscp_e
4870 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4872 xi=0.5D0*(c(1,i)+c(1,i+1))
4873 yi=0.5D0*(c(2,i)+c(2,i+1))
4874 zi=0.5D0*(c(3,i)+c(3,i+1))
4875 C Return atom into box, boxxsize is size of box in x dimension
4877 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4878 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4879 C Condition for being inside the proper box
4880 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4881 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4885 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4886 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4887 C Condition for being inside the proper box
4888 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4889 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4893 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4894 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4895 cC Condition for being inside the proper box
4896 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4897 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4901 if (xi.lt.0) xi=xi+boxxsize
4903 if (yi.lt.0) yi=yi+boxysize
4905 if (zi.lt.0) zi=zi+boxzsize
4906 C xi=xi+xshift*boxxsize
4907 C yi=yi+yshift*boxysize
4908 C zi=zi+zshift*boxzsize
4909 do iint=1,nscp_gr(i)
4911 do j=iscpstart(i,iint),iscpend(i,iint)
4912 if (itype(j).eq.ntyp1) cycle
4913 itypj=iabs(itype(j))
4914 C Uncomment following three lines for SC-p interactions
4918 C Uncomment following three lines for Ca-p interactions
4923 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4924 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4925 C Condition for being inside the proper box
4926 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4927 c & (xj.lt.((-0.5d0)*boxxsize))) then
4931 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4932 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4933 cC Condition for being inside the proper box
4934 c if ((yj.gt.((0.5d0)*boxysize)).or.
4935 c & (yj.lt.((-0.5d0)*boxysize))) then
4939 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4940 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4941 C Condition for being inside the proper box
4942 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4943 c & (zj.lt.((-0.5d0)*boxzsize))) then
4946 if (xj.lt.0) xj=xj+boxxsize
4948 if (yj.lt.0) yj=yj+boxysize
4950 if (zj.lt.0) zj=zj+boxzsize
4951 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4959 xj=xj_safe+xshift*boxxsize
4960 yj=yj_safe+yshift*boxysize
4961 zj=zj_safe+zshift*boxzsize
4962 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4963 if(dist_temp.lt.dist_init) then
4973 if (subchap.eq.1) then
4986 rij=xj*xj+yj*yj+zj*zj
4990 if (rij.lt.r0ijsq) then
4991 evdwij=0.25d0*(rij-r0ijsq)**2
4999 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5004 cgrad if (j.lt.i) then
5005 cd write (iout,*) 'j<i'
5006 C Uncomment following three lines for SC-p interactions
5008 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5011 cd write (iout,*) 'j>i'
5013 cgrad ggg(k)=-ggg(k)
5014 C Uncomment following line for SC-p interactions
5015 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5019 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5021 cgrad kstart=min0(i+1,j)
5022 cgrad kend=max0(i-1,j-1)
5023 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5024 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5025 cgrad do k=kstart,kend
5027 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5031 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5032 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5043 C-----------------------------------------------------------------------------
5044 subroutine escp(evdw2,evdw2_14)
5046 C This subroutine calculates the excluded-volume interaction energy between
5047 C peptide-group centers and side chains and its gradient in virtual-bond and
5048 C side-chain vectors.
5050 implicit real*8 (a-h,o-z)
5051 include 'DIMENSIONS'
5052 include 'COMMON.GEO'
5053 include 'COMMON.VAR'
5054 include 'COMMON.LOCAL'
5055 include 'COMMON.CHAIN'
5056 include 'COMMON.DERIV'
5057 include 'COMMON.INTERACT'
5058 include 'COMMON.FFIELD'
5059 include 'COMMON.IOUNITS'
5060 include 'COMMON.CONTROL'
5061 include 'COMMON.SPLITELE'
5065 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
5066 cd print '(a)','Enter ESCP'
5067 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5071 do i=iatscp_s,iatscp_e
5072 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5074 xi=0.5D0*(c(1,i)+c(1,i+1))
5075 yi=0.5D0*(c(2,i)+c(2,i+1))
5076 zi=0.5D0*(c(3,i)+c(3,i+1))
5078 if (xi.lt.0) xi=xi+boxxsize
5080 if (yi.lt.0) yi=yi+boxysize
5082 if (zi.lt.0) zi=zi+boxzsize
5083 c xi=xi+xshift*boxxsize
5084 c yi=yi+yshift*boxysize
5085 c zi=zi+zshift*boxzsize
5086 c print *,xi,yi,zi,'polozenie i'
5087 C Return atom into box, boxxsize is size of box in x dimension
5089 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5090 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5091 C Condition for being inside the proper box
5092 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5093 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5097 c print *,xi,boxxsize,"pierwszy"
5099 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5100 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5101 C Condition for being inside the proper box
5102 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5103 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5107 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5108 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5109 C Condition for being inside the proper box
5110 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5111 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5114 do iint=1,nscp_gr(i)
5116 do j=iscpstart(i,iint),iscpend(i,iint)
5117 itypj=iabs(itype(j))
5118 if (itypj.eq.ntyp1) cycle
5119 C Uncomment following three lines for SC-p interactions
5123 C Uncomment following three lines for Ca-p interactions
5128 if (xj.lt.0) xj=xj+boxxsize
5130 if (yj.lt.0) yj=yj+boxysize
5132 if (zj.lt.0) zj=zj+boxzsize
5134 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5135 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5136 C Condition for being inside the proper box
5137 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5138 c & (xj.lt.((-0.5d0)*boxxsize))) then
5142 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5143 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5144 cC Condition for being inside the proper box
5145 c if ((yj.gt.((0.5d0)*boxysize)).or.
5146 c & (yj.lt.((-0.5d0)*boxysize))) then
5150 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5151 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5152 C Condition for being inside the proper box
5153 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5154 c & (zj.lt.((-0.5d0)*boxzsize))) then
5157 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5158 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5166 xj=xj_safe+xshift*boxxsize
5167 yj=yj_safe+yshift*boxysize
5168 zj=zj_safe+zshift*boxzsize
5169 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5170 if(dist_temp.lt.dist_init) then
5180 if (subchap.eq.1) then
5189 c print *,xj,yj,zj,'polozenie j'
5190 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5192 sss=sscale(1.0d0/(dsqrt(rrij)))
5193 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5194 c if (sss.eq.0) print *,'czasem jest OK'
5195 if (sss.le.0.0d0) cycle
5196 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5198 e1=fac*fac*aad(itypj,iteli)
5199 e2=fac*bad(itypj,iteli)
5200 if (iabs(j-i) .le. 2) then
5203 evdw2_14=evdw2_14+(e1+e2)*sss
5206 evdw2=evdw2+evdwij*sss
5207 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5208 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5211 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5213 fac=-(evdwij+e1)*rrij*sss
5214 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5218 cgrad if (j.lt.i) then
5219 cd write (iout,*) 'j<i'
5220 C Uncomment following three lines for SC-p interactions
5222 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5225 cd write (iout,*) 'j>i'
5227 cgrad ggg(k)=-ggg(k)
5228 C Uncomment following line for SC-p interactions
5229 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5230 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5234 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5236 cgrad kstart=min0(i+1,j)
5237 cgrad kend=max0(i-1,j-1)
5238 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5239 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5240 cgrad do k=kstart,kend
5242 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5246 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5247 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5249 c endif !endif for sscale cutoff
5259 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5260 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5261 gradx_scp(j,i)=expon*gradx_scp(j,i)
5264 C******************************************************************************
5268 C To save time the factor EXPON has been extracted from ALL components
5269 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5272 C******************************************************************************
5275 C--------------------------------------------------------------------------
5276 subroutine edis(ehpb)
5278 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5280 implicit real*8 (a-h,o-z)
5281 include 'DIMENSIONS'
5282 include 'COMMON.SBRIDGE'
5283 include 'COMMON.CHAIN'
5284 include 'COMMON.DERIV'
5285 include 'COMMON.VAR'
5286 include 'COMMON.INTERACT'
5287 include 'COMMON.IOUNITS'
5288 include 'COMMON.CONTROL'
5294 C write (iout,*) ,"link_end",link_end,constr_dist
5295 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5296 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5297 if (link_end.eq.0) return
5298 do i=link_start,link_end
5299 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5300 C CA-CA distance used in regularization of structure.
5303 C iii and jjj point to the residues for which the distance is assigned.
5304 if (ii.gt.nres) then
5311 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5312 c & dhpb(i),dhpb1(i),forcon(i)
5313 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5314 C distance and angle dependent SS bond potential.
5315 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5316 C & iabs(itype(jjj)).eq.1) then
5317 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5318 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5319 if (.not.dyn_ss .and. i.le.nss) then
5320 C 15/02/13 CC dynamic SSbond - additional check
5321 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5322 & iabs(itype(jjj)).eq.1) then
5323 call ssbond_ene(iii,jjj,eij)
5326 cd write (iout,*) "eij",eij
5327 cd & ' waga=',waga,' fac=',fac
5328 else if (ii.gt.nres .and. jj.gt.nres) then
5329 c Restraints from contact prediction
5331 if (constr_dist.eq.11) then
5332 ehpb=ehpb+fordepth(i)**4.0d0
5333 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5334 fac=fordepth(i)**4.0d0
5335 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5336 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5337 & ehpb,fordepth(i),dd
5339 if (dhpb1(i).gt.0.0d0) then
5340 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5341 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5342 c write (iout,*) "beta nmr",
5343 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5347 C Get the force constant corresponding to this distance.
5349 C Calculate the contribution to energy.
5350 ehpb=ehpb+waga*rdis*rdis
5351 c write (iout,*) "beta reg",dd,waga*rdis*rdis
5353 C Evaluate gradient.
5359 ggg(j)=fac*(c(j,jj)-c(j,ii))
5362 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5363 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5366 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5367 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5370 C Calculate the distance between the two points and its difference from the
5373 if (constr_dist.eq.11) then
5374 ehpb=ehpb+fordepth(i)**4.0d0
5375 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5376 fac=fordepth(i)**4.0d0
5377 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5378 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5379 & ehpb,fordepth(i),dd
5381 if (dhpb1(i).gt.0.0d0) then
5382 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5383 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5384 c write (iout,*) "alph nmr",
5385 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5388 C Get the force constant corresponding to this distance.
5390 C Calculate the contribution to energy.
5391 ehpb=ehpb+waga*rdis*rdis
5392 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5394 C Evaluate gradient.
5400 ggg(j)=fac*(c(j,jj)-c(j,ii))
5402 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5403 C If this is a SC-SC distance, we need to calculate the contributions to the
5404 C Cartesian gradient in the SC vectors (ghpbx).
5407 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5408 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5411 cgrad do j=iii,jjj-1
5413 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5417 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5418 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5422 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5425 C--------------------------------------------------------------------------
5426 subroutine ssbond_ene(i,j,eij)
5428 C Calculate the distance and angle dependent SS-bond potential energy
5429 C using a free-energy function derived based on RHF/6-31G** ab initio
5430 C calculations of diethyl disulfide.
5432 C A. Liwo and U. Kozlowska, 11/24/03
5434 implicit real*8 (a-h,o-z)
5435 include 'DIMENSIONS'
5436 include 'COMMON.SBRIDGE'
5437 include 'COMMON.CHAIN'
5438 include 'COMMON.DERIV'
5439 include 'COMMON.LOCAL'
5440 include 'COMMON.INTERACT'
5441 include 'COMMON.VAR'
5442 include 'COMMON.IOUNITS'
5443 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5444 itypi=iabs(itype(i))
5448 dxi=dc_norm(1,nres+i)
5449 dyi=dc_norm(2,nres+i)
5450 dzi=dc_norm(3,nres+i)
5451 c dsci_inv=dsc_inv(itypi)
5452 dsci_inv=vbld_inv(nres+i)
5453 itypj=iabs(itype(j))
5454 c dscj_inv=dsc_inv(itypj)
5455 dscj_inv=vbld_inv(nres+j)
5459 dxj=dc_norm(1,nres+j)
5460 dyj=dc_norm(2,nres+j)
5461 dzj=dc_norm(3,nres+j)
5462 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5467 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5468 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5469 om12=dxi*dxj+dyi*dyj+dzi*dzj
5471 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5472 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5478 deltat12=om2-om1+2.0d0
5480 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5481 & +akct*deltad*deltat12
5482 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5483 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5484 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5485 c & " deltat12",deltat12," eij",eij
5486 ed=2*akcm*deltad+akct*deltat12
5488 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5489 eom1=-2*akth*deltat1-pom1-om2*pom2
5490 eom2= 2*akth*deltat2+pom1-om1*pom2
5493 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5494 ghpbx(k,i)=ghpbx(k,i)-ggk
5495 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5496 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5497 ghpbx(k,j)=ghpbx(k,j)+ggk
5498 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5499 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5500 ghpbc(k,i)=ghpbc(k,i)-ggk
5501 ghpbc(k,j)=ghpbc(k,j)+ggk
5504 C Calculate the components of the gradient in DC and X
5508 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5513 C--------------------------------------------------------------------------
5514 subroutine ebond(estr)
5516 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5518 implicit real*8 (a-h,o-z)
5519 include 'DIMENSIONS'
5520 include 'COMMON.LOCAL'
5521 include 'COMMON.GEO'
5522 include 'COMMON.INTERACT'
5523 include 'COMMON.DERIV'
5524 include 'COMMON.VAR'
5525 include 'COMMON.CHAIN'
5526 include 'COMMON.IOUNITS'
5527 include 'COMMON.NAMES'
5528 include 'COMMON.FFIELD'
5529 include 'COMMON.CONTROL'
5530 include 'COMMON.SETUP'
5531 double precision u(3),ud(3)
5534 do i=ibondp_start,ibondp_end
5535 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5536 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5538 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5539 c & *dc(j,i-1)/vbld(i)
5541 c if (energy_dec) write(iout,*)
5542 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5544 C Checking if it involves dummy (NH3+ or COO-) group
5545 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5546 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5547 diff = vbld(i)-vbldpDUM
5549 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5550 diff = vbld(i)-vbldp0
5552 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5553 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5556 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5558 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5561 estr=0.5d0*AKP*estr+estr1
5563 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5565 do i=ibond_start,ibond_end
5567 if (iti.ne.10 .and. iti.ne.ntyp1) then
5570 diff=vbld(i+nres)-vbldsc0(1,iti)
5571 if (energy_dec) write (iout,*)
5572 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5573 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5574 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5576 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5580 diff=vbld(i+nres)-vbldsc0(j,iti)
5581 ud(j)=aksc(j,iti)*diff
5582 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5596 uprod2=uprod2*u(k)*u(k)
5600 usumsqder=usumsqder+ud(j)*uprod2
5602 estr=estr+uprod/usum
5604 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5612 C--------------------------------------------------------------------------
5613 subroutine ebend(etheta,ethetacnstr)
5615 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5616 C angles gamma and its derivatives in consecutive thetas and gammas.
5618 implicit real*8 (a-h,o-z)
5619 include 'DIMENSIONS'
5620 include 'COMMON.LOCAL'
5621 include 'COMMON.GEO'
5622 include 'COMMON.INTERACT'
5623 include 'COMMON.DERIV'
5624 include 'COMMON.VAR'
5625 include 'COMMON.CHAIN'
5626 include 'COMMON.IOUNITS'
5627 include 'COMMON.NAMES'
5628 include 'COMMON.FFIELD'
5629 include 'COMMON.CONTROL'
5630 include 'COMMON.TORCNSTR'
5631 common /calcthet/ term1,term2,termm,diffak,ratak,
5632 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5633 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5634 double precision y(2),z(2)
5636 c time11=dexp(-2*time)
5639 c write (*,'(a,i2)') 'EBEND ICG=',icg
5640 do i=ithet_start,ithet_end
5641 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5642 & .or.itype(i).eq.ntyp1) cycle
5643 C Zero the energy function and its derivative at 0 or pi.
5644 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5646 ichir1=isign(1,itype(i-2))
5647 ichir2=isign(1,itype(i))
5648 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5649 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5650 if (itype(i-1).eq.10) then
5651 itype1=isign(10,itype(i-2))
5652 ichir11=isign(1,itype(i-2))
5653 ichir12=isign(1,itype(i-2))
5654 itype2=isign(10,itype(i))
5655 ichir21=isign(1,itype(i))
5656 ichir22=isign(1,itype(i))
5659 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5662 if (phii.ne.phii) phii=150.0
5672 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5675 if (phii1.ne.phii1) phii1=150.0
5687 C Calculate the "mean" value of theta from the part of the distribution
5688 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5689 C In following comments this theta will be referred to as t_c.
5690 thet_pred_mean=0.0d0
5692 athetk=athet(k,it,ichir1,ichir2)
5693 bthetk=bthet(k,it,ichir1,ichir2)
5695 athetk=athet(k,itype1,ichir11,ichir12)
5696 bthetk=bthet(k,itype2,ichir21,ichir22)
5698 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5699 c write(iout,*) 'chuj tu', y(k),z(k)
5701 dthett=thet_pred_mean*ssd
5702 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5703 C Derivatives of the "mean" values in gamma1 and gamma2.
5704 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5705 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5706 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5707 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5709 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5710 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5711 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5712 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5714 if (theta(i).gt.pi-delta) then
5715 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5717 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5718 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5719 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5721 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5723 else if (theta(i).lt.delta) then
5724 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5725 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5726 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5728 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5729 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5732 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5735 etheta=etheta+ethetai
5736 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5737 & 'ebend',i,ethetai,theta(i),itype(i)
5738 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5739 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5740 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5743 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5744 do i=ithetaconstr_start,ithetaconstr_end
5745 itheta=itheta_constr(i)
5746 thetiii=theta(itheta)
5747 difi=pinorm(thetiii-theta_constr0(i))
5748 if (difi.gt.theta_drange(i)) then
5749 difi=difi-theta_drange(i)
5750 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
5751 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5752 & +for_thet_constr(i)*difi**3
5753 else if (difi.lt.-drange(i)) then
5755 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
5756 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5757 & +for_thet_constr(i)*difi**3
5761 if (energy_dec) then
5762 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
5763 & i,itheta,rad2deg*thetiii,
5764 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
5765 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
5766 & gloc(itheta+nphi-2,icg)
5770 C Ufff.... We've done all this!!!
5773 C---------------------------------------------------------------------------
5774 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5776 implicit real*8 (a-h,o-z)
5777 include 'DIMENSIONS'
5778 include 'COMMON.LOCAL'
5779 include 'COMMON.IOUNITS'
5780 common /calcthet/ term1,term2,termm,diffak,ratak,
5781 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5782 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5783 C Calculate the contributions to both Gaussian lobes.
5784 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5785 C The "polynomial part" of the "standard deviation" of this part of
5786 C the distributioni.
5787 ccc write (iout,*) thetai,thet_pred_mean
5790 sig=sig*thet_pred_mean+polthet(j,it)
5792 C Derivative of the "interior part" of the "standard deviation of the"
5793 C gamma-dependent Gaussian lobe in t_c.
5794 sigtc=3*polthet(3,it)
5796 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5799 C Set the parameters of both Gaussian lobes of the distribution.
5800 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5801 fac=sig*sig+sigc0(it)
5804 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5805 sigsqtc=-4.0D0*sigcsq*sigtc
5806 c print *,i,sig,sigtc,sigsqtc
5807 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5808 sigtc=-sigtc/(fac*fac)
5809 C Following variable is sigma(t_c)**(-2)
5810 sigcsq=sigcsq*sigcsq
5812 sig0inv=1.0D0/sig0i**2
5813 delthec=thetai-thet_pred_mean
5814 delthe0=thetai-theta0i
5815 term1=-0.5D0*sigcsq*delthec*delthec
5816 term2=-0.5D0*sig0inv*delthe0*delthe0
5817 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5818 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5819 C NaNs in taking the logarithm. We extract the largest exponent which is added
5820 C to the energy (this being the log of the distribution) at the end of energy
5821 C term evaluation for this virtual-bond angle.
5822 if (term1.gt.term2) then
5824 term2=dexp(term2-termm)
5828 term1=dexp(term1-termm)
5831 C The ratio between the gamma-independent and gamma-dependent lobes of
5832 C the distribution is a Gaussian function of thet_pred_mean too.
5833 diffak=gthet(2,it)-thet_pred_mean
5834 ratak=diffak/gthet(3,it)**2
5835 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5836 C Let's differentiate it in thet_pred_mean NOW.
5838 C Now put together the distribution terms to make complete distribution.
5839 termexp=term1+ak*term2
5840 termpre=sigc+ak*sig0i
5841 C Contribution of the bending energy from this theta is just the -log of
5842 C the sum of the contributions from the two lobes and the pre-exponential
5843 C factor. Simple enough, isn't it?
5844 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5845 C write (iout,*) 'termexp',termexp,termm,termpre,i
5846 C NOW the derivatives!!!
5847 C 6/6/97 Take into account the deformation.
5848 E_theta=(delthec*sigcsq*term1
5849 & +ak*delthe0*sig0inv*term2)/termexp
5850 E_tc=((sigtc+aktc*sig0i)/termpre
5851 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5852 & aktc*term2)/termexp)
5855 c-----------------------------------------------------------------------------
5856 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5857 implicit real*8 (a-h,o-z)
5858 include 'DIMENSIONS'
5859 include 'COMMON.LOCAL'
5860 include 'COMMON.IOUNITS'
5861 common /calcthet/ term1,term2,termm,diffak,ratak,
5862 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5863 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5864 delthec=thetai-thet_pred_mean
5865 delthe0=thetai-theta0i
5866 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5867 t3 = thetai-thet_pred_mean
5871 t14 = t12+t6*sigsqtc
5873 t21 = thetai-theta0i
5879 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5880 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5881 & *(-t12*t9-ak*sig0inv*t27)
5885 C--------------------------------------------------------------------------
5886 subroutine ebend(etheta,ethetacnstr)
5888 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5889 C angles gamma and its derivatives in consecutive thetas and gammas.
5890 C ab initio-derived potentials from
5891 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5893 implicit real*8 (a-h,o-z)
5894 include 'DIMENSIONS'
5895 include 'COMMON.LOCAL'
5896 include 'COMMON.GEO'
5897 include 'COMMON.INTERACT'
5898 include 'COMMON.DERIV'
5899 include 'COMMON.VAR'
5900 include 'COMMON.CHAIN'
5901 include 'COMMON.IOUNITS'
5902 include 'COMMON.NAMES'
5903 include 'COMMON.FFIELD'
5904 include 'COMMON.CONTROL'
5905 include 'COMMON.TORCNSTR'
5906 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5907 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5908 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5909 & sinph1ph2(maxdouble,maxdouble)
5910 logical lprn /.false./, lprn1 /.false./
5912 do i=ithet_start,ithet_end
5914 c print *,i,itype(i-1),itype(i),itype(i-2)
5915 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5916 & .or.itype(i).eq.ntyp1) cycle
5917 C print *,i,theta(i)
5918 if (iabs(itype(i+1)).eq.20) iblock=2
5919 if (iabs(itype(i+1)).ne.20) iblock=1
5923 theti2=0.5d0*theta(i)
5924 ityp2=ithetyp((itype(i-1)))
5926 coskt(k)=dcos(k*theti2)
5927 sinkt(k)=dsin(k*theti2)
5939 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5942 if (phii.ne.phii) phii=150.0
5946 ityp1=ithetyp((itype(i-2)))
5947 C propagation of chirality for glycine type
5949 cosph1(k)=dcos(k*phii)
5950 sinph1(k)=dsin(k*phii)
5955 ityp1=ithetyp((itype(i-2)))
5961 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5964 if (phii1.ne.phii1) phii1=150.0
5969 ityp3=ithetyp((itype(i)))
5971 cosph2(k)=dcos(k*phii1)
5972 sinph2(k)=dsin(k*phii1)
5976 ityp3=ithetyp((itype(i)))
5982 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5985 ccl=cosph1(l)*cosph2(k-l)
5986 ssl=sinph1(l)*sinph2(k-l)
5987 scl=sinph1(l)*cosph2(k-l)
5988 csl=cosph1(l)*sinph2(k-l)
5989 cosph1ph2(l,k)=ccl-ssl
5990 cosph1ph2(k,l)=ccl+ssl
5991 sinph1ph2(l,k)=scl+csl
5992 sinph1ph2(k,l)=scl-csl
5996 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5997 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5998 write (iout,*) "coskt and sinkt"
6000 write (iout,*) k,coskt(k),sinkt(k)
6004 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6005 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
6008 & write (iout,*) "k",k,"
6009 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
6010 & " ethetai",ethetai
6013 write (iout,*) "cosph and sinph"
6015 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6017 write (iout,*) "cosph1ph2 and sinph2ph2"
6020 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6021 & sinph1ph2(l,k),sinph1ph2(k,l)
6024 write(iout,*) "ethetai",ethetai
6029 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
6030 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
6031 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
6032 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6033 ethetai=ethetai+sinkt(m)*aux
6034 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6035 dephii=dephii+k*sinkt(m)*(
6036 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
6037 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6038 dephii1=dephii1+k*sinkt(m)*(
6039 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
6040 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6042 & write (iout,*) "m",m," k",k," bbthet",
6043 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
6044 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
6045 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
6046 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6047 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6050 C print *,"cosph1", (cosph1(k), k=1,nsingle)
6051 C print *,"cosph2", (cosph2(k), k=1,nsingle)
6052 C print *,"sinph1", (sinph1(k), k=1,nsingle)
6053 C print *,"sinph2", (sinph2(k), k=1,nsingle)
6055 & write(iout,*) "ethetai",ethetai
6056 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6060 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6061 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
6062 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6063 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6064 ethetai=ethetai+sinkt(m)*aux
6065 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6066 dephii=dephii+l*sinkt(m)*(
6067 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
6068 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6069 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6070 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6071 dephii1=dephii1+(k-l)*sinkt(m)*(
6072 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6073 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6074 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
6075 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6077 write (iout,*) "m",m," k",k," l",l," ffthet",
6078 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6079 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
6080 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6081 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
6082 & " ethetai",ethetai
6083 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6084 & cosph1ph2(k,l)*sinkt(m),
6085 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6094 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6095 & i,theta(i)*rad2deg,phii*rad2deg,
6096 & phii1*rad2deg,ethetai
6098 etheta=etheta+ethetai
6099 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6100 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6101 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
6105 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6106 do i=ithetaconstr_start,ithetaconstr_end
6107 itheta=itheta_constr(i)
6108 thetiii=theta(itheta)
6109 difi=pinorm(thetiii-theta_constr0(i))
6110 if (difi.gt.theta_drange(i)) then
6111 difi=difi-theta_drange(i)
6112 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6113 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6114 & +for_thet_constr(i)*difi**3
6115 else if (difi.lt.-drange(i)) then
6117 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6118 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6119 & +for_thet_constr(i)*difi**3
6123 if (energy_dec) then
6124 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6125 & i,itheta,rad2deg*thetiii,
6126 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6127 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6128 & gloc(itheta+nphi-2,icg)
6136 c-----------------------------------------------------------------------------
6137 subroutine esc(escloc)
6138 C Calculate the local energy of a side chain and its derivatives in the
6139 C corresponding virtual-bond valence angles THETA and the spherical angles
6141 implicit real*8 (a-h,o-z)
6142 include 'DIMENSIONS'
6143 include 'COMMON.GEO'
6144 include 'COMMON.LOCAL'
6145 include 'COMMON.VAR'
6146 include 'COMMON.INTERACT'
6147 include 'COMMON.DERIV'
6148 include 'COMMON.CHAIN'
6149 include 'COMMON.IOUNITS'
6150 include 'COMMON.NAMES'
6151 include 'COMMON.FFIELD'
6152 include 'COMMON.CONTROL'
6153 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6154 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6155 common /sccalc/ time11,time12,time112,theti,it,nlobit
6158 c write (iout,'(a)') 'ESC'
6159 do i=loc_start,loc_end
6161 if (it.eq.ntyp1) cycle
6162 if (it.eq.10) goto 1
6163 nlobit=nlob(iabs(it))
6164 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6165 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6166 theti=theta(i+1)-pipol
6171 if (x(2).gt.pi-delta) then
6175 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6177 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6178 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6180 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6181 & ddersc0(1),dersc(1))
6182 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6183 & ddersc0(3),dersc(3))
6185 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6187 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6188 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6189 & dersc0(2),esclocbi,dersc02)
6190 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6192 call splinthet(x(2),0.5d0*delta,ss,ssd)
6197 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6199 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6200 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6202 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6204 c write (iout,*) escloci
6205 else if (x(2).lt.delta) then
6209 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6211 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6212 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6214 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6215 & ddersc0(1),dersc(1))
6216 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6217 & ddersc0(3),dersc(3))
6219 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6221 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6222 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6223 & dersc0(2),esclocbi,dersc02)
6224 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6229 call splinthet(x(2),0.5d0*delta,ss,ssd)
6231 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6233 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6234 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6236 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6237 c write (iout,*) escloci
6239 call enesc(x,escloci,dersc,ddummy,.false.)
6242 escloc=escloc+escloci
6243 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6244 & 'escloc',i,escloci
6245 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6247 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6249 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6250 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6255 C---------------------------------------------------------------------------
6256 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6257 implicit real*8 (a-h,o-z)
6258 include 'DIMENSIONS'
6259 include 'COMMON.GEO'
6260 include 'COMMON.LOCAL'
6261 include 'COMMON.IOUNITS'
6262 common /sccalc/ time11,time12,time112,theti,it,nlobit
6263 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6264 double precision contr(maxlob,-1:1)
6266 c write (iout,*) 'it=',it,' nlobit=',nlobit
6270 if (mixed) ddersc(j)=0.0d0
6274 C Because of periodicity of the dependence of the SC energy in omega we have
6275 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6276 C To avoid underflows, first compute & store the exponents.
6284 z(k)=x(k)-censc(k,j,it)
6289 Axk=Axk+gaussc(l,k,j,it)*z(l)
6295 expfac=expfac+Ax(k,j,iii)*z(k)
6303 C As in the case of ebend, we want to avoid underflows in exponentiation and
6304 C subsequent NaNs and INFs in energy calculation.
6305 C Find the largest exponent
6309 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6313 cd print *,'it=',it,' emin=',emin
6315 C Compute the contribution to SC energy and derivatives
6320 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6321 if(adexp.ne.adexp) adexp=1.0
6324 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6326 cd print *,'j=',j,' expfac=',expfac
6327 escloc_i=escloc_i+expfac
6329 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6333 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6334 & +gaussc(k,2,j,it))*expfac
6341 dersc(1)=dersc(1)/cos(theti)**2
6342 ddersc(1)=ddersc(1)/cos(theti)**2
6345 escloci=-(dlog(escloc_i)-emin)
6347 dersc(j)=dersc(j)/escloc_i
6351 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6356 C------------------------------------------------------------------------------
6357 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6358 implicit real*8 (a-h,o-z)
6359 include 'DIMENSIONS'
6360 include 'COMMON.GEO'
6361 include 'COMMON.LOCAL'
6362 include 'COMMON.IOUNITS'
6363 common /sccalc/ time11,time12,time112,theti,it,nlobit
6364 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6365 double precision contr(maxlob)
6376 z(k)=x(k)-censc(k,j,it)
6382 Axk=Axk+gaussc(l,k,j,it)*z(l)
6388 expfac=expfac+Ax(k,j)*z(k)
6393 C As in the case of ebend, we want to avoid underflows in exponentiation and
6394 C subsequent NaNs and INFs in energy calculation.
6395 C Find the largest exponent
6398 if (emin.gt.contr(j)) emin=contr(j)
6402 C Compute the contribution to SC energy and derivatives
6406 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6407 escloc_i=escloc_i+expfac
6409 dersc(k)=dersc(k)+Ax(k,j)*expfac
6411 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6412 & +gaussc(1,2,j,it))*expfac
6416 dersc(1)=dersc(1)/cos(theti)**2
6417 dersc12=dersc12/cos(theti)**2
6418 escloci=-(dlog(escloc_i)-emin)
6420 dersc(j)=dersc(j)/escloc_i
6422 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6426 c----------------------------------------------------------------------------------
6427 subroutine esc(escloc)
6428 C Calculate the local energy of a side chain and its derivatives in the
6429 C corresponding virtual-bond valence angles THETA and the spherical angles
6430 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6431 C added by Urszula Kozlowska. 07/11/2007
6433 implicit real*8 (a-h,o-z)
6434 include 'DIMENSIONS'
6435 include 'COMMON.GEO'
6436 include 'COMMON.LOCAL'
6437 include 'COMMON.VAR'
6438 include 'COMMON.SCROT'
6439 include 'COMMON.INTERACT'
6440 include 'COMMON.DERIV'
6441 include 'COMMON.CHAIN'
6442 include 'COMMON.IOUNITS'
6443 include 'COMMON.NAMES'
6444 include 'COMMON.FFIELD'
6445 include 'COMMON.CONTROL'
6446 include 'COMMON.VECTORS'
6447 double precision x_prime(3),y_prime(3),z_prime(3)
6448 & , sumene,dsc_i,dp2_i,x(65),
6449 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6450 & de_dxx,de_dyy,de_dzz,de_dt
6451 double precision s1_t,s1_6_t,s2_t,s2_6_t
6453 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6454 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6455 & dt_dCi(3),dt_dCi1(3)
6456 common /sccalc/ time11,time12,time112,theti,it,nlobit
6459 do i=loc_start,loc_end
6460 if (itype(i).eq.ntyp1) cycle
6461 costtab(i+1) =dcos(theta(i+1))
6462 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6463 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6464 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6465 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6466 cosfac=dsqrt(cosfac2)
6467 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6468 sinfac=dsqrt(sinfac2)
6470 if (it.eq.10) goto 1
6472 C Compute the axes of tghe local cartesian coordinates system; store in
6473 c x_prime, y_prime and z_prime
6480 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6481 C & dc_norm(3,i+nres)
6483 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6484 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6487 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6490 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6491 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6492 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6493 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6494 c & " xy",scalar(x_prime(1),y_prime(1)),
6495 c & " xz",scalar(x_prime(1),z_prime(1)),
6496 c & " yy",scalar(y_prime(1),y_prime(1)),
6497 c & " yz",scalar(y_prime(1),z_prime(1)),
6498 c & " zz",scalar(z_prime(1),z_prime(1))
6500 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6501 C to local coordinate system. Store in xx, yy, zz.
6507 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6508 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6509 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6516 C Compute the energy of the ith side cbain
6518 c write (2,*) "xx",xx," yy",yy," zz",zz
6521 x(j) = sc_parmin(j,it)
6524 Cc diagnostics - remove later
6526 yy1 = dsin(alph(2))*dcos(omeg(2))
6527 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6528 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6529 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6531 C," --- ", xx_w,yy_w,zz_w
6534 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6535 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6537 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6538 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6540 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6541 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6542 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6543 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6544 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6546 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6547 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6548 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6549 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6550 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6552 dsc_i = 0.743d0+x(61)
6554 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6555 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6556 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6557 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6558 s1=(1+x(63))/(0.1d0 + dscp1)
6559 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6560 s2=(1+x(65))/(0.1d0 + dscp2)
6561 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6562 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6563 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6564 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6566 c & dscp1,dscp2,sumene
6567 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6568 escloc = escloc + sumene
6569 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6574 C This section to check the numerical derivatives of the energy of ith side
6575 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6576 C #define DEBUG in the code to turn it on.
6578 write (2,*) "sumene =",sumene
6582 write (2,*) xx,yy,zz
6583 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6584 de_dxx_num=(sumenep-sumene)/aincr
6586 write (2,*) "xx+ sumene from enesc=",sumenep
6589 write (2,*) xx,yy,zz
6590 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6591 de_dyy_num=(sumenep-sumene)/aincr
6593 write (2,*) "yy+ sumene from enesc=",sumenep
6596 write (2,*) xx,yy,zz
6597 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6598 de_dzz_num=(sumenep-sumene)/aincr
6600 write (2,*) "zz+ sumene from enesc=",sumenep
6601 costsave=cost2tab(i+1)
6602 sintsave=sint2tab(i+1)
6603 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6604 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6605 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6606 de_dt_num=(sumenep-sumene)/aincr
6607 write (2,*) " t+ sumene from enesc=",sumenep
6608 cost2tab(i+1)=costsave
6609 sint2tab(i+1)=sintsave
6610 C End of diagnostics section.
6613 C Compute the gradient of esc
6615 c zz=zz*dsign(1.0,dfloat(itype(i)))
6616 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6617 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6618 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6619 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6620 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6621 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6622 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6623 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6624 pom1=(sumene3*sint2tab(i+1)+sumene1)
6625 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6626 pom2=(sumene4*cost2tab(i+1)+sumene2)
6627 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6628 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6629 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6630 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6632 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6633 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6634 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6636 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6637 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6638 & +(pom1+pom2)*pom_dx
6640 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6643 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6644 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6645 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6647 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6648 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6649 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6650 & +x(59)*zz**2 +x(60)*xx*zz
6651 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6652 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6653 & +(pom1-pom2)*pom_dy
6655 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6658 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6659 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6660 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6661 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6662 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6663 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6664 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6665 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6667 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6670 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6671 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6672 & +pom1*pom_dt1+pom2*pom_dt2
6674 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6679 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6680 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6681 cosfac2xx=cosfac2*xx
6682 sinfac2yy=sinfac2*yy
6684 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6686 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6688 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6689 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6690 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6691 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6692 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6693 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6694 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6695 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6696 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6697 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6701 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6702 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6703 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6704 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6707 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6708 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6709 dZZ_XYZ(k)=vbld_inv(i+nres)*
6710 & (z_prime(k)-zz*dC_norm(k,i+nres))
6712 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6713 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6717 dXX_Ctab(k,i)=dXX_Ci(k)
6718 dXX_C1tab(k,i)=dXX_Ci1(k)
6719 dYY_Ctab(k,i)=dYY_Ci(k)
6720 dYY_C1tab(k,i)=dYY_Ci1(k)
6721 dZZ_Ctab(k,i)=dZZ_Ci(k)
6722 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6723 dXX_XYZtab(k,i)=dXX_XYZ(k)
6724 dYY_XYZtab(k,i)=dYY_XYZ(k)
6725 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6729 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6730 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6731 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6732 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6733 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6735 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6736 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6737 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6738 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6739 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6740 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6741 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6742 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6744 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6745 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6747 C to check gradient call subroutine check_grad
6753 c------------------------------------------------------------------------------
6754 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6756 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6757 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6758 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6759 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6761 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6762 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6764 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6765 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6766 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6767 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6768 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6770 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6771 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6772 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6773 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6774 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6776 dsc_i = 0.743d0+x(61)
6778 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6779 & *(xx*cost2+yy*sint2))
6780 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6781 & *(xx*cost2-yy*sint2))
6782 s1=(1+x(63))/(0.1d0 + dscp1)
6783 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6784 s2=(1+x(65))/(0.1d0 + dscp2)
6785 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6786 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6787 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6792 c------------------------------------------------------------------------------
6793 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6795 C This procedure calculates two-body contact function g(rij) and its derivative:
6798 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6801 C where x=(rij-r0ij)/delta
6803 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6806 double precision rij,r0ij,eps0ij,fcont,fprimcont
6807 double precision x,x2,x4,delta
6811 if (x.lt.-1.0D0) then
6814 else if (x.le.1.0D0) then
6817 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6818 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6825 c------------------------------------------------------------------------------
6826 subroutine splinthet(theti,delta,ss,ssder)
6827 implicit real*8 (a-h,o-z)
6828 include 'DIMENSIONS'
6829 include 'COMMON.VAR'
6830 include 'COMMON.GEO'
6833 if (theti.gt.pipol) then
6834 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6836 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6841 c------------------------------------------------------------------------------
6842 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6844 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6845 double precision ksi,ksi2,ksi3,a1,a2,a3
6846 a1=fprim0*delta/(f1-f0)
6852 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6853 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6856 c------------------------------------------------------------------------------
6857 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6859 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6860 double precision ksi,ksi2,ksi3,a1,a2,a3
6865 a2=3*(f1x-f0x)-2*fprim0x*delta
6866 a3=fprim0x*delta-2*(f1x-f0x)
6867 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6870 C-----------------------------------------------------------------------------
6872 C-----------------------------------------------------------------------------
6873 subroutine etor(etors,edihcnstr)
6874 implicit real*8 (a-h,o-z)
6875 include 'DIMENSIONS'
6876 include 'COMMON.VAR'
6877 include 'COMMON.GEO'
6878 include 'COMMON.LOCAL'
6879 include 'COMMON.TORSION'
6880 include 'COMMON.INTERACT'
6881 include 'COMMON.DERIV'
6882 include 'COMMON.CHAIN'
6883 include 'COMMON.NAMES'
6884 include 'COMMON.IOUNITS'
6885 include 'COMMON.FFIELD'
6886 include 'COMMON.TORCNSTR'
6887 include 'COMMON.CONTROL'
6889 C Set lprn=.true. for debugging
6893 do i=iphi_start,iphi_end
6895 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6896 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6897 itori=itortyp(itype(i-2))
6898 itori1=itortyp(itype(i-1))
6901 C Proline-Proline pair is a special case...
6902 if (itori.eq.3 .and. itori1.eq.3) then
6903 if (phii.gt.-dwapi3) then
6905 fac=1.0D0/(1.0D0-cosphi)
6906 etorsi=v1(1,3,3)*fac
6907 etorsi=etorsi+etorsi
6908 etors=etors+etorsi-v1(1,3,3)
6909 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6910 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6913 v1ij=v1(j+1,itori,itori1)
6914 v2ij=v2(j+1,itori,itori1)
6917 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6918 if (energy_dec) etors_ii=etors_ii+
6919 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6920 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6924 v1ij=v1(j,itori,itori1)
6925 v2ij=v2(j,itori,itori1)
6928 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6929 if (energy_dec) etors_ii=etors_ii+
6930 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6931 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6934 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6937 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6938 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6939 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6940 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6941 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6943 ! 6/20/98 - dihedral angle constraints
6946 itori=idih_constr(i)
6949 if (difi.gt.drange(i)) then
6951 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6952 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6953 else if (difi.lt.-drange(i)) then
6955 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
6956 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6958 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6959 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6961 ! write (iout,*) 'edihcnstr',edihcnstr
6964 c------------------------------------------------------------------------------
6965 subroutine etor_d(etors_d)
6969 c----------------------------------------------------------------------------
6971 subroutine etor(etors,edihcnstr)
6972 implicit real*8 (a-h,o-z)
6973 include 'DIMENSIONS'
6974 include 'COMMON.VAR'
6975 include 'COMMON.GEO'
6976 include 'COMMON.LOCAL'
6977 include 'COMMON.TORSION'
6978 include 'COMMON.INTERACT'
6979 include 'COMMON.DERIV'
6980 include 'COMMON.CHAIN'
6981 include 'COMMON.NAMES'
6982 include 'COMMON.IOUNITS'
6983 include 'COMMON.FFIELD'
6984 include 'COMMON.TORCNSTR'
6985 include 'COMMON.CONTROL'
6987 C Set lprn=.true. for debugging
6991 do i=iphi_start,iphi_end
6992 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6993 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6994 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6995 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6996 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6997 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6998 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6999 C For introducing the NH3+ and COO- group please check the etor_d for reference
7002 if (iabs(itype(i)).eq.20) then
7007 itori=itortyp(itype(i-2))
7008 itori1=itortyp(itype(i-1))
7011 C Regular cosine and sine terms
7012 do j=1,nterm(itori,itori1,iblock)
7013 v1ij=v1(j,itori,itori1,iblock)
7014 v2ij=v2(j,itori,itori1,iblock)
7017 etors=etors+v1ij*cosphi+v2ij*sinphi
7018 if (energy_dec) etors_ii=etors_ii+
7019 & v1ij*cosphi+v2ij*sinphi
7020 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7024 C E = SUM ----------------------------------- - v1
7025 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7027 cosphi=dcos(0.5d0*phii)
7028 sinphi=dsin(0.5d0*phii)
7029 do j=1,nlor(itori,itori1,iblock)
7030 vl1ij=vlor1(j,itori,itori1)
7031 vl2ij=vlor2(j,itori,itori1)
7032 vl3ij=vlor3(j,itori,itori1)
7033 pom=vl2ij*cosphi+vl3ij*sinphi
7034 pom1=1.0d0/(pom*pom+1.0d0)
7035 etors=etors+vl1ij*pom1
7036 if (energy_dec) etors_ii=etors_ii+
7039 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7041 C Subtract the constant term
7042 etors=etors-v0(itori,itori1,iblock)
7043 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7044 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
7046 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7047 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7048 & (v1(j,itori,itori1,iblock),j=1,6),
7049 & (v2(j,itori,itori1,iblock),j=1,6)
7050 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7051 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7053 ! 6/20/98 - dihedral angle constraints
7055 c do i=1,ndih_constr
7056 do i=idihconstr_start,idihconstr_end
7057 itori=idih_constr(i)
7059 difi=pinorm(phii-phi0(i))
7060 if (difi.gt.drange(i)) then
7062 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7063 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7064 else if (difi.lt.-drange(i)) then
7066 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7067 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7071 if (energy_dec) then
7072 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
7073 & i,itori,rad2deg*phii,
7074 & rad2deg*phi0(i), rad2deg*drange(i),
7075 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
7078 cd write (iout,*) 'edihcnstr',edihcnstr
7081 c----------------------------------------------------------------------------
7082 subroutine etor_d(etors_d)
7083 C 6/23/01 Compute double torsional energy
7084 implicit real*8 (a-h,o-z)
7085 include 'DIMENSIONS'
7086 include 'COMMON.VAR'
7087 include 'COMMON.GEO'
7088 include 'COMMON.LOCAL'
7089 include 'COMMON.TORSION'
7090 include 'COMMON.INTERACT'
7091 include 'COMMON.DERIV'
7092 include 'COMMON.CHAIN'
7093 include 'COMMON.NAMES'
7094 include 'COMMON.IOUNITS'
7095 include 'COMMON.FFIELD'
7096 include 'COMMON.TORCNSTR'
7098 C Set lprn=.true. for debugging
7102 c write(iout,*) "a tu??"
7103 do i=iphid_start,iphid_end
7104 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7105 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7106 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7107 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7108 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7109 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7110 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7111 & (itype(i+1).eq.ntyp1)) cycle
7112 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7113 itori=itortyp(itype(i-2))
7114 itori1=itortyp(itype(i-1))
7115 itori2=itortyp(itype(i))
7121 if (iabs(itype(i+1)).eq.20) iblock=2
7122 C Iblock=2 Proline type
7123 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7124 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7125 C if (itype(i+1).eq.ntyp1) iblock=3
7126 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7127 C IS or IS NOT need for this
7128 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7129 C is (itype(i-3).eq.ntyp1) ntblock=2
7130 C ntblock is N-terminal blocking group
7132 C Regular cosine and sine terms
7133 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7134 C Example of changes for NH3+ blocking group
7135 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7136 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7137 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7138 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7139 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7140 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7141 cosphi1=dcos(j*phii)
7142 sinphi1=dsin(j*phii)
7143 cosphi2=dcos(j*phii1)
7144 sinphi2=dsin(j*phii1)
7145 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7146 & v2cij*cosphi2+v2sij*sinphi2
7147 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7148 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7150 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7152 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7153 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7154 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7155 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7156 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7157 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7158 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7159 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7160 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7161 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7162 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7163 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7164 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7165 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7168 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7169 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7174 c------------------------------------------------------------------------------
7175 subroutine eback_sc_corr(esccor)
7176 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7177 c conformational states; temporarily implemented as differences
7178 c between UNRES torsional potentials (dependent on three types of
7179 c residues) and the torsional potentials dependent on all 20 types
7180 c of residues computed from AM1 energy surfaces of terminally-blocked
7181 c amino-acid residues.
7182 implicit real*8 (a-h,o-z)
7183 include 'DIMENSIONS'
7184 include 'COMMON.VAR'
7185 include 'COMMON.GEO'
7186 include 'COMMON.LOCAL'
7187 include 'COMMON.TORSION'
7188 include 'COMMON.SCCOR'
7189 include 'COMMON.INTERACT'
7190 include 'COMMON.DERIV'
7191 include 'COMMON.CHAIN'
7192 include 'COMMON.NAMES'
7193 include 'COMMON.IOUNITS'
7194 include 'COMMON.FFIELD'
7195 include 'COMMON.CONTROL'
7197 C Set lprn=.true. for debugging
7200 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7202 do i=itau_start,itau_end
7203 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7205 isccori=isccortyp(itype(i-2))
7206 isccori1=isccortyp(itype(i-1))
7207 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7209 do intertyp=1,3 !intertyp
7210 cc Added 09 May 2012 (Adasko)
7211 cc Intertyp means interaction type of backbone mainchain correlation:
7212 c 1 = SC...Ca...Ca...Ca
7213 c 2 = Ca...Ca...Ca...SC
7214 c 3 = SC...Ca...Ca...SCi
7216 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7217 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7218 & (itype(i-1).eq.ntyp1)))
7219 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7220 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7221 & .or.(itype(i).eq.ntyp1)))
7222 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7223 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7224 & (itype(i-3).eq.ntyp1)))) cycle
7225 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7226 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7228 do j=1,nterm_sccor(isccori,isccori1)
7229 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7230 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7231 cosphi=dcos(j*tauangle(intertyp,i))
7232 sinphi=dsin(j*tauangle(intertyp,i))
7233 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7234 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7236 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7237 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7239 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7240 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
7241 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
7242 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7243 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7249 c----------------------------------------------------------------------------
7250 subroutine multibody(ecorr)
7251 C This subroutine calculates multi-body contributions to energy following
7252 C the idea of Skolnick et al. If side chains I and J make a contact and
7253 C at the same time side chains I+1 and J+1 make a contact, an extra
7254 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7255 implicit real*8 (a-h,o-z)
7256 include 'DIMENSIONS'
7257 include 'COMMON.IOUNITS'
7258 include 'COMMON.DERIV'
7259 include 'COMMON.INTERACT'
7260 include 'COMMON.CONTACTS'
7261 double precision gx(3),gx1(3)
7264 C Set lprn=.true. for debugging
7268 write (iout,'(a)') 'Contact function values:'
7270 write (iout,'(i2,20(1x,i2,f10.5))')
7271 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7286 num_conti=num_cont(i)
7287 num_conti1=num_cont(i1)
7292 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7293 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7294 cd & ' ishift=',ishift
7295 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7296 C The system gains extra energy.
7297 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7298 endif ! j1==j+-ishift
7307 c------------------------------------------------------------------------------
7308 double precision function esccorr(i,j,k,l,jj,kk)
7309 implicit real*8 (a-h,o-z)
7310 include 'DIMENSIONS'
7311 include 'COMMON.IOUNITS'
7312 include 'COMMON.DERIV'
7313 include 'COMMON.INTERACT'
7314 include 'COMMON.CONTACTS'
7315 double precision gx(3),gx1(3)
7320 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7321 C Calculate the multi-body contribution to energy.
7322 C Calculate multi-body contributions to the gradient.
7323 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7324 cd & k,l,(gacont(m,kk,k),m=1,3)
7326 gx(m) =ekl*gacont(m,jj,i)
7327 gx1(m)=eij*gacont(m,kk,k)
7328 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7329 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7330 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7331 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7335 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7340 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7346 c------------------------------------------------------------------------------
7347 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7348 C This subroutine calculates multi-body contributions to hydrogen-bonding
7349 implicit real*8 (a-h,o-z)
7350 include 'DIMENSIONS'
7351 include 'COMMON.IOUNITS'
7354 parameter (max_cont=maxconts)
7355 parameter (max_dim=26)
7356 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7357 double precision zapas(max_dim,maxconts,max_fg_procs),
7358 & zapas_recv(max_dim,maxconts,max_fg_procs)
7359 common /przechowalnia/ zapas
7360 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7361 & status_array(MPI_STATUS_SIZE,maxconts*2)
7363 include 'COMMON.SETUP'
7364 include 'COMMON.FFIELD'
7365 include 'COMMON.DERIV'
7366 include 'COMMON.INTERACT'
7367 include 'COMMON.CONTACTS'
7368 include 'COMMON.CONTROL'
7369 include 'COMMON.LOCAL'
7370 double precision gx(3),gx1(3),time00
7373 C Set lprn=.true. for debugging
7378 if (nfgtasks.le.1) goto 30
7380 write (iout,'(a)') 'Contact function values before RECEIVE:'
7382 write (iout,'(2i3,50(1x,i2,f5.2))')
7383 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7384 & j=1,num_cont_hb(i))
7388 do i=1,ntask_cont_from
7391 do i=1,ntask_cont_to
7394 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7396 C Make the list of contacts to send to send to other procesors
7397 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7399 do i=iturn3_start,iturn3_end
7400 c write (iout,*) "make contact list turn3",i," num_cont",
7402 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7404 do i=iturn4_start,iturn4_end
7405 c write (iout,*) "make contact list turn4",i," num_cont",
7407 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7411 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7413 do j=1,num_cont_hb(i)
7416 iproc=iint_sent_local(k,jjc,ii)
7417 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7418 if (iproc.gt.0) then
7419 ncont_sent(iproc)=ncont_sent(iproc)+1
7420 nn=ncont_sent(iproc)
7422 zapas(2,nn,iproc)=jjc
7423 zapas(3,nn,iproc)=facont_hb(j,i)
7424 zapas(4,nn,iproc)=ees0p(j,i)
7425 zapas(5,nn,iproc)=ees0m(j,i)
7426 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7427 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7428 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7429 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7430 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7431 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7432 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7433 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7434 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7435 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7436 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7437 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7438 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7439 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7440 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7441 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7442 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7443 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7444 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7445 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7446 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7453 & "Numbers of contacts to be sent to other processors",
7454 & (ncont_sent(i),i=1,ntask_cont_to)
7455 write (iout,*) "Contacts sent"
7456 do ii=1,ntask_cont_to
7458 iproc=itask_cont_to(ii)
7459 write (iout,*) nn," contacts to processor",iproc,
7460 & " of CONT_TO_COMM group"
7462 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7470 CorrelID1=nfgtasks+fg_rank+1
7472 C Receive the numbers of needed contacts from other processors
7473 do ii=1,ntask_cont_from
7474 iproc=itask_cont_from(ii)
7476 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7477 & FG_COMM,req(ireq),IERR)
7479 c write (iout,*) "IRECV ended"
7481 C Send the number of contacts needed by other processors
7482 do ii=1,ntask_cont_to
7483 iproc=itask_cont_to(ii)
7485 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7486 & FG_COMM,req(ireq),IERR)
7488 c write (iout,*) "ISEND ended"
7489 c write (iout,*) "number of requests (nn)",ireq
7492 & call MPI_Waitall(ireq,req,status_array,ierr)
7494 c & "Numbers of contacts to be received from other processors",
7495 c & (ncont_recv(i),i=1,ntask_cont_from)
7499 do ii=1,ntask_cont_from
7500 iproc=itask_cont_from(ii)
7502 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7503 c & " of CONT_TO_COMM group"
7507 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7508 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7509 c write (iout,*) "ireq,req",ireq,req(ireq)
7512 C Send the contacts to processors that need them
7513 do ii=1,ntask_cont_to
7514 iproc=itask_cont_to(ii)
7516 c write (iout,*) nn," contacts to processor",iproc,
7517 c & " of CONT_TO_COMM group"
7520 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7521 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7522 c write (iout,*) "ireq,req",ireq,req(ireq)
7524 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7528 c write (iout,*) "number of requests (contacts)",ireq
7529 c write (iout,*) "req",(req(i),i=1,4)
7532 & call MPI_Waitall(ireq,req,status_array,ierr)
7533 do iii=1,ntask_cont_from
7534 iproc=itask_cont_from(iii)
7537 write (iout,*) "Received",nn," contacts from processor",iproc,
7538 & " of CONT_FROM_COMM group"
7541 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7546 ii=zapas_recv(1,i,iii)
7547 c Flag the received contacts to prevent double-counting
7548 jj=-zapas_recv(2,i,iii)
7549 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7551 nnn=num_cont_hb(ii)+1
7554 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7555 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7556 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7557 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7558 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7559 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7560 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7561 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7562 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7563 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7564 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7565 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7566 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7567 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7568 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7569 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7570 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7571 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7572 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7573 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7574 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7575 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7576 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7577 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7582 write (iout,'(a)') 'Contact function values after receive:'
7584 write (iout,'(2i3,50(1x,i3,f5.2))')
7585 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7586 & j=1,num_cont_hb(i))
7593 write (iout,'(a)') 'Contact function values:'
7595 write (iout,'(2i3,50(1x,i3,f5.2))')
7596 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7597 & j=1,num_cont_hb(i))
7601 C Remove the loop below after debugging !!!
7608 C Calculate the local-electrostatic correlation terms
7609 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7611 num_conti=num_cont_hb(i)
7612 num_conti1=num_cont_hb(i+1)
7619 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7620 c & ' jj=',jj,' kk=',kk
7621 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7622 & .or. j.lt.0 .and. j1.gt.0) .and.
7623 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7624 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7625 C The system gains extra energy.
7626 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7627 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7628 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7630 else if (j1.eq.j) then
7631 C Contacts I-J and I-(J+1) occur simultaneously.
7632 C The system loses extra energy.
7633 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7638 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7639 c & ' jj=',jj,' kk=',kk
7641 C Contacts I-J and (I+1)-J occur simultaneously.
7642 C The system loses extra energy.
7643 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7650 c------------------------------------------------------------------------------
7651 subroutine add_hb_contact(ii,jj,itask)
7652 implicit real*8 (a-h,o-z)
7653 include "DIMENSIONS"
7654 include "COMMON.IOUNITS"
7657 parameter (max_cont=maxconts)
7658 parameter (max_dim=26)
7659 include "COMMON.CONTACTS"
7660 double precision zapas(max_dim,maxconts,max_fg_procs),
7661 & zapas_recv(max_dim,maxconts,max_fg_procs)
7662 common /przechowalnia/ zapas
7663 integer i,j,ii,jj,iproc,itask(4),nn
7664 c write (iout,*) "itask",itask
7667 if (iproc.gt.0) then
7668 do j=1,num_cont_hb(ii)
7670 c write (iout,*) "i",ii," j",jj," jjc",jjc
7672 ncont_sent(iproc)=ncont_sent(iproc)+1
7673 nn=ncont_sent(iproc)
7674 zapas(1,nn,iproc)=ii
7675 zapas(2,nn,iproc)=jjc
7676 zapas(3,nn,iproc)=facont_hb(j,ii)
7677 zapas(4,nn,iproc)=ees0p(j,ii)
7678 zapas(5,nn,iproc)=ees0m(j,ii)
7679 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7680 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7681 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7682 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7683 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7684 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7685 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7686 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7687 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7688 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7689 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7690 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7691 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7692 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7693 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7694 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7695 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7696 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7697 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7698 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7699 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7707 c------------------------------------------------------------------------------
7708 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7710 C This subroutine calculates multi-body contributions to hydrogen-bonding
7711 implicit real*8 (a-h,o-z)
7712 include 'DIMENSIONS'
7713 include 'COMMON.IOUNITS'
7716 parameter (max_cont=maxconts)
7717 parameter (max_dim=70)
7718 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7719 double precision zapas(max_dim,maxconts,max_fg_procs),
7720 & zapas_recv(max_dim,maxconts,max_fg_procs)
7721 common /przechowalnia/ zapas
7722 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7723 & status_array(MPI_STATUS_SIZE,maxconts*2)
7725 include 'COMMON.SETUP'
7726 include 'COMMON.FFIELD'
7727 include 'COMMON.DERIV'
7728 include 'COMMON.LOCAL'
7729 include 'COMMON.INTERACT'
7730 include 'COMMON.CONTACTS'
7731 include 'COMMON.CHAIN'
7732 include 'COMMON.CONTROL'
7733 double precision gx(3),gx1(3)
7734 integer num_cont_hb_old(maxres)
7736 double precision eello4,eello5,eelo6,eello_turn6
7737 external eello4,eello5,eello6,eello_turn6
7738 C Set lprn=.true. for debugging
7743 num_cont_hb_old(i)=num_cont_hb(i)
7747 if (nfgtasks.le.1) goto 30
7749 write (iout,'(a)') 'Contact function values before RECEIVE:'
7751 write (iout,'(2i3,50(1x,i2,f5.2))')
7752 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7753 & j=1,num_cont_hb(i))
7757 do i=1,ntask_cont_from
7760 do i=1,ntask_cont_to
7763 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7765 C Make the list of contacts to send to send to other procesors
7766 do i=iturn3_start,iturn3_end
7767 c write (iout,*) "make contact list turn3",i," num_cont",
7769 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7771 do i=iturn4_start,iturn4_end
7772 c write (iout,*) "make contact list turn4",i," num_cont",
7774 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7778 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7780 do j=1,num_cont_hb(i)
7783 iproc=iint_sent_local(k,jjc,ii)
7784 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7785 if (iproc.ne.0) then
7786 ncont_sent(iproc)=ncont_sent(iproc)+1
7787 nn=ncont_sent(iproc)
7789 zapas(2,nn,iproc)=jjc
7790 zapas(3,nn,iproc)=d_cont(j,i)
7794 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7799 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7807 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7818 & "Numbers of contacts to be sent to other processors",
7819 & (ncont_sent(i),i=1,ntask_cont_to)
7820 write (iout,*) "Contacts sent"
7821 do ii=1,ntask_cont_to
7823 iproc=itask_cont_to(ii)
7824 write (iout,*) nn," contacts to processor",iproc,
7825 & " of CONT_TO_COMM group"
7827 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7835 CorrelID1=nfgtasks+fg_rank+1
7837 C Receive the numbers of needed contacts from other processors
7838 do ii=1,ntask_cont_from
7839 iproc=itask_cont_from(ii)
7841 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7842 & FG_COMM,req(ireq),IERR)
7844 c write (iout,*) "IRECV ended"
7846 C Send the number of contacts needed by other processors
7847 do ii=1,ntask_cont_to
7848 iproc=itask_cont_to(ii)
7850 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7851 & FG_COMM,req(ireq),IERR)
7853 c write (iout,*) "ISEND ended"
7854 c write (iout,*) "number of requests (nn)",ireq
7857 & call MPI_Waitall(ireq,req,status_array,ierr)
7859 c & "Numbers of contacts to be received from other processors",
7860 c & (ncont_recv(i),i=1,ntask_cont_from)
7864 do ii=1,ntask_cont_from
7865 iproc=itask_cont_from(ii)
7867 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7868 c & " of CONT_TO_COMM group"
7872 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7873 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7874 c write (iout,*) "ireq,req",ireq,req(ireq)
7877 C Send the contacts to processors that need them
7878 do ii=1,ntask_cont_to
7879 iproc=itask_cont_to(ii)
7881 c write (iout,*) nn," contacts to processor",iproc,
7882 c & " of CONT_TO_COMM group"
7885 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7886 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7887 c write (iout,*) "ireq,req",ireq,req(ireq)
7889 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7893 c write (iout,*) "number of requests (contacts)",ireq
7894 c write (iout,*) "req",(req(i),i=1,4)
7897 & call MPI_Waitall(ireq,req,status_array,ierr)
7898 do iii=1,ntask_cont_from
7899 iproc=itask_cont_from(iii)
7902 write (iout,*) "Received",nn," contacts from processor",iproc,
7903 & " of CONT_FROM_COMM group"
7906 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7911 ii=zapas_recv(1,i,iii)
7912 c Flag the received contacts to prevent double-counting
7913 jj=-zapas_recv(2,i,iii)
7914 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7916 nnn=num_cont_hb(ii)+1
7919 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7923 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7928 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7936 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7945 write (iout,'(a)') 'Contact function values after receive:'
7947 write (iout,'(2i3,50(1x,i3,5f6.3))')
7948 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7949 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7956 write (iout,'(a)') 'Contact function values:'
7958 write (iout,'(2i3,50(1x,i2,5f6.3))')
7959 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7960 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7966 C Remove the loop below after debugging !!!
7973 C Calculate the dipole-dipole interaction energies
7974 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7975 do i=iatel_s,iatel_e+1
7976 num_conti=num_cont_hb(i)
7985 C Calculate the local-electrostatic correlation terms
7986 c write (iout,*) "gradcorr5 in eello5 before loop"
7988 c write (iout,'(i5,3f10.5)')
7989 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7991 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7992 c write (iout,*) "corr loop i",i
7994 num_conti=num_cont_hb(i)
7995 num_conti1=num_cont_hb(i+1)
8002 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8003 c & ' jj=',jj,' kk=',kk
8004 c if (j1.eq.j+1 .or. j1.eq.j-1) then
8005 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8006 & .or. j.lt.0 .and. j1.gt.0) .and.
8007 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8008 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8009 C The system gains extra energy.
8011 sqd1=dsqrt(d_cont(jj,i))
8012 sqd2=dsqrt(d_cont(kk,i1))
8013 sred_geom = sqd1*sqd2
8014 IF (sred_geom.lt.cutoff_corr) THEN
8015 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
8017 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8018 cd & ' jj=',jj,' kk=',kk
8019 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8020 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8022 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8023 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8026 cd write (iout,*) 'sred_geom=',sred_geom,
8027 cd & ' ekont=',ekont,' fprim=',fprimcont,
8028 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8029 cd write (iout,*) "g_contij",g_contij
8030 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8031 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8032 call calc_eello(i,jp,i+1,jp1,jj,kk)
8033 if (wcorr4.gt.0.0d0)
8034 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8035 if (energy_dec.and.wcorr4.gt.0.0d0)
8036 1 write (iout,'(a6,4i5,0pf7.3)')
8037 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8038 c write (iout,*) "gradcorr5 before eello5"
8040 c write (iout,'(i5,3f10.5)')
8041 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8043 if (wcorr5.gt.0.0d0)
8044 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8045 c write (iout,*) "gradcorr5 after eello5"
8047 c write (iout,'(i5,3f10.5)')
8048 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8050 if (energy_dec.and.wcorr5.gt.0.0d0)
8051 1 write (iout,'(a6,4i5,0pf7.3)')
8052 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8053 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8054 cd write(2,*)'ijkl',i,jp,i+1,jp1
8055 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
8056 & .or. wturn6.eq.0.0d0))then
8057 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8058 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8059 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8060 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8061 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8062 cd & 'ecorr6=',ecorr6
8063 cd write (iout,'(4e15.5)') sred_geom,
8064 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8065 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8066 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8067 else if (wturn6.gt.0.0d0
8068 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8069 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8070 eturn6=eturn6+eello_turn6(i,jj,kk)
8071 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8072 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8073 cd write (2,*) 'multibody_eello:eturn6',eturn6
8082 num_cont_hb(i)=num_cont_hb_old(i)
8084 c write (iout,*) "gradcorr5 in eello5"
8086 c write (iout,'(i5,3f10.5)')
8087 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8091 c------------------------------------------------------------------------------
8092 subroutine add_hb_contact_eello(ii,jj,itask)
8093 implicit real*8 (a-h,o-z)
8094 include "DIMENSIONS"
8095 include "COMMON.IOUNITS"
8098 parameter (max_cont=maxconts)
8099 parameter (max_dim=70)
8100 include "COMMON.CONTACTS"
8101 double precision zapas(max_dim,maxconts,max_fg_procs),
8102 & zapas_recv(max_dim,maxconts,max_fg_procs)
8103 common /przechowalnia/ zapas
8104 integer i,j,ii,jj,iproc,itask(4),nn
8105 c write (iout,*) "itask",itask
8108 if (iproc.gt.0) then
8109 do j=1,num_cont_hb(ii)
8111 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8113 ncont_sent(iproc)=ncont_sent(iproc)+1
8114 nn=ncont_sent(iproc)
8115 zapas(1,nn,iproc)=ii
8116 zapas(2,nn,iproc)=jjc
8117 zapas(3,nn,iproc)=d_cont(j,ii)
8121 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8126 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8134 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8146 c------------------------------------------------------------------------------
8147 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8148 implicit real*8 (a-h,o-z)
8149 include 'DIMENSIONS'
8150 include 'COMMON.IOUNITS'
8151 include 'COMMON.DERIV'
8152 include 'COMMON.INTERACT'
8153 include 'COMMON.CONTACTS'
8154 double precision gx(3),gx1(3)
8164 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8165 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8166 C Following 4 lines for diagnostics.
8171 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8172 c & 'Contacts ',i,j,
8173 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8174 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8176 C Calculate the multi-body contribution to energy.
8177 c ecorr=ecorr+ekont*ees
8178 C Calculate multi-body contributions to the gradient.
8179 coeffpees0pij=coeffp*ees0pij
8180 coeffmees0mij=coeffm*ees0mij
8181 coeffpees0pkl=coeffp*ees0pkl
8182 coeffmees0mkl=coeffm*ees0mkl
8184 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8185 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8186 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8187 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8188 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8189 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8190 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8191 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8192 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8193 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8194 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8195 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8196 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8197 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8198 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8199 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8200 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8201 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8202 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8203 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8204 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8205 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8206 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8207 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8208 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8213 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8214 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8215 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8216 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8221 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8222 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8223 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8224 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8227 c write (iout,*) "ehbcorr",ekont*ees
8232 C---------------------------------------------------------------------------
8233 subroutine dipole(i,j,jj)
8234 implicit real*8 (a-h,o-z)
8235 include 'DIMENSIONS'
8236 include 'COMMON.IOUNITS'
8237 include 'COMMON.CHAIN'
8238 include 'COMMON.FFIELD'
8239 include 'COMMON.DERIV'
8240 include 'COMMON.INTERACT'
8241 include 'COMMON.CONTACTS'
8242 include 'COMMON.TORSION'
8243 include 'COMMON.VAR'
8244 include 'COMMON.GEO'
8245 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8247 iti1 = itortyp(itype(i+1))
8248 if (j.lt.nres-1) then
8249 itj1 = itortyp(itype(j+1))
8254 dipi(iii,1)=Ub2(iii,i)
8255 dipderi(iii)=Ub2der(iii,i)
8256 dipi(iii,2)=b1(iii,i+1)
8257 dipj(iii,1)=Ub2(iii,j)
8258 dipderj(iii)=Ub2der(iii,j)
8259 dipj(iii,2)=b1(iii,j+1)
8263 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8266 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8273 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8277 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8282 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8283 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8285 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8287 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8289 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8294 C---------------------------------------------------------------------------
8295 subroutine calc_eello(i,j,k,l,jj,kk)
8297 C This subroutine computes matrices and vectors needed to calculate
8298 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8300 implicit real*8 (a-h,o-z)
8301 include 'DIMENSIONS'
8302 include 'COMMON.IOUNITS'
8303 include 'COMMON.CHAIN'
8304 include 'COMMON.DERIV'
8305 include 'COMMON.INTERACT'
8306 include 'COMMON.CONTACTS'
8307 include 'COMMON.TORSION'
8308 include 'COMMON.VAR'
8309 include 'COMMON.GEO'
8310 include 'COMMON.FFIELD'
8311 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8312 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8315 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8316 cd & ' jj=',jj,' kk=',kk
8317 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8318 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8319 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8322 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8323 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8326 call transpose2(aa1(1,1),aa1t(1,1))
8327 call transpose2(aa2(1,1),aa2t(1,1))
8330 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8331 & aa1tder(1,1,lll,kkk))
8332 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8333 & aa2tder(1,1,lll,kkk))
8337 C parallel orientation of the two CA-CA-CA frames.
8339 iti=itortyp(itype(i))
8343 itk1=itortyp(itype(k+1))
8344 itj=itortyp(itype(j))
8345 if (l.lt.nres-1) then
8346 itl1=itortyp(itype(l+1))
8350 C A1 kernel(j+1) A2T
8352 cd write (iout,'(3f10.5,5x,3f10.5)')
8353 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8355 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8356 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8357 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8358 C Following matrices are needed only for 6-th order cumulants
8359 IF (wcorr6.gt.0.0d0) THEN
8360 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8361 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8362 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8363 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8364 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8365 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8366 & ADtEAderx(1,1,1,1,1,1))
8368 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8369 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8370 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8371 & ADtEA1derx(1,1,1,1,1,1))
8373 C End 6-th order cumulants
8376 cd write (2,*) 'In calc_eello6'
8378 cd write (2,*) 'iii=',iii
8380 cd write (2,*) 'kkk=',kkk
8382 cd write (2,'(3(2f10.5),5x)')
8383 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8388 call transpose2(EUgder(1,1,k),auxmat(1,1))
8389 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8390 call transpose2(EUg(1,1,k),auxmat(1,1))
8391 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8392 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8396 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8397 & EAEAderx(1,1,lll,kkk,iii,1))
8401 C A1T kernel(i+1) A2
8402 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8403 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8404 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8405 C Following matrices are needed only for 6-th order cumulants
8406 IF (wcorr6.gt.0.0d0) THEN
8407 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8408 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8409 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8410 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8411 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8412 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8413 & ADtEAderx(1,1,1,1,1,2))
8414 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8415 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8416 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8417 & ADtEA1derx(1,1,1,1,1,2))
8419 C End 6-th order cumulants
8420 call transpose2(EUgder(1,1,l),auxmat(1,1))
8421 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8422 call transpose2(EUg(1,1,l),auxmat(1,1))
8423 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8424 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8428 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8429 & EAEAderx(1,1,lll,kkk,iii,2))
8434 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8435 C They are needed only when the fifth- or the sixth-order cumulants are
8437 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8438 call transpose2(AEA(1,1,1),auxmat(1,1))
8439 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8440 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8441 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8442 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8443 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8444 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8445 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8446 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8447 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8448 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8449 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8450 call transpose2(AEA(1,1,2),auxmat(1,1))
8451 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8452 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8453 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8454 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8455 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8456 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8457 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8458 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8459 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8460 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8461 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8462 C Calculate the Cartesian derivatives of the vectors.
8466 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8467 call matvec2(auxmat(1,1),b1(1,i),
8468 & AEAb1derx(1,lll,kkk,iii,1,1))
8469 call matvec2(auxmat(1,1),Ub2(1,i),
8470 & AEAb2derx(1,lll,kkk,iii,1,1))
8471 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8472 & AEAb1derx(1,lll,kkk,iii,2,1))
8473 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8474 & AEAb2derx(1,lll,kkk,iii,2,1))
8475 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8476 call matvec2(auxmat(1,1),b1(1,j),
8477 & AEAb1derx(1,lll,kkk,iii,1,2))
8478 call matvec2(auxmat(1,1),Ub2(1,j),
8479 & AEAb2derx(1,lll,kkk,iii,1,2))
8480 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8481 & AEAb1derx(1,lll,kkk,iii,2,2))
8482 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8483 & AEAb2derx(1,lll,kkk,iii,2,2))
8490 C Antiparallel orientation of the two CA-CA-CA frames.
8492 iti=itortyp(itype(i))
8496 itk1=itortyp(itype(k+1))
8497 itl=itortyp(itype(l))
8498 itj=itortyp(itype(j))
8499 if (j.lt.nres-1) then
8500 itj1=itortyp(itype(j+1))
8504 C A2 kernel(j-1)T A1T
8505 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8506 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8507 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8508 C Following matrices are needed only for 6-th order cumulants
8509 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8510 & j.eq.i+4 .and. l.eq.i+3)) THEN
8511 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8512 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8513 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8514 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8515 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8516 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8517 & ADtEAderx(1,1,1,1,1,1))
8518 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8519 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8520 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8521 & ADtEA1derx(1,1,1,1,1,1))
8523 C End 6-th order cumulants
8524 call transpose2(EUgder(1,1,k),auxmat(1,1))
8525 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8526 call transpose2(EUg(1,1,k),auxmat(1,1))
8527 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8528 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8532 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8533 & EAEAderx(1,1,lll,kkk,iii,1))
8537 C A2T kernel(i+1)T A1
8538 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8539 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8540 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8541 C Following matrices are needed only for 6-th order cumulants
8542 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8543 & j.eq.i+4 .and. l.eq.i+3)) THEN
8544 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8545 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8546 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8547 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8548 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8549 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8550 & ADtEAderx(1,1,1,1,1,2))
8551 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8552 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8553 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8554 & ADtEA1derx(1,1,1,1,1,2))
8556 C End 6-th order cumulants
8557 call transpose2(EUgder(1,1,j),auxmat(1,1))
8558 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8559 call transpose2(EUg(1,1,j),auxmat(1,1))
8560 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8561 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8565 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8566 & EAEAderx(1,1,lll,kkk,iii,2))
8571 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8572 C They are needed only when the fifth- or the sixth-order cumulants are
8574 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8575 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8576 call transpose2(AEA(1,1,1),auxmat(1,1))
8577 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8578 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8579 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8580 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8581 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8582 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8583 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8584 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8585 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8586 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8587 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8588 call transpose2(AEA(1,1,2),auxmat(1,1))
8589 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8590 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8591 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8592 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8593 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8594 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8595 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8596 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8597 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8598 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8599 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8600 C Calculate the Cartesian derivatives of the vectors.
8604 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8605 call matvec2(auxmat(1,1),b1(1,i),
8606 & AEAb1derx(1,lll,kkk,iii,1,1))
8607 call matvec2(auxmat(1,1),Ub2(1,i),
8608 & AEAb2derx(1,lll,kkk,iii,1,1))
8609 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8610 & AEAb1derx(1,lll,kkk,iii,2,1))
8611 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8612 & AEAb2derx(1,lll,kkk,iii,2,1))
8613 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8614 call matvec2(auxmat(1,1),b1(1,l),
8615 & AEAb1derx(1,lll,kkk,iii,1,2))
8616 call matvec2(auxmat(1,1),Ub2(1,l),
8617 & AEAb2derx(1,lll,kkk,iii,1,2))
8618 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8619 & AEAb1derx(1,lll,kkk,iii,2,2))
8620 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8621 & AEAb2derx(1,lll,kkk,iii,2,2))
8630 C---------------------------------------------------------------------------
8631 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8632 & KK,KKderg,AKA,AKAderg,AKAderx)
8636 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8637 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8638 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8643 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8645 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8648 cd if (lprn) write (2,*) 'In kernel'
8650 cd if (lprn) write (2,*) 'kkk=',kkk
8652 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8653 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8655 cd write (2,*) 'lll=',lll
8656 cd write (2,*) 'iii=1'
8658 cd write (2,'(3(2f10.5),5x)')
8659 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8662 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8663 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8665 cd write (2,*) 'lll=',lll
8666 cd write (2,*) 'iii=2'
8668 cd write (2,'(3(2f10.5),5x)')
8669 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8676 C---------------------------------------------------------------------------
8677 double precision function eello4(i,j,k,l,jj,kk)
8678 implicit real*8 (a-h,o-z)
8679 include 'DIMENSIONS'
8680 include 'COMMON.IOUNITS'
8681 include 'COMMON.CHAIN'
8682 include 'COMMON.DERIV'
8683 include 'COMMON.INTERACT'
8684 include 'COMMON.CONTACTS'
8685 include 'COMMON.TORSION'
8686 include 'COMMON.VAR'
8687 include 'COMMON.GEO'
8688 double precision pizda(2,2),ggg1(3),ggg2(3)
8689 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8693 cd print *,'eello4:',i,j,k,l,jj,kk
8694 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8695 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8696 cold eij=facont_hb(jj,i)
8697 cold ekl=facont_hb(kk,k)
8699 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8700 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8701 gcorr_loc(k-1)=gcorr_loc(k-1)
8702 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8704 gcorr_loc(l-1)=gcorr_loc(l-1)
8705 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8707 gcorr_loc(j-1)=gcorr_loc(j-1)
8708 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8713 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8714 & -EAEAderx(2,2,lll,kkk,iii,1)
8715 cd derx(lll,kkk,iii)=0.0d0
8719 cd gcorr_loc(l-1)=0.0d0
8720 cd gcorr_loc(j-1)=0.0d0
8721 cd gcorr_loc(k-1)=0.0d0
8723 cd write (iout,*)'Contacts have occurred for peptide groups',
8724 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8725 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8726 if (j.lt.nres-1) then
8733 if (l.lt.nres-1) then
8741 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8742 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8743 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8744 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8745 cgrad ghalf=0.5d0*ggg1(ll)
8746 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8747 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8748 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8749 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8750 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8751 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8752 cgrad ghalf=0.5d0*ggg2(ll)
8753 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8754 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8755 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8756 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8757 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8758 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8762 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8767 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8772 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8777 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8781 cd write (2,*) iii,gcorr_loc(iii)
8784 cd write (2,*) 'ekont',ekont
8785 cd write (iout,*) 'eello4',ekont*eel4
8788 C---------------------------------------------------------------------------
8789 double precision function eello5(i,j,k,l,jj,kk)
8790 implicit real*8 (a-h,o-z)
8791 include 'DIMENSIONS'
8792 include 'COMMON.IOUNITS'
8793 include 'COMMON.CHAIN'
8794 include 'COMMON.DERIV'
8795 include 'COMMON.INTERACT'
8796 include 'COMMON.CONTACTS'
8797 include 'COMMON.TORSION'
8798 include 'COMMON.VAR'
8799 include 'COMMON.GEO'
8800 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8801 double precision ggg1(3),ggg2(3)
8802 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8807 C /l\ / \ \ / \ / \ / C
8808 C / \ / \ \ / \ / \ / C
8809 C j| o |l1 | o | o| o | | o |o C
8810 C \ |/k\| |/ \| / |/ \| |/ \| C
8811 C \i/ \ / \ / / \ / \ C
8813 C (I) (II) (III) (IV) C
8815 C eello5_1 eello5_2 eello5_3 eello5_4 C
8817 C Antiparallel chains C
8820 C /j\ / \ \ / \ / \ / C
8821 C / \ / \ \ / \ / \ / C
8822 C j1| o |l | o | o| o | | o |o C
8823 C \ |/k\| |/ \| / |/ \| |/ \| C
8824 C \i/ \ / \ / / \ / \ C
8826 C (I) (II) (III) (IV) C
8828 C eello5_1 eello5_2 eello5_3 eello5_4 C
8830 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8832 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8833 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8838 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8840 itk=itortyp(itype(k))
8841 itl=itortyp(itype(l))
8842 itj=itortyp(itype(j))
8847 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8848 cd & eel5_3_num,eel5_4_num)
8852 derx(lll,kkk,iii)=0.0d0
8856 cd eij=facont_hb(jj,i)
8857 cd ekl=facont_hb(kk,k)
8859 cd write (iout,*)'Contacts have occurred for peptide groups',
8860 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8862 C Contribution from the graph I.
8863 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8864 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8865 call transpose2(EUg(1,1,k),auxmat(1,1))
8866 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8867 vv(1)=pizda(1,1)-pizda(2,2)
8868 vv(2)=pizda(1,2)+pizda(2,1)
8869 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8870 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8871 C Explicit gradient in virtual-dihedral angles.
8872 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8873 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8874 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8875 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8876 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8877 vv(1)=pizda(1,1)-pizda(2,2)
8878 vv(2)=pizda(1,2)+pizda(2,1)
8879 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8880 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8881 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8882 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8883 vv(1)=pizda(1,1)-pizda(2,2)
8884 vv(2)=pizda(1,2)+pizda(2,1)
8886 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8887 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8888 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8890 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8891 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8892 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8894 C Cartesian gradient
8898 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8900 vv(1)=pizda(1,1)-pizda(2,2)
8901 vv(2)=pizda(1,2)+pizda(2,1)
8902 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8903 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8904 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8910 C Contribution from graph II
8911 call transpose2(EE(1,1,itk),auxmat(1,1))
8912 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8913 vv(1)=pizda(1,1)+pizda(2,2)
8914 vv(2)=pizda(2,1)-pizda(1,2)
8915 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8916 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8917 C Explicit gradient in virtual-dihedral angles.
8918 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8919 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8920 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8921 vv(1)=pizda(1,1)+pizda(2,2)
8922 vv(2)=pizda(2,1)-pizda(1,2)
8924 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8925 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8926 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8928 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8929 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8930 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8932 C Cartesian gradient
8936 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8938 vv(1)=pizda(1,1)+pizda(2,2)
8939 vv(2)=pizda(2,1)-pizda(1,2)
8940 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8941 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8942 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8950 C Parallel orientation
8951 C Contribution from graph III
8952 call transpose2(EUg(1,1,l),auxmat(1,1))
8953 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8954 vv(1)=pizda(1,1)-pizda(2,2)
8955 vv(2)=pizda(1,2)+pizda(2,1)
8956 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8957 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8958 C Explicit gradient in virtual-dihedral angles.
8959 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8960 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8961 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8962 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8963 vv(1)=pizda(1,1)-pizda(2,2)
8964 vv(2)=pizda(1,2)+pizda(2,1)
8965 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8966 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8967 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8968 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8969 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8970 vv(1)=pizda(1,1)-pizda(2,2)
8971 vv(2)=pizda(1,2)+pizda(2,1)
8972 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8973 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8974 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8975 C Cartesian gradient
8979 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8981 vv(1)=pizda(1,1)-pizda(2,2)
8982 vv(2)=pizda(1,2)+pizda(2,1)
8983 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8984 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8985 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8990 C Contribution from graph IV
8992 call transpose2(EE(1,1,itl),auxmat(1,1))
8993 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8994 vv(1)=pizda(1,1)+pizda(2,2)
8995 vv(2)=pizda(2,1)-pizda(1,2)
8996 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8997 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8998 C Explicit gradient in virtual-dihedral angles.
8999 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9000 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9001 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9002 vv(1)=pizda(1,1)+pizda(2,2)
9003 vv(2)=pizda(2,1)-pizda(1,2)
9004 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9005 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
9006 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9007 C Cartesian gradient
9011 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9013 vv(1)=pizda(1,1)+pizda(2,2)
9014 vv(2)=pizda(2,1)-pizda(1,2)
9015 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9016 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
9017 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9022 C Antiparallel orientation
9023 C Contribution from graph III
9025 call transpose2(EUg(1,1,j),auxmat(1,1))
9026 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9027 vv(1)=pizda(1,1)-pizda(2,2)
9028 vv(2)=pizda(1,2)+pizda(2,1)
9029 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9030 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9031 C Explicit gradient in virtual-dihedral angles.
9032 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9033 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9034 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9035 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9036 vv(1)=pizda(1,1)-pizda(2,2)
9037 vv(2)=pizda(1,2)+pizda(2,1)
9038 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9039 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9040 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9041 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9042 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9043 vv(1)=pizda(1,1)-pizda(2,2)
9044 vv(2)=pizda(1,2)+pizda(2,1)
9045 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9046 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9047 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9048 C Cartesian gradient
9052 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9054 vv(1)=pizda(1,1)-pizda(2,2)
9055 vv(2)=pizda(1,2)+pizda(2,1)
9056 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9057 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9058 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9063 C Contribution from graph IV
9065 call transpose2(EE(1,1,itj),auxmat(1,1))
9066 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9067 vv(1)=pizda(1,1)+pizda(2,2)
9068 vv(2)=pizda(2,1)-pizda(1,2)
9069 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9070 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9071 C Explicit gradient in virtual-dihedral angles.
9072 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9073 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9074 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9075 vv(1)=pizda(1,1)+pizda(2,2)
9076 vv(2)=pizda(2,1)-pizda(1,2)
9077 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9078 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9079 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9080 C Cartesian gradient
9084 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9086 vv(1)=pizda(1,1)+pizda(2,2)
9087 vv(2)=pizda(2,1)-pizda(1,2)
9088 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9089 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9090 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9096 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9097 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9098 cd write (2,*) 'ijkl',i,j,k,l
9099 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9100 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9102 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9103 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9104 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9105 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9106 if (j.lt.nres-1) then
9113 if (l.lt.nres-1) then
9123 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9124 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9125 C summed up outside the subrouine as for the other subroutines
9126 C handling long-range interactions. The old code is commented out
9127 C with "cgrad" to keep track of changes.
9129 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9130 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9131 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9132 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9133 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9134 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9135 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9136 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9137 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9138 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9140 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9141 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9142 cgrad ghalf=0.5d0*ggg1(ll)
9144 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9145 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9146 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9147 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9148 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9149 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9150 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9151 cgrad ghalf=0.5d0*ggg2(ll)
9153 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
9154 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9155 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
9156 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9157 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9158 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9163 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9164 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9169 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9170 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9176 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9181 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9185 cd write (2,*) iii,g_corr5_loc(iii)
9188 cd write (2,*) 'ekont',ekont
9189 cd write (iout,*) 'eello5',ekont*eel5
9192 c--------------------------------------------------------------------------
9193 double precision function eello6(i,j,k,l,jj,kk)
9194 implicit real*8 (a-h,o-z)
9195 include 'DIMENSIONS'
9196 include 'COMMON.IOUNITS'
9197 include 'COMMON.CHAIN'
9198 include 'COMMON.DERIV'
9199 include 'COMMON.INTERACT'
9200 include 'COMMON.CONTACTS'
9201 include 'COMMON.TORSION'
9202 include 'COMMON.VAR'
9203 include 'COMMON.GEO'
9204 include 'COMMON.FFIELD'
9205 double precision ggg1(3),ggg2(3)
9206 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9211 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9219 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9220 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9224 derx(lll,kkk,iii)=0.0d0
9228 cd eij=facont_hb(jj,i)
9229 cd ekl=facont_hb(kk,k)
9235 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9236 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9237 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9238 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9239 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9240 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9242 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9243 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9244 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9245 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9246 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9247 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9251 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9253 C If turn contributions are considered, they will be handled separately.
9254 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9255 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9256 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9257 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9258 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9259 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9260 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9262 if (j.lt.nres-1) then
9269 if (l.lt.nres-1) then
9277 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9278 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9279 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9280 cgrad ghalf=0.5d0*ggg1(ll)
9282 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9283 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9284 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9285 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9286 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9287 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9288 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9289 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9290 cgrad ghalf=0.5d0*ggg2(ll)
9291 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9293 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9294 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9295 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9296 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9297 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9298 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9303 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9304 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9309 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9310 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9316 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9321 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9325 cd write (2,*) iii,g_corr6_loc(iii)
9328 cd write (2,*) 'ekont',ekont
9329 cd write (iout,*) 'eello6',ekont*eel6
9332 c--------------------------------------------------------------------------
9333 double precision function eello6_graph1(i,j,k,l,imat,swap)
9334 implicit real*8 (a-h,o-z)
9335 include 'DIMENSIONS'
9336 include 'COMMON.IOUNITS'
9337 include 'COMMON.CHAIN'
9338 include 'COMMON.DERIV'
9339 include 'COMMON.INTERACT'
9340 include 'COMMON.CONTACTS'
9341 include 'COMMON.TORSION'
9342 include 'COMMON.VAR'
9343 include 'COMMON.GEO'
9344 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9348 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9350 C Parallel Antiparallel C
9356 C \ j|/k\| / \ |/k\|l / C
9361 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9362 itk=itortyp(itype(k))
9363 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9364 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9365 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9366 call transpose2(EUgC(1,1,k),auxmat(1,1))
9367 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9368 vv1(1)=pizda1(1,1)-pizda1(2,2)
9369 vv1(2)=pizda1(1,2)+pizda1(2,1)
9370 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9371 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9372 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9373 s5=scalar2(vv(1),Dtobr2(1,i))
9374 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9375 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9376 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9377 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9378 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9379 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9380 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9381 & +scalar2(vv(1),Dtobr2der(1,i)))
9382 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9383 vv1(1)=pizda1(1,1)-pizda1(2,2)
9384 vv1(2)=pizda1(1,2)+pizda1(2,1)
9385 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9386 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9388 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9389 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9390 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9391 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9392 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9394 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9395 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9396 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9397 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9398 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9400 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9401 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9402 vv1(1)=pizda1(1,1)-pizda1(2,2)
9403 vv1(2)=pizda1(1,2)+pizda1(2,1)
9404 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9405 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9406 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9407 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9416 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9417 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9418 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9419 call transpose2(EUgC(1,1,k),auxmat(1,1))
9420 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9422 vv1(1)=pizda1(1,1)-pizda1(2,2)
9423 vv1(2)=pizda1(1,2)+pizda1(2,1)
9424 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9425 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9426 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9427 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9428 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9429 s5=scalar2(vv(1),Dtobr2(1,i))
9430 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9436 c----------------------------------------------------------------------------
9437 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9438 implicit real*8 (a-h,o-z)
9439 include 'DIMENSIONS'
9440 include 'COMMON.IOUNITS'
9441 include 'COMMON.CHAIN'
9442 include 'COMMON.DERIV'
9443 include 'COMMON.INTERACT'
9444 include 'COMMON.CONTACTS'
9445 include 'COMMON.TORSION'
9446 include 'COMMON.VAR'
9447 include 'COMMON.GEO'
9449 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9450 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9453 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9455 C Parallel Antiparallel C
9461 C \ j|/k\| \ |/k\|l C
9466 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9467 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9468 C AL 7/4/01 s1 would occur in the sixth-order moment,
9469 C but not in a cluster cumulant
9471 s1=dip(1,jj,i)*dip(1,kk,k)
9473 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9474 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9475 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9476 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9477 call transpose2(EUg(1,1,k),auxmat(1,1))
9478 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9479 vv(1)=pizda(1,1)-pizda(2,2)
9480 vv(2)=pizda(1,2)+pizda(2,1)
9481 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9482 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9484 eello6_graph2=-(s1+s2+s3+s4)
9486 eello6_graph2=-(s2+s3+s4)
9489 C Derivatives in gamma(i-1)
9492 s1=dipderg(1,jj,i)*dip(1,kk,k)
9494 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9495 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9496 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9497 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9499 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9501 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9503 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9505 C Derivatives in gamma(k-1)
9507 s1=dip(1,jj,i)*dipderg(1,kk,k)
9509 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9510 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9511 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9512 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9513 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9514 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9515 vv(1)=pizda(1,1)-pizda(2,2)
9516 vv(2)=pizda(1,2)+pizda(2,1)
9517 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9519 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9521 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9523 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9524 C Derivatives in gamma(j-1) or gamma(l-1)
9527 s1=dipderg(3,jj,i)*dip(1,kk,k)
9529 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9530 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9531 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9532 call matmat2(ADtEA1derg(1,1,1,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(l-1)=g_corr6_loc(l-1)-ekont*s1
9540 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9543 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9544 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9546 C Derivatives in gamma(l-1) or gamma(j-1)
9549 s1=dip(1,jj,i)*dipderg(3,kk,k)
9551 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9552 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9553 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9554 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9555 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9556 vv(1)=pizda(1,1)-pizda(2,2)
9557 vv(2)=pizda(1,2)+pizda(2,1)
9558 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9561 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9563 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9566 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9567 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9569 C Cartesian derivatives.
9571 write (2,*) 'In eello6_graph2'
9573 write (2,*) 'iii=',iii
9575 write (2,*) 'kkk=',kkk
9577 write (2,'(3(2f10.5),5x)')
9578 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9588 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9590 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9593 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9595 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9596 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9598 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9599 call transpose2(EUg(1,1,k),auxmat(1,1))
9600 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9602 vv(1)=pizda(1,1)-pizda(2,2)
9603 vv(2)=pizda(1,2)+pizda(2,1)
9604 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9605 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9607 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9609 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9612 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9614 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9621 c----------------------------------------------------------------------------
9622 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9623 implicit real*8 (a-h,o-z)
9624 include 'DIMENSIONS'
9625 include 'COMMON.IOUNITS'
9626 include 'COMMON.CHAIN'
9627 include 'COMMON.DERIV'
9628 include 'COMMON.INTERACT'
9629 include 'COMMON.CONTACTS'
9630 include 'COMMON.TORSION'
9631 include 'COMMON.VAR'
9632 include 'COMMON.GEO'
9633 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9635 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9637 C Parallel Antiparallel C
9643 C j|/k\| / |/k\|l / C
9648 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9650 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9651 C energy moment and not to the cluster cumulant.
9652 iti=itortyp(itype(i))
9653 if (j.lt.nres-1) then
9654 itj1=itortyp(itype(j+1))
9658 itk=itortyp(itype(k))
9659 itk1=itortyp(itype(k+1))
9660 if (l.lt.nres-1) then
9661 itl1=itortyp(itype(l+1))
9666 s1=dip(4,jj,i)*dip(4,kk,k)
9668 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9669 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9670 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9671 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9672 call transpose2(EE(1,1,itk),auxmat(1,1))
9673 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9674 vv(1)=pizda(1,1)+pizda(2,2)
9675 vv(2)=pizda(2,1)-pizda(1,2)
9676 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9677 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9678 cd & "sum",-(s2+s3+s4)
9680 eello6_graph3=-(s1+s2+s3+s4)
9682 eello6_graph3=-(s2+s3+s4)
9685 C Derivatives in gamma(k-1)
9686 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9687 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9688 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9689 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9690 C Derivatives in gamma(l-1)
9691 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9692 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9693 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,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))
9697 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9698 C Cartesian derivatives.
9704 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9706 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9709 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9711 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9712 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9714 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9715 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9717 vv(1)=pizda(1,1)+pizda(2,2)
9718 vv(2)=pizda(2,1)-pizda(1,2)
9719 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9721 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9723 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9726 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9728 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9730 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9736 c----------------------------------------------------------------------------
9737 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9738 implicit real*8 (a-h,o-z)
9739 include 'DIMENSIONS'
9740 include 'COMMON.IOUNITS'
9741 include 'COMMON.CHAIN'
9742 include 'COMMON.DERIV'
9743 include 'COMMON.INTERACT'
9744 include 'COMMON.CONTACTS'
9745 include 'COMMON.TORSION'
9746 include 'COMMON.VAR'
9747 include 'COMMON.GEO'
9748 include 'COMMON.FFIELD'
9749 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9750 & auxvec1(2),auxmat1(2,2)
9752 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9754 C Parallel Antiparallel C
9760 C \ j|/k\| \ |/k\|l C
9765 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9767 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9768 C energy moment and not to the cluster cumulant.
9769 cd write (2,*) 'eello_graph4: wturn6',wturn6
9770 iti=itortyp(itype(i))
9771 itj=itortyp(itype(j))
9772 if (j.lt.nres-1) then
9773 itj1=itortyp(itype(j+1))
9777 itk=itortyp(itype(k))
9778 if (k.lt.nres-1) then
9779 itk1=itortyp(itype(k+1))
9783 itl=itortyp(itype(l))
9784 if (l.lt.nres-1) then
9785 itl1=itortyp(itype(l+1))
9789 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9790 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9791 cd & ' itl',itl,' itl1',itl1
9794 s1=dip(3,jj,i)*dip(3,kk,k)
9796 s1=dip(2,jj,j)*dip(2,kk,l)
9799 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9800 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9802 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9803 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9805 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9806 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9808 call transpose2(EUg(1,1,k),auxmat(1,1))
9809 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9810 vv(1)=pizda(1,1)-pizda(2,2)
9811 vv(2)=pizda(2,1)+pizda(1,2)
9812 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9813 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9815 eello6_graph4=-(s1+s2+s3+s4)
9817 eello6_graph4=-(s2+s3+s4)
9819 C Derivatives in gamma(i-1)
9823 s1=dipderg(2,jj,i)*dip(3,kk,k)
9825 s1=dipderg(4,jj,j)*dip(2,kk,l)
9828 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9830 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9831 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9833 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9834 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9836 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9837 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9838 cd write (2,*) 'turn6 derivatives'
9840 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9842 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9846 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9848 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9852 C Derivatives in gamma(k-1)
9855 s1=dip(3,jj,i)*dipderg(2,kk,k)
9857 s1=dip(2,jj,j)*dipderg(4,kk,l)
9860 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9861 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9863 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9864 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9866 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9867 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9869 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9870 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9871 vv(1)=pizda(1,1)-pizda(2,2)
9872 vv(2)=pizda(2,1)+pizda(1,2)
9873 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9874 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9876 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9878 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9882 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9884 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9887 C Derivatives in gamma(j-1) or gamma(l-1)
9888 if (l.eq.j+1 .and. l.gt.1) then
9889 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9890 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9891 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9892 vv(1)=pizda(1,1)-pizda(2,2)
9893 vv(2)=pizda(2,1)+pizda(1,2)
9894 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9895 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9896 else if (j.gt.1) then
9897 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9898 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9899 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9900 vv(1)=pizda(1,1)-pizda(2,2)
9901 vv(2)=pizda(2,1)+pizda(1,2)
9902 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9903 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9904 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9906 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9909 C Cartesian derivatives.
9916 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9918 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9922 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9924 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9928 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9930 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9932 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9933 & b1(1,j+1),auxvec(1))
9934 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9936 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9937 & b1(1,l+1),auxvec(1))
9938 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9940 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9942 vv(1)=pizda(1,1)-pizda(2,2)
9943 vv(2)=pizda(2,1)+pizda(1,2)
9944 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9946 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9948 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9951 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9954 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9957 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9959 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9961 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9965 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9967 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9970 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9972 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9980 c----------------------------------------------------------------------------
9981 double precision function eello_turn6(i,jj,kk)
9982 implicit real*8 (a-h,o-z)
9983 include 'DIMENSIONS'
9984 include 'COMMON.IOUNITS'
9985 include 'COMMON.CHAIN'
9986 include 'COMMON.DERIV'
9987 include 'COMMON.INTERACT'
9988 include 'COMMON.CONTACTS'
9989 include 'COMMON.TORSION'
9990 include 'COMMON.VAR'
9991 include 'COMMON.GEO'
9992 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9993 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9995 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9996 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9997 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9998 C the respective energy moment and not to the cluster cumulant.
10007 iti=itortyp(itype(i))
10008 itk=itortyp(itype(k))
10009 itk1=itortyp(itype(k+1))
10010 itl=itortyp(itype(l))
10011 itj=itortyp(itype(j))
10012 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10013 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
10014 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10019 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10021 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10025 derx_turn(lll,kkk,iii)=0.0d0
10032 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10034 cd write (2,*) 'eello6_5',eello6_5
10036 call transpose2(AEA(1,1,1),auxmat(1,1))
10037 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10038 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10039 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10041 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10042 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10043 s2 = scalar2(b1(1,k),vtemp1(1))
10045 call transpose2(AEA(1,1,2),atemp(1,1))
10046 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10047 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10048 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10050 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10051 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10052 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10054 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10055 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10056 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10057 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10058 ss13 = scalar2(b1(1,k),vtemp4(1))
10059 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10061 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10067 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10068 C Derivatives in gamma(i+2)
10072 call transpose2(AEA(1,1,1),auxmatd(1,1))
10073 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10074 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10075 call transpose2(AEAderg(1,1,2),atempd(1,1))
10076 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10077 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10079 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10080 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10081 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10087 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10088 C Derivatives in gamma(i+3)
10090 call transpose2(AEA(1,1,1),auxmatd(1,1))
10091 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10092 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10093 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10095 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10096 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10097 s2d = scalar2(b1(1,k),vtemp1d(1))
10099 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10100 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10102 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10104 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10105 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10106 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10114 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10115 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10117 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10118 & -0.5d0*ekont*(s2d+s12d)
10120 C Derivatives in gamma(i+4)
10121 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10122 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10123 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10125 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10126 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10127 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10135 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10137 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10139 C Derivatives in gamma(i+5)
10141 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10142 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10143 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10145 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10146 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10147 s2d = scalar2(b1(1,k),vtemp1d(1))
10149 call transpose2(AEA(1,1,2),atempd(1,1))
10150 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10151 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10153 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10154 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10156 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10157 ss13d = scalar2(b1(1,k),vtemp4d(1))
10158 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10166 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10167 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10169 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10170 & -0.5d0*ekont*(s2d+s12d)
10172 C Cartesian derivatives
10177 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10178 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10179 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10181 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10182 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10184 s2d = scalar2(b1(1,k),vtemp1d(1))
10186 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10187 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10188 s8d = -(atempd(1,1)+atempd(2,2))*
10189 & scalar2(cc(1,1,itl),vtemp2(1))
10191 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10193 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10194 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10201 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10202 & - 0.5d0*(s1d+s2d)
10204 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10208 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10209 & - 0.5d0*(s8d+s12d)
10211 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10220 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10221 & achuj_tempd(1,1))
10222 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10223 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10224 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10225 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10226 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10228 ss13d = scalar2(b1(1,k),vtemp4d(1))
10229 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10230 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10234 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10235 cd & 16*eel_turn6_num
10237 if (j.lt.nres-1) then
10244 if (l.lt.nres-1) then
10252 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10253 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10254 cgrad ghalf=0.5d0*ggg1(ll)
10256 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10257 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10258 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10259 & +ekont*derx_turn(ll,2,1)
10260 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10261 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10262 & +ekont*derx_turn(ll,4,1)
10263 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10264 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10265 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10266 cgrad ghalf=0.5d0*ggg2(ll)
10268 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10269 & +ekont*derx_turn(ll,2,2)
10270 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10271 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10272 & +ekont*derx_turn(ll,4,2)
10273 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10274 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10275 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10280 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10285 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10291 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10296 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10300 cd write (2,*) iii,g_corr6_loc(iii)
10302 eello_turn6=ekont*eel_turn6
10303 cd write (2,*) 'ekont',ekont
10304 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10308 C-----------------------------------------------------------------------------
10309 double precision function scalar(u,v)
10310 !DIR$ INLINEALWAYS scalar
10312 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10315 double precision u(3),v(3)
10316 cd double precision sc
10324 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10327 crc-------------------------------------------------
10328 SUBROUTINE MATVEC2(A1,V1,V2)
10329 !DIR$ INLINEALWAYS MATVEC2
10331 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10333 implicit real*8 (a-h,o-z)
10334 include 'DIMENSIONS'
10335 DIMENSION A1(2,2),V1(2),V2(2)
10339 c 3 VI=VI+A1(I,K)*V1(K)
10343 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10344 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10349 C---------------------------------------
10350 SUBROUTINE MATMAT2(A1,A2,A3)
10352 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10354 implicit real*8 (a-h,o-z)
10355 include 'DIMENSIONS'
10356 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10357 c DIMENSION AI3(2,2)
10361 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10367 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10368 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10369 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10370 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10378 c-------------------------------------------------------------------------
10379 double precision function scalar2(u,v)
10380 !DIR$ INLINEALWAYS scalar2
10382 double precision u(2),v(2)
10383 double precision sc
10385 scalar2=u(1)*v(1)+u(2)*v(2)
10389 C-----------------------------------------------------------------------------
10391 subroutine transpose2(a,at)
10392 !DIR$ INLINEALWAYS transpose2
10394 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10397 double precision a(2,2),at(2,2)
10404 c--------------------------------------------------------------------------
10405 subroutine transpose(n,a,at)
10408 double precision a(n,n),at(n,n)
10416 C---------------------------------------------------------------------------
10417 subroutine prodmat3(a1,a2,kk,transp,prod)
10418 !DIR$ INLINEALWAYS prodmat3
10420 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10424 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10426 crc double precision auxmat(2,2),prod_(2,2)
10429 crc call transpose2(kk(1,1),auxmat(1,1))
10430 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10431 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10433 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10434 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10435 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10436 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10437 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10438 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10439 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10440 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10443 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10444 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10446 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10447 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10448 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10449 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10450 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10451 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10452 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10453 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10456 c call transpose2(a2(1,1),a2t(1,1))
10459 crc print *,((prod_(i,j),i=1,2),j=1,2)
10460 crc print *,((prod(i,j),i=1,2),j=1,2)
10464 CCC----------------------------------------------
10465 subroutine Eliptransfer(eliptran)
10466 implicit real*8 (a-h,o-z)
10467 include 'DIMENSIONS'
10468 include 'COMMON.GEO'
10469 include 'COMMON.VAR'
10470 include 'COMMON.LOCAL'
10471 include 'COMMON.CHAIN'
10472 include 'COMMON.DERIV'
10473 include 'COMMON.NAMES'
10474 include 'COMMON.INTERACT'
10475 include 'COMMON.IOUNITS'
10476 include 'COMMON.CALC'
10477 include 'COMMON.CONTROL'
10478 include 'COMMON.SPLITELE'
10479 include 'COMMON.SBRIDGE'
10480 C this is done by Adasko
10481 C print *,"wchodze"
10482 C structure of box:
10484 C--bordliptop-- buffore starts
10485 C--bufliptop--- here true lipid starts
10487 C--buflipbot--- lipid ends buffore starts
10488 C--bordlipbot--buffore ends
10490 do i=ilip_start,ilip_end
10492 if (itype(i).eq.ntyp1) cycle
10494 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10495 if (positi.le.0) positi=positi+boxzsize
10497 C first for peptide groups
10498 c for each residue check if it is in lipid or lipid water border area
10499 if ((positi.gt.bordlipbot)
10500 &.and.(positi.lt.bordliptop)) then
10501 C the energy transfer exist
10502 if (positi.lt.buflipbot) then
10503 C what fraction I am in
10505 & ((positi-bordlipbot)/lipbufthick)
10506 C lipbufthick is thickenes of lipid buffore
10507 sslip=sscalelip(fracinbuf)
10508 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10509 eliptran=eliptran+sslip*pepliptran
10510 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10511 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10512 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10514 C print *,"doing sccale for lower part"
10515 C print *,i,sslip,fracinbuf,ssgradlip
10516 elseif (positi.gt.bufliptop) then
10517 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10518 sslip=sscalelip(fracinbuf)
10519 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10520 eliptran=eliptran+sslip*pepliptran
10521 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10522 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10523 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10524 C print *, "doing sscalefor top part"
10525 C print *,i,sslip,fracinbuf,ssgradlip
10527 eliptran=eliptran+pepliptran
10528 C print *,"I am in true lipid"
10531 C eliptran=elpitran+0.0 ! I am in water
10534 C print *, "nic nie bylo w lipidzie?"
10535 C now multiply all by the peptide group transfer factor
10536 C eliptran=eliptran*pepliptran
10537 C now the same for side chains
10539 do i=ilip_start,ilip_end
10540 if (itype(i).eq.ntyp1) cycle
10541 positi=(mod(c(3,i+nres),boxzsize))
10542 if (positi.le.0) positi=positi+boxzsize
10543 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10544 c for each residue check if it is in lipid or lipid water border area
10545 C respos=mod(c(3,i+nres),boxzsize)
10546 C print *,positi,bordlipbot,buflipbot
10547 if ((positi.gt.bordlipbot)
10548 & .and.(positi.lt.bordliptop)) then
10549 C the energy transfer exist
10550 if (positi.lt.buflipbot) then
10552 & ((positi-bordlipbot)/lipbufthick)
10553 C lipbufthick is thickenes of lipid buffore
10554 sslip=sscalelip(fracinbuf)
10555 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10556 eliptran=eliptran+sslip*liptranene(itype(i))
10557 gliptranx(3,i)=gliptranx(3,i)
10558 &+ssgradlip*liptranene(itype(i))
10559 gliptranc(3,i-1)= gliptranc(3,i-1)
10560 &+ssgradlip*liptranene(itype(i))
10561 C print *,"doing sccale for lower part"
10562 elseif (positi.gt.bufliptop) then
10564 &((bordliptop-positi)/lipbufthick)
10565 sslip=sscalelip(fracinbuf)
10566 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10567 eliptran=eliptran+sslip*liptranene(itype(i))
10568 gliptranx(3,i)=gliptranx(3,i)
10569 &+ssgradlip*liptranene(itype(i))
10570 gliptranc(3,i-1)= gliptranc(3,i-1)
10571 &+ssgradlip*liptranene(itype(i))
10572 C print *, "doing sscalefor top part",sslip,fracinbuf
10574 eliptran=eliptran+liptranene(itype(i))
10575 C print *,"I am in true lipid"
10577 endif ! if in lipid or buffor
10579 C eliptran=elpitran+0.0 ! I am in water
10583 C---------------------------------------------------------
10584 C AFM soubroutine for constant force
10585 subroutine AFMforce(Eafmforce)
10586 implicit real*8 (a-h,o-z)
10587 include 'DIMENSIONS'
10588 include 'COMMON.GEO'
10589 include 'COMMON.VAR'
10590 include 'COMMON.LOCAL'
10591 include 'COMMON.CHAIN'
10592 include 'COMMON.DERIV'
10593 include 'COMMON.NAMES'
10594 include 'COMMON.INTERACT'
10595 include 'COMMON.IOUNITS'
10596 include 'COMMON.CALC'
10597 include 'COMMON.CONTROL'
10598 include 'COMMON.SPLITELE'
10599 include 'COMMON.SBRIDGE'
10604 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10605 dist=dist+diffafm(i)**2
10608 Eafmforce=-forceAFMconst*(dist-distafminit)
10610 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
10611 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
10613 C print *,'AFM',Eafmforce
10616 C---------------------------------------------------------
10617 C AFM subroutine with pseudoconstant velocity
10618 subroutine AFMvel(Eafmforce)
10619 implicit real*8 (a-h,o-z)
10620 include 'DIMENSIONS'
10621 include 'COMMON.GEO'
10622 include 'COMMON.VAR'
10623 include 'COMMON.LOCAL'
10624 include 'COMMON.CHAIN'
10625 include 'COMMON.DERIV'
10626 include 'COMMON.NAMES'
10627 include 'COMMON.INTERACT'
10628 include 'COMMON.IOUNITS'
10629 include 'COMMON.CALC'
10630 include 'COMMON.CONTROL'
10631 include 'COMMON.SPLITELE'
10632 include 'COMMON.SBRIDGE'
10634 C Only for check grad COMMENT if not used for checkgrad
10636 C--------------------------------------------------------
10637 C print *,"wchodze"
10641 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10642 dist=dist+diffafm(i)**2
10645 Eafmforce=0.5d0*forceAFMconst
10646 & *(distafminit+totTafm*velAFMconst-dist)**2
10647 C Eafmforce=-forceAFMconst*(dist-distafminit)
10649 gradafm(i,afmend-1)=-forceAFMconst*
10650 &(distafminit+totTafm*velAFMconst-dist)
10652 gradafm(i,afmbeg-1)=forceAFMconst*
10653 &(distafminit+totTafm*velAFMconst-dist)
10656 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
10659 C-----------------------------------------------------------
10660 C first for shielding is setting of function of side-chains
10661 subroutine set_shield_fac
10662 implicit real*8 (a-h,o-z)
10663 include 'DIMENSIONS'
10664 include 'COMMON.CHAIN'
10665 include 'COMMON.DERIV'
10666 include 'COMMON.IOUNITS'
10667 include 'COMMON.SHIELD'
10668 include 'COMMON.INTERACT'
10669 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10670 double precision div77_81/0.974996043d0/,
10671 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10673 C the vector between center of side_chain and peptide group
10674 double precision pep_side(3),long,side_calf(3),
10675 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10676 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10677 C the line belowe needs to be changed for FGPROC>1
10679 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10681 Cif there two consequtive dummy atoms there is no peptide group between them
10682 C the line below has to be changed for FGPROC>1
10685 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10689 C first lets set vector conecting the ithe side-chain with kth side-chain
10690 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10691 C pep_side(j)=2.0d0
10692 C and vector conecting the side-chain with its proper calfa
10693 side_calf(j)=c(j,k+nres)-c(j,k)
10694 C side_calf(j)=2.0d0
10695 pept_group(j)=c(j,i)-c(j,i+1)
10696 C lets have their lenght
10697 dist_pep_side=pep_side(j)**2+dist_pep_side
10698 dist_side_calf=dist_side_calf+side_calf(j)**2
10699 dist_pept_group=dist_pept_group+pept_group(j)**2
10701 dist_pep_side=dsqrt(dist_pep_side)
10702 dist_pept_group=dsqrt(dist_pept_group)
10703 dist_side_calf=dsqrt(dist_side_calf)
10705 pep_side_norm(j)=pep_side(j)/dist_pep_side
10706 side_calf_norm(j)=dist_side_calf
10708 C now sscale fraction
10709 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10710 C print *,buff_shield,"buff"
10712 if (sh_frac_dist.le.0.0) cycle
10713 C If we reach here it means that this side chain reaches the shielding sphere
10714 C Lets add him to the list for gradient
10715 ishield_list(i)=ishield_list(i)+1
10716 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10717 C this list is essential otherwise problem would be O3
10718 shield_list(ishield_list(i),i)=k
10719 C Lets have the sscale value
10720 if (sh_frac_dist.gt.1.0) then
10721 scale_fac_dist=1.0d0
10723 sh_frac_dist_grad(j)=0.0d0
10726 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10727 & *(2.0*sh_frac_dist-3.0d0)
10728 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
10729 & /dist_pep_side/buff_shield*0.5
10730 C remember for the final gradient multiply sh_frac_dist_grad(j)
10731 C for side_chain by factor -2 !
10733 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10734 C print *,"jestem",scale_fac_dist,fac_help_scale,
10735 C & sh_frac_dist_grad(j)
10738 C if ((i.eq.3).and.(k.eq.2)) then
10739 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
10743 C this is what is now we have the distance scaling now volume...
10744 short=short_r_sidechain(itype(k))
10745 long=long_r_sidechain(itype(k))
10746 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
10749 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
10750 C costhet_fac=0.0d0
10752 costhet_grad(j)=costhet_fac*pep_side(j)
10754 C remember for the final gradient multiply costhet_grad(j)
10755 C for side_chain by factor -2 !
10756 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10757 C pep_side0pept_group is vector multiplication
10758 pep_side0pept_group=0.0
10760 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10762 cosalfa=(pep_side0pept_group/
10763 & (dist_pep_side*dist_side_calf))
10764 fac_alfa_sin=1.0-cosalfa**2
10765 fac_alfa_sin=dsqrt(fac_alfa_sin)
10766 rkprim=fac_alfa_sin*(long-short)+short
10768 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
10769 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
10772 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10773 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10774 &*(long-short)/fac_alfa_sin*cosalfa/
10775 &((dist_pep_side*dist_side_calf))*
10776 &((side_calf(j))-cosalfa*
10777 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10779 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10780 &*(long-short)/fac_alfa_sin*cosalfa
10781 &/((dist_pep_side*dist_side_calf))*
10783 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10786 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
10788 C now the gradient...
10789 C grad_shield is gradient of Calfa for peptide groups
10791 grad_shield(j,i)=grad_shield(j,i)
10792 C gradient po skalowaniu
10793 & +(sh_frac_dist_grad(j)
10794 C gradient po costhet
10795 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
10796 &-scale_fac_dist*(cosphi_grad_long(j))
10797 &/(1.0-cosphi) )*div77_81
10799 C grad_shield_side is Cbeta sidechain gradient
10800 grad_shield_side(j,ishield_list(i),i)=
10801 & (sh_frac_dist_grad(j)*-2.0d0
10802 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
10803 & +scale_fac_dist*(cosphi_grad_long(j))
10804 & *2.0d0/(1.0-cosphi))
10805 & *div77_81*VofOverlap
10807 grad_shield_loc(j,ishield_list(i),i)=
10808 & scale_fac_dist*cosphi_grad_loc(j)
10809 & *2.0d0/(1.0-cosphi)
10810 & *div77_81*VofOverlap
10812 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10814 fac_shield(i)=VolumeTotal*div77_81+div4_81
10815 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)