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,2f8.3)') 'ees',i,j,eesij,
3732 &fac_shield(i),fac_shield(j)
3736 C Calculate contributions to the Cartesian gradient.
3739 facvdw=-6*rrmij*(ev1+evdwij)*sss
3740 facel=-3*rrmij*(el1+eesij)
3747 * Radial derivatives. First process both termini of the fragment (i,j)
3752 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3753 & (shield_mode.gt.0)) then
3755 do ilist=1,ishield_list(i)
3756 iresshield=shield_list(ilist,i)
3758 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
3759 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3761 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3762 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3763 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3764 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3765 C if (iresshield.gt.i) then
3766 C do ishi=i+1,iresshield-1
3767 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3768 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3772 C do ishi=iresshield,i
3773 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3774 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3780 do ilist=1,ishield_list(j)
3781 iresshield=shield_list(ilist,j)
3783 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
3784 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3786 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3787 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3789 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3790 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3791 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3792 C if (iresshield.gt.j) then
3793 C do ishi=j+1,iresshield-1
3794 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3795 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3799 C do ishi=iresshield,j
3800 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3801 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3808 gshieldc(k,i)=gshieldc(k,i)+
3809 & grad_shield(k,i)*eesij/fac_shield(i)
3810 gshieldc(k,j)=gshieldc(k,j)+
3811 & grad_shield(k,j)*eesij/fac_shield(j)
3812 gshieldc(k,i-1)=gshieldc(k,i-1)+
3813 & grad_shield(k,i)*eesij/fac_shield(i)
3814 gshieldc(k,j-1)=gshieldc(k,j-1)+
3815 & grad_shield(k,j)*eesij/fac_shield(j)
3820 c ghalf=0.5D0*ggg(k)
3821 c gelc(k,i)=gelc(k,i)+ghalf
3822 c gelc(k,j)=gelc(k,j)+ghalf
3824 c 9/28/08 AL Gradient compotents will be summed only at the end
3825 C print *,"before", gelc_long(1,i), gelc_long(1,j)
3827 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3828 C & +grad_shield(k,j)*eesij/fac_shield(j)
3829 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3830 C & +grad_shield(k,i)*eesij/fac_shield(i)
3831 C gelc_long(k,i-1)=gelc_long(k,i-1)
3832 C & +grad_shield(k,i)*eesij/fac_shield(i)
3833 C gelc_long(k,j-1)=gelc_long(k,j-1)
3834 C & +grad_shield(k,j)*eesij/fac_shield(j)
3836 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
3839 * Loop over residues i+1 thru j-1.
3843 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3846 if (sss.gt.0.0) then
3847 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3848 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3849 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3856 c ghalf=0.5D0*ggg(k)
3857 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3858 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3860 c 9/28/08 AL Gradient compotents will be summed only at the end
3862 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3863 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3866 * Loop over residues i+1 thru j-1.
3870 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3875 facvdw=(ev1+evdwij)*sss
3878 fac=-3*rrmij*(facvdw+facvdw+facel)
3883 * Radial derivatives. First process both termini of the fragment (i,j)
3886 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
3888 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
3890 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
3892 c ghalf=0.5D0*ggg(k)
3893 c gelc(k,i)=gelc(k,i)+ghalf
3894 c gelc(k,j)=gelc(k,j)+ghalf
3896 c 9/28/08 AL Gradient compotents will be summed only at the end
3898 gelc_long(k,j)=gelc(k,j)+ggg(k)
3899 gelc_long(k,i)=gelc(k,i)-ggg(k)
3902 * Loop over residues i+1 thru j-1.
3906 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3909 c 9/28/08 AL Gradient compotents will be summed only at the end
3910 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3911 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3912 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3914 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3915 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3921 ecosa=2.0D0*fac3*fac1+fac4
3924 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3925 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3927 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3928 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3930 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3931 cd & (dcosg(k),k=1,3)
3933 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
3934 & fac_shield(i)*fac_shield(j)
3937 c ghalf=0.5D0*ggg(k)
3938 c gelc(k,i)=gelc(k,i)+ghalf
3939 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3940 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3941 c gelc(k,j)=gelc(k,j)+ghalf
3942 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3943 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3947 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3950 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
3953 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3954 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
3955 & *fac_shield(i)*fac_shield(j)
3957 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3958 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
3959 & *fac_shield(i)*fac_shield(j)
3960 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3961 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3963 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
3967 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3968 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3969 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3971 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3972 C energy of a peptide unit is assumed in the form of a second-order
3973 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3974 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3975 C are computed for EVERY pair of non-contiguous peptide groups.
3978 if (j.lt.nres-1) then
3990 muij(kkk)=mu(k,i)*mu(l,j)
3991 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3993 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3994 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3995 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3996 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3997 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3998 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4002 cd write (iout,*) 'EELEC: i',i,' j',j
4003 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
4004 cd write(iout,*) 'muij',muij
4005 ury=scalar(uy(1,i),erij)
4006 urz=scalar(uz(1,i),erij)
4007 vry=scalar(uy(1,j),erij)
4008 vrz=scalar(uz(1,j),erij)
4009 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4010 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4011 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4012 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4013 fac=dsqrt(-ael6i)*r3ij
4018 cd write (iout,'(4i5,4f10.5)')
4019 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
4020 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4021 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4022 cd & uy(:,j),uz(:,j)
4023 cd write (iout,'(4f10.5)')
4024 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4025 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4026 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
4027 cd write (iout,'(9f10.5/)')
4028 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4029 C Derivatives of the elements of A in virtual-bond vectors
4030 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4032 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4033 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4034 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4035 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4036 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4037 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4038 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4039 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4040 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4041 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4042 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4043 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4045 C Compute radial contributions to the gradient
4063 C Add the contributions coming from er
4066 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4067 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4068 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4069 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4072 C Derivatives in DC(i)
4073 cgrad ghalf1=0.5d0*agg(k,1)
4074 cgrad ghalf2=0.5d0*agg(k,2)
4075 cgrad ghalf3=0.5d0*agg(k,3)
4076 cgrad ghalf4=0.5d0*agg(k,4)
4077 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
4078 & -3.0d0*uryg(k,2)*vry)!+ghalf1
4079 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
4080 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
4081 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
4082 & -3.0d0*urzg(k,2)*vry)!+ghalf3
4083 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
4084 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
4085 C Derivatives in DC(i+1)
4086 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
4087 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4088 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
4089 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4090 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
4091 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4092 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
4093 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4094 C Derivatives in DC(j)
4095 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
4096 & -3.0d0*vryg(k,2)*ury)!+ghalf1
4097 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4098 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4099 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4100 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4101 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4102 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4103 C Derivatives in DC(j+1) or DC(nres-1)
4104 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4105 & -3.0d0*vryg(k,3)*ury)
4106 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4107 & -3.0d0*vrzg(k,3)*ury)
4108 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4109 & -3.0d0*vryg(k,3)*urz)
4110 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4111 & -3.0d0*vrzg(k,3)*urz)
4112 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4114 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4127 aggi(k,l)=-aggi(k,l)
4128 aggi1(k,l)=-aggi1(k,l)
4129 aggj(k,l)=-aggj(k,l)
4130 aggj1(k,l)=-aggj1(k,l)
4133 if (j.lt.nres-1) then
4139 aggi(k,l)=-aggi(k,l)
4140 aggi1(k,l)=-aggi1(k,l)
4141 aggj(k,l)=-aggj(k,l)
4142 aggj1(k,l)=-aggj1(k,l)
4153 aggi(k,l)=-aggi(k,l)
4154 aggi1(k,l)=-aggi1(k,l)
4155 aggj(k,l)=-aggj(k,l)
4156 aggj1(k,l)=-aggj1(k,l)
4161 IF (wel_loc.gt.0.0d0) THEN
4162 C Contribution to the local-electrostatic energy coming from the i-j pair
4163 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4165 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4166 c & ' eel_loc_ij',eel_loc_ij
4167 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4168 C Calculate patrial derivative for theta angle
4170 geel_loc_ij=a22*gmuij1(1)
4174 c write(iout,*) "derivative over thatai"
4175 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4177 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4178 & geel_loc_ij*wel_loc
4179 c write(iout,*) "derivative over thatai-1"
4180 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4187 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4188 & geel_loc_ij*wel_loc
4189 c Derivative over j residue
4190 geel_loc_ji=a22*gmuji1(1)
4194 c write(iout,*) "derivative over thataj"
4195 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4198 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4199 & geel_loc_ji*wel_loc
4205 c write(iout,*) "derivative over thataj-1"
4206 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4208 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4209 & geel_loc_ji*wel_loc
4211 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4213 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4214 & 'eelloc',i,j,eel_loc_ij
4215 c if (eel_loc_ij.ne.0)
4216 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4217 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4219 eel_loc=eel_loc+eel_loc_ij
4220 C Partial derivatives in virtual-bond dihedral angles gamma
4222 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4223 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4224 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
4225 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4226 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4227 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
4228 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4230 ggg(l)=agg(l,1)*muij(1)+
4231 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
4232 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4233 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4234 cgrad ghalf=0.5d0*ggg(l)
4235 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4236 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4240 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4243 C Remaining derivatives of eello
4245 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4246 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4247 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4248 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4249 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4250 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4251 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4252 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4255 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4256 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4257 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4258 & .and. num_conti.le.maxconts) then
4259 c write (iout,*) i,j," entered corr"
4261 C Calculate the contact function. The ith column of the array JCONT will
4262 C contain the numbers of atoms that make contacts with the atom I (of numbers
4263 C greater than I). The arrays FACONT and GACONT will contain the values of
4264 C the contact function and its derivative.
4265 c r0ij=1.02D0*rpp(iteli,itelj)
4266 c r0ij=1.11D0*rpp(iteli,itelj)
4267 r0ij=2.20D0*rpp(iteli,itelj)
4268 c r0ij=1.55D0*rpp(iteli,itelj)
4269 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4270 if (fcont.gt.0.0D0) then
4271 num_conti=num_conti+1
4272 if (num_conti.gt.maxconts) then
4273 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4274 & ' will skip next contacts for this conf.'
4276 jcont_hb(num_conti,i)=j
4277 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4278 cd & " jcont_hb",jcont_hb(num_conti,i)
4279 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4280 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4281 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4283 d_cont(num_conti,i)=rij
4284 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4285 C --- Electrostatic-interaction matrix ---
4286 a_chuj(1,1,num_conti,i)=a22
4287 a_chuj(1,2,num_conti,i)=a23
4288 a_chuj(2,1,num_conti,i)=a32
4289 a_chuj(2,2,num_conti,i)=a33
4290 C --- Gradient of rij
4292 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4299 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4300 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4301 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4302 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4303 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4308 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4309 C Calculate contact energies
4311 wij=cosa-3.0D0*cosb*cosg
4314 c fac3=dsqrt(-ael6i)/r0ij**3
4315 fac3=dsqrt(-ael6i)*r3ij
4316 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4317 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4318 if (ees0tmp.gt.0) then
4319 ees0pij=dsqrt(ees0tmp)
4323 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4324 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4325 if (ees0tmp.gt.0) then
4326 ees0mij=dsqrt(ees0tmp)
4331 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4332 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4333 C Diagnostics. Comment out or remove after debugging!
4334 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4335 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4336 c ees0m(num_conti,i)=0.0D0
4338 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4339 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4340 C Angular derivatives of the contact function
4341 ees0pij1=fac3/ees0pij
4342 ees0mij1=fac3/ees0mij
4343 fac3p=-3.0D0*fac3*rrmij
4344 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4345 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4347 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4348 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4349 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4350 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4351 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4352 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4353 ecosap=ecosa1+ecosa2
4354 ecosbp=ecosb1+ecosb2
4355 ecosgp=ecosg1+ecosg2
4356 ecosam=ecosa1-ecosa2
4357 ecosbm=ecosb1-ecosb2
4358 ecosgm=ecosg1-ecosg2
4367 facont_hb(num_conti,i)=fcont
4368 fprimcont=fprimcont/rij
4369 cd facont_hb(num_conti,i)=1.0D0
4370 C Following line is for diagnostics.
4373 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4374 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4377 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4378 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4380 gggp(1)=gggp(1)+ees0pijp*xj
4381 gggp(2)=gggp(2)+ees0pijp*yj
4382 gggp(3)=gggp(3)+ees0pijp*zj
4383 gggm(1)=gggm(1)+ees0mijp*xj
4384 gggm(2)=gggm(2)+ees0mijp*yj
4385 gggm(3)=gggm(3)+ees0mijp*zj
4386 C Derivatives due to the contact function
4387 gacont_hbr(1,num_conti,i)=fprimcont*xj
4388 gacont_hbr(2,num_conti,i)=fprimcont*yj
4389 gacont_hbr(3,num_conti,i)=fprimcont*zj
4392 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4393 c following the change of gradient-summation algorithm.
4395 cgrad ghalfp=0.5D0*gggp(k)
4396 cgrad ghalfm=0.5D0*gggm(k)
4397 gacontp_hb1(k,num_conti,i)=!ghalfp
4398 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4399 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4400 gacontp_hb2(k,num_conti,i)=!ghalfp
4401 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4402 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4403 gacontp_hb3(k,num_conti,i)=gggp(k)
4404 gacontm_hb1(k,num_conti,i)=!ghalfm
4405 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4406 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4407 gacontm_hb2(k,num_conti,i)=!ghalfm
4408 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4409 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4410 gacontm_hb3(k,num_conti,i)=gggm(k)
4412 C Diagnostics. Comment out or remove after debugging!
4414 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4415 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4416 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4417 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4418 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4419 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4422 endif ! num_conti.le.maxconts
4425 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4428 ghalf=0.5d0*agg(l,k)
4429 aggi(l,k)=aggi(l,k)+ghalf
4430 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4431 aggj(l,k)=aggj(l,k)+ghalf
4434 if (j.eq.nres-1 .and. i.lt.j-2) then
4437 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4442 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4445 C-----------------------------------------------------------------------------
4446 subroutine eturn3(i,eello_turn3)
4447 C Third- and fourth-order contributions from turns
4448 implicit real*8 (a-h,o-z)
4449 include 'DIMENSIONS'
4450 include 'COMMON.IOUNITS'
4451 include 'COMMON.GEO'
4452 include 'COMMON.VAR'
4453 include 'COMMON.LOCAL'
4454 include 'COMMON.CHAIN'
4455 include 'COMMON.DERIV'
4456 include 'COMMON.INTERACT'
4457 include 'COMMON.CONTACTS'
4458 include 'COMMON.TORSION'
4459 include 'COMMON.VECTORS'
4460 include 'COMMON.FFIELD'
4461 include 'COMMON.CONTROL'
4463 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4464 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4465 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4466 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4467 & auxgmat2(2,2),auxgmatt2(2,2)
4468 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4469 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4470 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4471 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4474 c write (iout,*) "eturn3",i,j,j1,j2
4479 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4481 C Third-order contributions
4488 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4489 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4490 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4491 c auxalary matices for theta gradient
4492 c auxalary matrix for i+1 and constant i+2
4493 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4494 c auxalary matrix for i+2 and constant i+1
4495 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4496 call transpose2(auxmat(1,1),auxmat1(1,1))
4497 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4498 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4499 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4500 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4501 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4502 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4503 C Derivatives in theta
4504 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4505 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4506 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4507 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4509 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4510 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4511 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4512 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4513 cd & ' eello_turn3_num',4*eello_turn3_num
4514 C Derivatives in gamma(i)
4515 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4516 call transpose2(auxmat2(1,1),auxmat3(1,1))
4517 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4518 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4519 C Derivatives in gamma(i+1)
4520 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4521 call transpose2(auxmat2(1,1),auxmat3(1,1))
4522 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4523 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4524 & +0.5d0*(pizda(1,1)+pizda(2,2))
4525 C Cartesian derivatives
4527 c ghalf1=0.5d0*agg(l,1)
4528 c ghalf2=0.5d0*agg(l,2)
4529 c ghalf3=0.5d0*agg(l,3)
4530 c ghalf4=0.5d0*agg(l,4)
4531 a_temp(1,1)=aggi(l,1)!+ghalf1
4532 a_temp(1,2)=aggi(l,2)!+ghalf2
4533 a_temp(2,1)=aggi(l,3)!+ghalf3
4534 a_temp(2,2)=aggi(l,4)!+ghalf4
4535 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4536 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4537 & +0.5d0*(pizda(1,1)+pizda(2,2))
4538 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4539 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4540 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4541 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4542 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4543 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4544 & +0.5d0*(pizda(1,1)+pizda(2,2))
4545 a_temp(1,1)=aggj(l,1)!+ghalf1
4546 a_temp(1,2)=aggj(l,2)!+ghalf2
4547 a_temp(2,1)=aggj(l,3)!+ghalf3
4548 a_temp(2,2)=aggj(l,4)!+ghalf4
4549 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4550 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4551 & +0.5d0*(pizda(1,1)+pizda(2,2))
4552 a_temp(1,1)=aggj1(l,1)
4553 a_temp(1,2)=aggj1(l,2)
4554 a_temp(2,1)=aggj1(l,3)
4555 a_temp(2,2)=aggj1(l,4)
4556 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4557 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4558 & +0.5d0*(pizda(1,1)+pizda(2,2))
4562 C-------------------------------------------------------------------------------
4563 subroutine eturn4(i,eello_turn4)
4564 C Third- and fourth-order contributions from turns
4565 implicit real*8 (a-h,o-z)
4566 include 'DIMENSIONS'
4567 include 'COMMON.IOUNITS'
4568 include 'COMMON.GEO'
4569 include 'COMMON.VAR'
4570 include 'COMMON.LOCAL'
4571 include 'COMMON.CHAIN'
4572 include 'COMMON.DERIV'
4573 include 'COMMON.INTERACT'
4574 include 'COMMON.CONTACTS'
4575 include 'COMMON.TORSION'
4576 include 'COMMON.VECTORS'
4577 include 'COMMON.FFIELD'
4578 include 'COMMON.CONTROL'
4580 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4581 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4582 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4583 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4584 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4585 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4586 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4587 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4588 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4589 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4590 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4593 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4595 C Fourth-order contributions
4603 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4604 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4605 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4606 c write(iout,*)"WCHODZE W PROGRAM"
4611 iti1=itortyp(itype(i+1))
4612 iti2=itortyp(itype(i+2))
4613 iti3=itortyp(itype(i+3))
4614 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4615 call transpose2(EUg(1,1,i+1),e1t(1,1))
4616 call transpose2(Eug(1,1,i+2),e2t(1,1))
4617 call transpose2(Eug(1,1,i+3),e3t(1,1))
4618 C Ematrix derivative in theta
4619 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4620 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4621 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4622 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4623 c eta1 in derivative theta
4624 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4625 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4626 c auxgvec is derivative of Ub2 so i+3 theta
4627 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4628 c auxalary matrix of E i+1
4629 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4632 s1=scalar2(b1(1,i+2),auxvec(1))
4633 c derivative of theta i+2 with constant i+3
4634 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4635 c derivative of theta i+2 with constant i+2
4636 gs32=scalar2(b1(1,i+2),auxgvec(1))
4637 c derivative of E matix in theta of i+1
4638 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4640 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4641 c ea31 in derivative theta
4642 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4643 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4644 c auxilary matrix auxgvec of Ub2 with constant E matirx
4645 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4646 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4647 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4651 s2=scalar2(b1(1,i+1),auxvec(1))
4652 c derivative of theta i+1 with constant i+3
4653 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4654 c derivative of theta i+2 with constant i+1
4655 gs21=scalar2(b1(1,i+1),auxgvec(1))
4656 c derivative of theta i+3 with constant i+1
4657 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4658 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4660 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4661 c two derivatives over diffetent matrices
4662 c gtae3e2 is derivative over i+3
4663 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4664 c ae3gte2 is derivative over i+2
4665 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4666 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4667 c three possible derivative over theta E matices
4669 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4671 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4673 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4674 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4676 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4677 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4678 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4680 eello_turn4=eello_turn4-(s1+s2+s3)
4681 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4682 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4683 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4684 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4685 cd & ' eello_turn4_num',8*eello_turn4_num
4687 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4688 & -(gs13+gsE13+gsEE1)*wturn4
4689 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4690 & -(gs23+gs21+gsEE2)*wturn4
4691 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4692 & -(gs32+gsE31+gsEE3)*wturn4
4693 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4696 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4697 & 'eturn4',i,j,-(s1+s2+s3)
4698 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4699 c & ' eello_turn4_num',8*eello_turn4_num
4700 C Derivatives in gamma(i)
4701 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4702 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4703 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4704 s1=scalar2(b1(1,i+2),auxvec(1))
4705 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4706 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4707 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4708 C Derivatives in gamma(i+1)
4709 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4710 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4711 s2=scalar2(b1(1,i+1),auxvec(1))
4712 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4713 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4714 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4715 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4716 C Derivatives in gamma(i+2)
4717 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4718 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4719 s1=scalar2(b1(1,i+2),auxvec(1))
4720 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4721 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4722 s2=scalar2(b1(1,i+1),auxvec(1))
4723 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4724 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4725 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4726 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4727 C Cartesian derivatives
4728 C Derivatives of this turn contributions in DC(i+2)
4729 if (j.lt.nres-1) then
4731 a_temp(1,1)=agg(l,1)
4732 a_temp(1,2)=agg(l,2)
4733 a_temp(2,1)=agg(l,3)
4734 a_temp(2,2)=agg(l,4)
4735 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4736 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4737 s1=scalar2(b1(1,i+2),auxvec(1))
4738 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4739 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4740 s2=scalar2(b1(1,i+1),auxvec(1))
4741 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4742 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4743 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4745 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4748 C Remaining derivatives of this turn contribution
4750 a_temp(1,1)=aggi(l,1)
4751 a_temp(1,2)=aggi(l,2)
4752 a_temp(2,1)=aggi(l,3)
4753 a_temp(2,2)=aggi(l,4)
4754 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4755 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4756 s1=scalar2(b1(1,i+2),auxvec(1))
4757 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4758 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4759 s2=scalar2(b1(1,i+1),auxvec(1))
4760 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4761 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4762 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4763 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4764 a_temp(1,1)=aggi1(l,1)
4765 a_temp(1,2)=aggi1(l,2)
4766 a_temp(2,1)=aggi1(l,3)
4767 a_temp(2,2)=aggi1(l,4)
4768 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4769 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4770 s1=scalar2(b1(1,i+2),auxvec(1))
4771 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4772 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4773 s2=scalar2(b1(1,i+1),auxvec(1))
4774 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4775 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4776 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4777 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4778 a_temp(1,1)=aggj(l,1)
4779 a_temp(1,2)=aggj(l,2)
4780 a_temp(2,1)=aggj(l,3)
4781 a_temp(2,2)=aggj(l,4)
4782 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4783 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4784 s1=scalar2(b1(1,i+2),auxvec(1))
4785 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4786 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4787 s2=scalar2(b1(1,i+1),auxvec(1))
4788 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4789 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4790 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4791 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4792 a_temp(1,1)=aggj1(l,1)
4793 a_temp(1,2)=aggj1(l,2)
4794 a_temp(2,1)=aggj1(l,3)
4795 a_temp(2,2)=aggj1(l,4)
4796 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4797 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4798 s1=scalar2(b1(1,i+2),auxvec(1))
4799 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4800 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4801 s2=scalar2(b1(1,i+1),auxvec(1))
4802 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4803 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4804 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4805 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4806 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4810 C-----------------------------------------------------------------------------
4811 subroutine vecpr(u,v,w)
4812 implicit real*8(a-h,o-z)
4813 dimension u(3),v(3),w(3)
4814 w(1)=u(2)*v(3)-u(3)*v(2)
4815 w(2)=-u(1)*v(3)+u(3)*v(1)
4816 w(3)=u(1)*v(2)-u(2)*v(1)
4819 C-----------------------------------------------------------------------------
4820 subroutine unormderiv(u,ugrad,unorm,ungrad)
4821 C This subroutine computes the derivatives of a normalized vector u, given
4822 C the derivatives computed without normalization conditions, ugrad. Returns
4825 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4826 double precision vec(3)
4827 double precision scalar
4829 c write (2,*) 'ugrad',ugrad
4832 vec(i)=scalar(ugrad(1,i),u(1))
4834 c write (2,*) 'vec',vec
4837 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4840 c write (2,*) 'ungrad',ungrad
4843 C-----------------------------------------------------------------------------
4844 subroutine escp_soft_sphere(evdw2,evdw2_14)
4846 C This subroutine calculates the excluded-volume interaction energy between
4847 C peptide-group centers and side chains and its gradient in virtual-bond and
4848 C side-chain vectors.
4850 implicit real*8 (a-h,o-z)
4851 include 'DIMENSIONS'
4852 include 'COMMON.GEO'
4853 include 'COMMON.VAR'
4854 include 'COMMON.LOCAL'
4855 include 'COMMON.CHAIN'
4856 include 'COMMON.DERIV'
4857 include 'COMMON.INTERACT'
4858 include 'COMMON.FFIELD'
4859 include 'COMMON.IOUNITS'
4860 include 'COMMON.CONTROL'
4865 cd print '(a)','Enter ESCP'
4866 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4870 do i=iatscp_s,iatscp_e
4871 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4873 xi=0.5D0*(c(1,i)+c(1,i+1))
4874 yi=0.5D0*(c(2,i)+c(2,i+1))
4875 zi=0.5D0*(c(3,i)+c(3,i+1))
4876 C Return atom into box, boxxsize is size of box in x dimension
4878 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4879 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4880 C Condition for being inside the proper box
4881 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4882 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4886 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4887 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4888 C Condition for being inside the proper box
4889 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4890 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4894 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4895 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4896 cC Condition for being inside the proper box
4897 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4898 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4902 if (xi.lt.0) xi=xi+boxxsize
4904 if (yi.lt.0) yi=yi+boxysize
4906 if (zi.lt.0) zi=zi+boxzsize
4907 C xi=xi+xshift*boxxsize
4908 C yi=yi+yshift*boxysize
4909 C zi=zi+zshift*boxzsize
4910 do iint=1,nscp_gr(i)
4912 do j=iscpstart(i,iint),iscpend(i,iint)
4913 if (itype(j).eq.ntyp1) cycle
4914 itypj=iabs(itype(j))
4915 C Uncomment following three lines for SC-p interactions
4919 C Uncomment following three lines for Ca-p interactions
4924 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4925 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4926 C Condition for being inside the proper box
4927 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4928 c & (xj.lt.((-0.5d0)*boxxsize))) then
4932 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4933 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4934 cC Condition for being inside the proper box
4935 c if ((yj.gt.((0.5d0)*boxysize)).or.
4936 c & (yj.lt.((-0.5d0)*boxysize))) then
4940 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4941 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4942 C Condition for being inside the proper box
4943 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4944 c & (zj.lt.((-0.5d0)*boxzsize))) then
4947 if (xj.lt.0) xj=xj+boxxsize
4949 if (yj.lt.0) yj=yj+boxysize
4951 if (zj.lt.0) zj=zj+boxzsize
4952 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4960 xj=xj_safe+xshift*boxxsize
4961 yj=yj_safe+yshift*boxysize
4962 zj=zj_safe+zshift*boxzsize
4963 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4964 if(dist_temp.lt.dist_init) then
4974 if (subchap.eq.1) then
4987 rij=xj*xj+yj*yj+zj*zj
4991 if (rij.lt.r0ijsq) then
4992 evdwij=0.25d0*(rij-r0ijsq)**2
5000 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5005 cgrad if (j.lt.i) then
5006 cd write (iout,*) 'j<i'
5007 C Uncomment following three lines for SC-p interactions
5009 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5012 cd write (iout,*) 'j>i'
5014 cgrad ggg(k)=-ggg(k)
5015 C Uncomment following line for SC-p interactions
5016 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5020 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5022 cgrad kstart=min0(i+1,j)
5023 cgrad kend=max0(i-1,j-1)
5024 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5025 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5026 cgrad do k=kstart,kend
5028 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5032 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5033 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5044 C-----------------------------------------------------------------------------
5045 subroutine escp(evdw2,evdw2_14)
5047 C This subroutine calculates the excluded-volume interaction energy between
5048 C peptide-group centers and side chains and its gradient in virtual-bond and
5049 C side-chain vectors.
5051 implicit real*8 (a-h,o-z)
5052 include 'DIMENSIONS'
5053 include 'COMMON.GEO'
5054 include 'COMMON.VAR'
5055 include 'COMMON.LOCAL'
5056 include 'COMMON.CHAIN'
5057 include 'COMMON.DERIV'
5058 include 'COMMON.INTERACT'
5059 include 'COMMON.FFIELD'
5060 include 'COMMON.IOUNITS'
5061 include 'COMMON.CONTROL'
5062 include 'COMMON.SPLITELE'
5066 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
5067 cd print '(a)','Enter ESCP'
5068 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5072 do i=iatscp_s,iatscp_e
5073 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5075 xi=0.5D0*(c(1,i)+c(1,i+1))
5076 yi=0.5D0*(c(2,i)+c(2,i+1))
5077 zi=0.5D0*(c(3,i)+c(3,i+1))
5079 if (xi.lt.0) xi=xi+boxxsize
5081 if (yi.lt.0) yi=yi+boxysize
5083 if (zi.lt.0) zi=zi+boxzsize
5084 c xi=xi+xshift*boxxsize
5085 c yi=yi+yshift*boxysize
5086 c zi=zi+zshift*boxzsize
5087 c print *,xi,yi,zi,'polozenie i'
5088 C Return atom into box, boxxsize is size of box in x dimension
5090 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5091 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5092 C Condition for being inside the proper box
5093 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5094 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5098 c print *,xi,boxxsize,"pierwszy"
5100 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5101 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5102 C Condition for being inside the proper box
5103 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5104 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5108 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5109 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5110 C Condition for being inside the proper box
5111 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5112 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5115 do iint=1,nscp_gr(i)
5117 do j=iscpstart(i,iint),iscpend(i,iint)
5118 itypj=iabs(itype(j))
5119 if (itypj.eq.ntyp1) cycle
5120 C Uncomment following three lines for SC-p interactions
5124 C Uncomment following three lines for Ca-p interactions
5129 if (xj.lt.0) xj=xj+boxxsize
5131 if (yj.lt.0) yj=yj+boxysize
5133 if (zj.lt.0) zj=zj+boxzsize
5135 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5136 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5137 C Condition for being inside the proper box
5138 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5139 c & (xj.lt.((-0.5d0)*boxxsize))) then
5143 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5144 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5145 cC Condition for being inside the proper box
5146 c if ((yj.gt.((0.5d0)*boxysize)).or.
5147 c & (yj.lt.((-0.5d0)*boxysize))) then
5151 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5152 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5153 C Condition for being inside the proper box
5154 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5155 c & (zj.lt.((-0.5d0)*boxzsize))) then
5158 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5159 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5167 xj=xj_safe+xshift*boxxsize
5168 yj=yj_safe+yshift*boxysize
5169 zj=zj_safe+zshift*boxzsize
5170 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5171 if(dist_temp.lt.dist_init) then
5181 if (subchap.eq.1) then
5190 c print *,xj,yj,zj,'polozenie j'
5191 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5193 sss=sscale(1.0d0/(dsqrt(rrij)))
5194 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5195 c if (sss.eq.0) print *,'czasem jest OK'
5196 if (sss.le.0.0d0) cycle
5197 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5199 e1=fac*fac*aad(itypj,iteli)
5200 e2=fac*bad(itypj,iteli)
5201 if (iabs(j-i) .le. 2) then
5204 evdw2_14=evdw2_14+(e1+e2)*sss
5207 evdw2=evdw2+evdwij*sss
5208 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5209 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5212 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5214 fac=-(evdwij+e1)*rrij*sss
5215 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5219 cgrad if (j.lt.i) then
5220 cd write (iout,*) 'j<i'
5221 C Uncomment following three lines for SC-p interactions
5223 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5226 cd write (iout,*) 'j>i'
5228 cgrad ggg(k)=-ggg(k)
5229 C Uncomment following line for SC-p interactions
5230 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5231 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5235 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5237 cgrad kstart=min0(i+1,j)
5238 cgrad kend=max0(i-1,j-1)
5239 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5240 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5241 cgrad do k=kstart,kend
5243 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5247 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5248 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5250 c endif !endif for sscale cutoff
5260 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5261 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5262 gradx_scp(j,i)=expon*gradx_scp(j,i)
5265 C******************************************************************************
5269 C To save time the factor EXPON has been extracted from ALL components
5270 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5273 C******************************************************************************
5276 C--------------------------------------------------------------------------
5277 subroutine edis(ehpb)
5279 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5281 implicit real*8 (a-h,o-z)
5282 include 'DIMENSIONS'
5283 include 'COMMON.SBRIDGE'
5284 include 'COMMON.CHAIN'
5285 include 'COMMON.DERIV'
5286 include 'COMMON.VAR'
5287 include 'COMMON.INTERACT'
5288 include 'COMMON.IOUNITS'
5289 include 'COMMON.CONTROL'
5295 C write (iout,*) ,"link_end",link_end,constr_dist
5296 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5297 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5298 if (link_end.eq.0) return
5299 do i=link_start,link_end
5300 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5301 C CA-CA distance used in regularization of structure.
5304 C iii and jjj point to the residues for which the distance is assigned.
5305 if (ii.gt.nres) then
5312 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5313 c & dhpb(i),dhpb1(i),forcon(i)
5314 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5315 C distance and angle dependent SS bond potential.
5316 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5317 C & iabs(itype(jjj)).eq.1) then
5318 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5319 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5320 if (.not.dyn_ss .and. i.le.nss) then
5321 C 15/02/13 CC dynamic SSbond - additional check
5322 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5323 & iabs(itype(jjj)).eq.1) then
5324 call ssbond_ene(iii,jjj,eij)
5327 cd write (iout,*) "eij",eij
5328 cd & ' waga=',waga,' fac=',fac
5329 else if (ii.gt.nres .and. jj.gt.nres) then
5330 c Restraints from contact prediction
5332 if (constr_dist.eq.11) then
5333 ehpb=ehpb+fordepth(i)**4.0d0
5334 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5335 fac=fordepth(i)**4.0d0
5336 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5337 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5338 & ehpb,fordepth(i),dd
5340 if (dhpb1(i).gt.0.0d0) then
5341 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5342 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5343 c write (iout,*) "beta nmr",
5344 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5348 C Get the force constant corresponding to this distance.
5350 C Calculate the contribution to energy.
5351 ehpb=ehpb+waga*rdis*rdis
5352 c write (iout,*) "beta reg",dd,waga*rdis*rdis
5354 C Evaluate gradient.
5360 ggg(j)=fac*(c(j,jj)-c(j,ii))
5363 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5364 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5367 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5368 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5371 C Calculate the distance between the two points and its difference from the
5374 if (constr_dist.eq.11) then
5375 ehpb=ehpb+fordepth(i)**4.0d0
5376 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5377 fac=fordepth(i)**4.0d0
5378 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5379 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5380 & ehpb,fordepth(i),dd
5382 if (dhpb1(i).gt.0.0d0) then
5383 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5384 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5385 c write (iout,*) "alph nmr",
5386 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5389 C Get the force constant corresponding to this distance.
5391 C Calculate the contribution to energy.
5392 ehpb=ehpb+waga*rdis*rdis
5393 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5395 C Evaluate gradient.
5401 ggg(j)=fac*(c(j,jj)-c(j,ii))
5403 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5404 C If this is a SC-SC distance, we need to calculate the contributions to the
5405 C Cartesian gradient in the SC vectors (ghpbx).
5408 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5409 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5412 cgrad do j=iii,jjj-1
5414 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5418 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5419 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5423 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5426 C--------------------------------------------------------------------------
5427 subroutine ssbond_ene(i,j,eij)
5429 C Calculate the distance and angle dependent SS-bond potential energy
5430 C using a free-energy function derived based on RHF/6-31G** ab initio
5431 C calculations of diethyl disulfide.
5433 C A. Liwo and U. Kozlowska, 11/24/03
5435 implicit real*8 (a-h,o-z)
5436 include 'DIMENSIONS'
5437 include 'COMMON.SBRIDGE'
5438 include 'COMMON.CHAIN'
5439 include 'COMMON.DERIV'
5440 include 'COMMON.LOCAL'
5441 include 'COMMON.INTERACT'
5442 include 'COMMON.VAR'
5443 include 'COMMON.IOUNITS'
5444 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5445 itypi=iabs(itype(i))
5449 dxi=dc_norm(1,nres+i)
5450 dyi=dc_norm(2,nres+i)
5451 dzi=dc_norm(3,nres+i)
5452 c dsci_inv=dsc_inv(itypi)
5453 dsci_inv=vbld_inv(nres+i)
5454 itypj=iabs(itype(j))
5455 c dscj_inv=dsc_inv(itypj)
5456 dscj_inv=vbld_inv(nres+j)
5460 dxj=dc_norm(1,nres+j)
5461 dyj=dc_norm(2,nres+j)
5462 dzj=dc_norm(3,nres+j)
5463 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5468 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5469 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5470 om12=dxi*dxj+dyi*dyj+dzi*dzj
5472 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5473 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5479 deltat12=om2-om1+2.0d0
5481 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5482 & +akct*deltad*deltat12
5483 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5484 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5485 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5486 c & " deltat12",deltat12," eij",eij
5487 ed=2*akcm*deltad+akct*deltat12
5489 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5490 eom1=-2*akth*deltat1-pom1-om2*pom2
5491 eom2= 2*akth*deltat2+pom1-om1*pom2
5494 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5495 ghpbx(k,i)=ghpbx(k,i)-ggk
5496 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5497 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5498 ghpbx(k,j)=ghpbx(k,j)+ggk
5499 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5500 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5501 ghpbc(k,i)=ghpbc(k,i)-ggk
5502 ghpbc(k,j)=ghpbc(k,j)+ggk
5505 C Calculate the components of the gradient in DC and X
5509 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5514 C--------------------------------------------------------------------------
5515 subroutine ebond(estr)
5517 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5519 implicit real*8 (a-h,o-z)
5520 include 'DIMENSIONS'
5521 include 'COMMON.LOCAL'
5522 include 'COMMON.GEO'
5523 include 'COMMON.INTERACT'
5524 include 'COMMON.DERIV'
5525 include 'COMMON.VAR'
5526 include 'COMMON.CHAIN'
5527 include 'COMMON.IOUNITS'
5528 include 'COMMON.NAMES'
5529 include 'COMMON.FFIELD'
5530 include 'COMMON.CONTROL'
5531 include 'COMMON.SETUP'
5532 double precision u(3),ud(3)
5535 do i=ibondp_start,ibondp_end
5536 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5537 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5539 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5540 c & *dc(j,i-1)/vbld(i)
5542 c if (energy_dec) write(iout,*)
5543 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5545 C Checking if it involves dummy (NH3+ or COO-) group
5546 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5547 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5548 diff = vbld(i)-vbldpDUM
5550 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5551 diff = vbld(i)-vbldp0
5553 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5554 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5557 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5559 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5562 estr=0.5d0*AKP*estr+estr1
5564 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5566 do i=ibond_start,ibond_end
5568 if (iti.ne.10 .and. iti.ne.ntyp1) then
5571 diff=vbld(i+nres)-vbldsc0(1,iti)
5572 if (energy_dec) write (iout,*)
5573 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5574 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5575 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5577 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5581 diff=vbld(i+nres)-vbldsc0(j,iti)
5582 ud(j)=aksc(j,iti)*diff
5583 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5597 uprod2=uprod2*u(k)*u(k)
5601 usumsqder=usumsqder+ud(j)*uprod2
5603 estr=estr+uprod/usum
5605 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5613 C--------------------------------------------------------------------------
5614 subroutine ebend(etheta,ethetacnstr)
5616 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5617 C angles gamma and its derivatives in consecutive thetas and gammas.
5619 implicit real*8 (a-h,o-z)
5620 include 'DIMENSIONS'
5621 include 'COMMON.LOCAL'
5622 include 'COMMON.GEO'
5623 include 'COMMON.INTERACT'
5624 include 'COMMON.DERIV'
5625 include 'COMMON.VAR'
5626 include 'COMMON.CHAIN'
5627 include 'COMMON.IOUNITS'
5628 include 'COMMON.NAMES'
5629 include 'COMMON.FFIELD'
5630 include 'COMMON.CONTROL'
5631 include 'COMMON.TORCNSTR'
5632 common /calcthet/ term1,term2,termm,diffak,ratak,
5633 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5634 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5635 double precision y(2),z(2)
5637 c time11=dexp(-2*time)
5640 c write (*,'(a,i2)') 'EBEND ICG=',icg
5641 do i=ithet_start,ithet_end
5642 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5643 & .or.itype(i).eq.ntyp1) cycle
5644 C Zero the energy function and its derivative at 0 or pi.
5645 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5647 ichir1=isign(1,itype(i-2))
5648 ichir2=isign(1,itype(i))
5649 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5650 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5651 if (itype(i-1).eq.10) then
5652 itype1=isign(10,itype(i-2))
5653 ichir11=isign(1,itype(i-2))
5654 ichir12=isign(1,itype(i-2))
5655 itype2=isign(10,itype(i))
5656 ichir21=isign(1,itype(i))
5657 ichir22=isign(1,itype(i))
5660 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5663 if (phii.ne.phii) phii=150.0
5673 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5676 if (phii1.ne.phii1) phii1=150.0
5688 C Calculate the "mean" value of theta from the part of the distribution
5689 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5690 C In following comments this theta will be referred to as t_c.
5691 thet_pred_mean=0.0d0
5693 athetk=athet(k,it,ichir1,ichir2)
5694 bthetk=bthet(k,it,ichir1,ichir2)
5696 athetk=athet(k,itype1,ichir11,ichir12)
5697 bthetk=bthet(k,itype2,ichir21,ichir22)
5699 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5700 c write(iout,*) 'chuj tu', y(k),z(k)
5702 dthett=thet_pred_mean*ssd
5703 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5704 C Derivatives of the "mean" values in gamma1 and gamma2.
5705 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5706 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5707 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5708 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5710 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5711 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5712 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5713 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5715 if (theta(i).gt.pi-delta) then
5716 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5718 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5719 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5720 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5722 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5724 else if (theta(i).lt.delta) then
5725 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5726 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5727 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5729 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5730 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5733 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5736 etheta=etheta+ethetai
5737 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5738 & 'ebend',i,ethetai,theta(i),itype(i)
5739 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5740 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5741 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5744 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5745 do i=ithetaconstr_start,ithetaconstr_end
5746 itheta=itheta_constr(i)
5747 thetiii=theta(itheta)
5748 difi=pinorm(thetiii-theta_constr0(i))
5749 if (difi.gt.theta_drange(i)) then
5750 difi=difi-theta_drange(i)
5751 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
5752 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5753 & +for_thet_constr(i)*difi**3
5754 else if (difi.lt.-drange(i)) then
5756 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
5757 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5758 & +for_thet_constr(i)*difi**3
5762 if (energy_dec) then
5763 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
5764 & i,itheta,rad2deg*thetiii,
5765 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
5766 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
5767 & gloc(itheta+nphi-2,icg)
5771 C Ufff.... We've done all this!!!
5774 C---------------------------------------------------------------------------
5775 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5777 implicit real*8 (a-h,o-z)
5778 include 'DIMENSIONS'
5779 include 'COMMON.LOCAL'
5780 include 'COMMON.IOUNITS'
5781 common /calcthet/ term1,term2,termm,diffak,ratak,
5782 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5783 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5784 C Calculate the contributions to both Gaussian lobes.
5785 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5786 C The "polynomial part" of the "standard deviation" of this part of
5787 C the distributioni.
5788 ccc write (iout,*) thetai,thet_pred_mean
5791 sig=sig*thet_pred_mean+polthet(j,it)
5793 C Derivative of the "interior part" of the "standard deviation of the"
5794 C gamma-dependent Gaussian lobe in t_c.
5795 sigtc=3*polthet(3,it)
5797 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5800 C Set the parameters of both Gaussian lobes of the distribution.
5801 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5802 fac=sig*sig+sigc0(it)
5805 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5806 sigsqtc=-4.0D0*sigcsq*sigtc
5807 c print *,i,sig,sigtc,sigsqtc
5808 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5809 sigtc=-sigtc/(fac*fac)
5810 C Following variable is sigma(t_c)**(-2)
5811 sigcsq=sigcsq*sigcsq
5813 sig0inv=1.0D0/sig0i**2
5814 delthec=thetai-thet_pred_mean
5815 delthe0=thetai-theta0i
5816 term1=-0.5D0*sigcsq*delthec*delthec
5817 term2=-0.5D0*sig0inv*delthe0*delthe0
5818 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5819 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5820 C NaNs in taking the logarithm. We extract the largest exponent which is added
5821 C to the energy (this being the log of the distribution) at the end of energy
5822 C term evaluation for this virtual-bond angle.
5823 if (term1.gt.term2) then
5825 term2=dexp(term2-termm)
5829 term1=dexp(term1-termm)
5832 C The ratio between the gamma-independent and gamma-dependent lobes of
5833 C the distribution is a Gaussian function of thet_pred_mean too.
5834 diffak=gthet(2,it)-thet_pred_mean
5835 ratak=diffak/gthet(3,it)**2
5836 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5837 C Let's differentiate it in thet_pred_mean NOW.
5839 C Now put together the distribution terms to make complete distribution.
5840 termexp=term1+ak*term2
5841 termpre=sigc+ak*sig0i
5842 C Contribution of the bending energy from this theta is just the -log of
5843 C the sum of the contributions from the two lobes and the pre-exponential
5844 C factor. Simple enough, isn't it?
5845 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5846 C write (iout,*) 'termexp',termexp,termm,termpre,i
5847 C NOW the derivatives!!!
5848 C 6/6/97 Take into account the deformation.
5849 E_theta=(delthec*sigcsq*term1
5850 & +ak*delthe0*sig0inv*term2)/termexp
5851 E_tc=((sigtc+aktc*sig0i)/termpre
5852 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5853 & aktc*term2)/termexp)
5856 c-----------------------------------------------------------------------------
5857 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5858 implicit real*8 (a-h,o-z)
5859 include 'DIMENSIONS'
5860 include 'COMMON.LOCAL'
5861 include 'COMMON.IOUNITS'
5862 common /calcthet/ term1,term2,termm,diffak,ratak,
5863 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5864 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5865 delthec=thetai-thet_pred_mean
5866 delthe0=thetai-theta0i
5867 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5868 t3 = thetai-thet_pred_mean
5872 t14 = t12+t6*sigsqtc
5874 t21 = thetai-theta0i
5880 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5881 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5882 & *(-t12*t9-ak*sig0inv*t27)
5886 C--------------------------------------------------------------------------
5887 subroutine ebend(etheta,ethetacnstr)
5889 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5890 C angles gamma and its derivatives in consecutive thetas and gammas.
5891 C ab initio-derived potentials from
5892 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5894 implicit real*8 (a-h,o-z)
5895 include 'DIMENSIONS'
5896 include 'COMMON.LOCAL'
5897 include 'COMMON.GEO'
5898 include 'COMMON.INTERACT'
5899 include 'COMMON.DERIV'
5900 include 'COMMON.VAR'
5901 include 'COMMON.CHAIN'
5902 include 'COMMON.IOUNITS'
5903 include 'COMMON.NAMES'
5904 include 'COMMON.FFIELD'
5905 include 'COMMON.CONTROL'
5906 include 'COMMON.TORCNSTR'
5907 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5908 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5909 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5910 & sinph1ph2(maxdouble,maxdouble)
5911 logical lprn /.false./, lprn1 /.false./
5913 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)
5930 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5933 if (phii.ne.phii) phii=150.0
5937 ityp1=ithetyp((itype(i-2)))
5938 C propagation of chirality for glycine type
5940 cosph1(k)=dcos(k*phii)
5941 sinph1(k)=dsin(k*phii)
5946 ityp1=ithetyp((itype(i-2)))
5951 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5954 if (phii1.ne.phii1) phii1=150.0
5959 ityp3=ithetyp((itype(i)))
5961 cosph2(k)=dcos(k*phii1)
5962 sinph2(k)=dsin(k*phii1)
5966 ityp3=ithetyp((itype(i)))
5972 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5975 ccl=cosph1(l)*cosph2(k-l)
5976 ssl=sinph1(l)*sinph2(k-l)
5977 scl=sinph1(l)*cosph2(k-l)
5978 csl=cosph1(l)*sinph2(k-l)
5979 cosph1ph2(l,k)=ccl-ssl
5980 cosph1ph2(k,l)=ccl+ssl
5981 sinph1ph2(l,k)=scl+csl
5982 sinph1ph2(k,l)=scl-csl
5986 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5987 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5988 write (iout,*) "coskt and sinkt"
5990 write (iout,*) k,coskt(k),sinkt(k)
5994 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5995 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5998 & write (iout,*) "k",k,"
5999 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
6000 & " ethetai",ethetai
6003 write (iout,*) "cosph and sinph"
6005 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6007 write (iout,*) "cosph1ph2 and sinph2ph2"
6010 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6011 & sinph1ph2(l,k),sinph1ph2(k,l)
6014 write(iout,*) "ethetai",ethetai
6019 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
6020 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
6021 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
6022 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6023 ethetai=ethetai+sinkt(m)*aux
6024 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6025 dephii=dephii+k*sinkt(m)*(
6026 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
6027 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6028 dephii1=dephii1+k*sinkt(m)*(
6029 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
6030 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6032 & write (iout,*) "m",m," k",k," bbthet",
6033 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
6034 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
6035 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
6036 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6037 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6040 C print *,"cosph1", (cosph1(k), k=1,nsingle)
6041 C print *,"cosph2", (cosph2(k), k=1,nsingle)
6042 C print *,"sinph1", (sinph1(k), k=1,nsingle)
6043 C print *,"sinph2", (sinph2(k), k=1,nsingle)
6045 & write(iout,*) "ethetai",ethetai
6046 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6050 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6051 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
6052 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6053 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6054 ethetai=ethetai+sinkt(m)*aux
6055 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6056 dephii=dephii+l*sinkt(m)*(
6057 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
6058 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6059 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6060 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6061 dephii1=dephii1+(k-l)*sinkt(m)*(
6062 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6063 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6064 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
6065 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6067 write (iout,*) "m",m," k",k," l",l," ffthet",
6068 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6069 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
6070 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6071 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
6072 & " ethetai",ethetai
6073 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6074 & cosph1ph2(k,l)*sinkt(m),
6075 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6084 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6085 & i,theta(i)*rad2deg,phii*rad2deg,
6086 & phii1*rad2deg,ethetai
6088 etheta=etheta+ethetai
6089 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6090 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6091 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
6095 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6096 do i=ithetaconstr_start,ithetaconstr_end
6097 itheta=itheta_constr(i)
6098 thetiii=theta(itheta)
6099 difi=pinorm(thetiii-theta_constr0(i))
6100 if (difi.gt.theta_drange(i)) then
6101 difi=difi-theta_drange(i)
6102 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6103 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6104 & +for_thet_constr(i)*difi**3
6105 else if (difi.lt.-drange(i)) then
6107 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6108 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6109 & +for_thet_constr(i)*difi**3
6113 if (energy_dec) then
6114 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6115 & i,itheta,rad2deg*thetiii,
6116 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6117 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6118 & gloc(itheta+nphi-2,icg)
6126 c-----------------------------------------------------------------------------
6127 subroutine esc(escloc)
6128 C Calculate the local energy of a side chain and its derivatives in the
6129 C corresponding virtual-bond valence angles THETA and the spherical angles
6131 implicit real*8 (a-h,o-z)
6132 include 'DIMENSIONS'
6133 include 'COMMON.GEO'
6134 include 'COMMON.LOCAL'
6135 include 'COMMON.VAR'
6136 include 'COMMON.INTERACT'
6137 include 'COMMON.DERIV'
6138 include 'COMMON.CHAIN'
6139 include 'COMMON.IOUNITS'
6140 include 'COMMON.NAMES'
6141 include 'COMMON.FFIELD'
6142 include 'COMMON.CONTROL'
6143 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6144 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6145 common /sccalc/ time11,time12,time112,theti,it,nlobit
6148 c write (iout,'(a)') 'ESC'
6149 do i=loc_start,loc_end
6151 if (it.eq.ntyp1) cycle
6152 if (it.eq.10) goto 1
6153 nlobit=nlob(iabs(it))
6154 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6155 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6156 theti=theta(i+1)-pipol
6161 if (x(2).gt.pi-delta) then
6165 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6167 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6168 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6170 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6171 & ddersc0(1),dersc(1))
6172 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6173 & ddersc0(3),dersc(3))
6175 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6177 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6178 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6179 & dersc0(2),esclocbi,dersc02)
6180 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6182 call splinthet(x(2),0.5d0*delta,ss,ssd)
6187 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6189 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6190 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6192 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6194 c write (iout,*) escloci
6195 else if (x(2).lt.delta) then
6199 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6201 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6202 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6204 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6205 & ddersc0(1),dersc(1))
6206 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6207 & ddersc0(3),dersc(3))
6209 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6211 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6212 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6213 & dersc0(2),esclocbi,dersc02)
6214 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6219 call splinthet(x(2),0.5d0*delta,ss,ssd)
6221 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6223 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6224 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6226 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6227 c write (iout,*) escloci
6229 call enesc(x,escloci,dersc,ddummy,.false.)
6232 escloc=escloc+escloci
6233 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6234 & 'escloc',i,escloci
6235 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6237 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6239 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6240 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6245 C---------------------------------------------------------------------------
6246 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6247 implicit real*8 (a-h,o-z)
6248 include 'DIMENSIONS'
6249 include 'COMMON.GEO'
6250 include 'COMMON.LOCAL'
6251 include 'COMMON.IOUNITS'
6252 common /sccalc/ time11,time12,time112,theti,it,nlobit
6253 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6254 double precision contr(maxlob,-1:1)
6256 c write (iout,*) 'it=',it,' nlobit=',nlobit
6260 if (mixed) ddersc(j)=0.0d0
6264 C Because of periodicity of the dependence of the SC energy in omega we have
6265 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6266 C To avoid underflows, first compute & store the exponents.
6274 z(k)=x(k)-censc(k,j,it)
6279 Axk=Axk+gaussc(l,k,j,it)*z(l)
6285 expfac=expfac+Ax(k,j,iii)*z(k)
6293 C As in the case of ebend, we want to avoid underflows in exponentiation and
6294 C subsequent NaNs and INFs in energy calculation.
6295 C Find the largest exponent
6299 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6303 cd print *,'it=',it,' emin=',emin
6305 C Compute the contribution to SC energy and derivatives
6310 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6311 if(adexp.ne.adexp) adexp=1.0
6314 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6316 cd print *,'j=',j,' expfac=',expfac
6317 escloc_i=escloc_i+expfac
6319 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6323 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6324 & +gaussc(k,2,j,it))*expfac
6331 dersc(1)=dersc(1)/cos(theti)**2
6332 ddersc(1)=ddersc(1)/cos(theti)**2
6335 escloci=-(dlog(escloc_i)-emin)
6337 dersc(j)=dersc(j)/escloc_i
6341 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6346 C------------------------------------------------------------------------------
6347 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6348 implicit real*8 (a-h,o-z)
6349 include 'DIMENSIONS'
6350 include 'COMMON.GEO'
6351 include 'COMMON.LOCAL'
6352 include 'COMMON.IOUNITS'
6353 common /sccalc/ time11,time12,time112,theti,it,nlobit
6354 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6355 double precision contr(maxlob)
6366 z(k)=x(k)-censc(k,j,it)
6372 Axk=Axk+gaussc(l,k,j,it)*z(l)
6378 expfac=expfac+Ax(k,j)*z(k)
6383 C As in the case of ebend, we want to avoid underflows in exponentiation and
6384 C subsequent NaNs and INFs in energy calculation.
6385 C Find the largest exponent
6388 if (emin.gt.contr(j)) emin=contr(j)
6392 C Compute the contribution to SC energy and derivatives
6396 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6397 escloc_i=escloc_i+expfac
6399 dersc(k)=dersc(k)+Ax(k,j)*expfac
6401 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6402 & +gaussc(1,2,j,it))*expfac
6406 dersc(1)=dersc(1)/cos(theti)**2
6407 dersc12=dersc12/cos(theti)**2
6408 escloci=-(dlog(escloc_i)-emin)
6410 dersc(j)=dersc(j)/escloc_i
6412 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6416 c----------------------------------------------------------------------------------
6417 subroutine esc(escloc)
6418 C Calculate the local energy of a side chain and its derivatives in the
6419 C corresponding virtual-bond valence angles THETA and the spherical angles
6420 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6421 C added by Urszula Kozlowska. 07/11/2007
6423 implicit real*8 (a-h,o-z)
6424 include 'DIMENSIONS'
6425 include 'COMMON.GEO'
6426 include 'COMMON.LOCAL'
6427 include 'COMMON.VAR'
6428 include 'COMMON.SCROT'
6429 include 'COMMON.INTERACT'
6430 include 'COMMON.DERIV'
6431 include 'COMMON.CHAIN'
6432 include 'COMMON.IOUNITS'
6433 include 'COMMON.NAMES'
6434 include 'COMMON.FFIELD'
6435 include 'COMMON.CONTROL'
6436 include 'COMMON.VECTORS'
6437 double precision x_prime(3),y_prime(3),z_prime(3)
6438 & , sumene,dsc_i,dp2_i,x(65),
6439 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6440 & de_dxx,de_dyy,de_dzz,de_dt
6441 double precision s1_t,s1_6_t,s2_t,s2_6_t
6443 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6444 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6445 & dt_dCi(3),dt_dCi1(3)
6446 common /sccalc/ time11,time12,time112,theti,it,nlobit
6449 do i=loc_start,loc_end
6450 if (itype(i).eq.ntyp1) cycle
6451 costtab(i+1) =dcos(theta(i+1))
6452 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6453 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6454 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6455 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6456 cosfac=dsqrt(cosfac2)
6457 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6458 sinfac=dsqrt(sinfac2)
6460 if (it.eq.10) goto 1
6462 C Compute the axes of tghe local cartesian coordinates system; store in
6463 c x_prime, y_prime and z_prime
6470 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6471 C & dc_norm(3,i+nres)
6473 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6474 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6477 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6480 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6481 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6482 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6483 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6484 c & " xy",scalar(x_prime(1),y_prime(1)),
6485 c & " xz",scalar(x_prime(1),z_prime(1)),
6486 c & " yy",scalar(y_prime(1),y_prime(1)),
6487 c & " yz",scalar(y_prime(1),z_prime(1)),
6488 c & " zz",scalar(z_prime(1),z_prime(1))
6490 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6491 C to local coordinate system. Store in xx, yy, zz.
6497 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6498 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6499 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6506 C Compute the energy of the ith side cbain
6508 c write (2,*) "xx",xx," yy",yy," zz",zz
6511 x(j) = sc_parmin(j,it)
6514 Cc diagnostics - remove later
6516 yy1 = dsin(alph(2))*dcos(omeg(2))
6517 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6518 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6519 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6521 C," --- ", xx_w,yy_w,zz_w
6524 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6525 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6527 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6528 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6530 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6531 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6532 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6533 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6534 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6536 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6537 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6538 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6539 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6540 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6542 dsc_i = 0.743d0+x(61)
6544 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6545 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6546 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6547 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6548 s1=(1+x(63))/(0.1d0 + dscp1)
6549 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6550 s2=(1+x(65))/(0.1d0 + dscp2)
6551 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6552 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6553 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6554 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6556 c & dscp1,dscp2,sumene
6557 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6558 escloc = escloc + sumene
6559 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6564 C This section to check the numerical derivatives of the energy of ith side
6565 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6566 C #define DEBUG in the code to turn it on.
6568 write (2,*) "sumene =",sumene
6572 write (2,*) xx,yy,zz
6573 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6574 de_dxx_num=(sumenep-sumene)/aincr
6576 write (2,*) "xx+ sumene from enesc=",sumenep
6579 write (2,*) xx,yy,zz
6580 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6581 de_dyy_num=(sumenep-sumene)/aincr
6583 write (2,*) "yy+ sumene from enesc=",sumenep
6586 write (2,*) xx,yy,zz
6587 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6588 de_dzz_num=(sumenep-sumene)/aincr
6590 write (2,*) "zz+ sumene from enesc=",sumenep
6591 costsave=cost2tab(i+1)
6592 sintsave=sint2tab(i+1)
6593 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6594 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6595 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6596 de_dt_num=(sumenep-sumene)/aincr
6597 write (2,*) " t+ sumene from enesc=",sumenep
6598 cost2tab(i+1)=costsave
6599 sint2tab(i+1)=sintsave
6600 C End of diagnostics section.
6603 C Compute the gradient of esc
6605 c zz=zz*dsign(1.0,dfloat(itype(i)))
6606 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6607 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6608 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6609 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6610 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6611 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6612 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6613 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6614 pom1=(sumene3*sint2tab(i+1)+sumene1)
6615 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6616 pom2=(sumene4*cost2tab(i+1)+sumene2)
6617 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6618 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6619 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6620 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6622 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6623 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6624 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6626 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6627 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6628 & +(pom1+pom2)*pom_dx
6630 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6633 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6634 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6635 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6637 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6638 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6639 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6640 & +x(59)*zz**2 +x(60)*xx*zz
6641 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6642 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6643 & +(pom1-pom2)*pom_dy
6645 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6648 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6649 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6650 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6651 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6652 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6653 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6654 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6655 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6657 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6660 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6661 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6662 & +pom1*pom_dt1+pom2*pom_dt2
6664 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6669 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6670 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6671 cosfac2xx=cosfac2*xx
6672 sinfac2yy=sinfac2*yy
6674 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6676 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6678 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6679 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6680 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6681 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6682 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6683 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6684 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6685 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6686 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6687 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6691 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6692 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6693 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6694 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6697 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6698 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6699 dZZ_XYZ(k)=vbld_inv(i+nres)*
6700 & (z_prime(k)-zz*dC_norm(k,i+nres))
6702 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6703 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6707 dXX_Ctab(k,i)=dXX_Ci(k)
6708 dXX_C1tab(k,i)=dXX_Ci1(k)
6709 dYY_Ctab(k,i)=dYY_Ci(k)
6710 dYY_C1tab(k,i)=dYY_Ci1(k)
6711 dZZ_Ctab(k,i)=dZZ_Ci(k)
6712 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6713 dXX_XYZtab(k,i)=dXX_XYZ(k)
6714 dYY_XYZtab(k,i)=dYY_XYZ(k)
6715 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6719 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6720 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6721 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6722 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6723 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6725 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6726 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6727 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6728 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6729 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6730 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6731 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6732 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6734 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6735 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6737 C to check gradient call subroutine check_grad
6743 c------------------------------------------------------------------------------
6744 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6746 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6747 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6748 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6749 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6751 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6752 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6754 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6755 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6756 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6757 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6758 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6760 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6761 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6762 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6763 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6764 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6766 dsc_i = 0.743d0+x(61)
6768 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6769 & *(xx*cost2+yy*sint2))
6770 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6771 & *(xx*cost2-yy*sint2))
6772 s1=(1+x(63))/(0.1d0 + dscp1)
6773 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6774 s2=(1+x(65))/(0.1d0 + dscp2)
6775 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6776 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6777 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6782 c------------------------------------------------------------------------------
6783 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6785 C This procedure calculates two-body contact function g(rij) and its derivative:
6788 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6791 C where x=(rij-r0ij)/delta
6793 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6796 double precision rij,r0ij,eps0ij,fcont,fprimcont
6797 double precision x,x2,x4,delta
6801 if (x.lt.-1.0D0) then
6804 else if (x.le.1.0D0) then
6807 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6808 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6815 c------------------------------------------------------------------------------
6816 subroutine splinthet(theti,delta,ss,ssder)
6817 implicit real*8 (a-h,o-z)
6818 include 'DIMENSIONS'
6819 include 'COMMON.VAR'
6820 include 'COMMON.GEO'
6823 if (theti.gt.pipol) then
6824 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6826 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6831 c------------------------------------------------------------------------------
6832 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6834 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6835 double precision ksi,ksi2,ksi3,a1,a2,a3
6836 a1=fprim0*delta/(f1-f0)
6842 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6843 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6846 c------------------------------------------------------------------------------
6847 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6849 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6850 double precision ksi,ksi2,ksi3,a1,a2,a3
6855 a2=3*(f1x-f0x)-2*fprim0x*delta
6856 a3=fprim0x*delta-2*(f1x-f0x)
6857 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6860 C-----------------------------------------------------------------------------
6862 C-----------------------------------------------------------------------------
6863 subroutine etor(etors,edihcnstr)
6864 implicit real*8 (a-h,o-z)
6865 include 'DIMENSIONS'
6866 include 'COMMON.VAR'
6867 include 'COMMON.GEO'
6868 include 'COMMON.LOCAL'
6869 include 'COMMON.TORSION'
6870 include 'COMMON.INTERACT'
6871 include 'COMMON.DERIV'
6872 include 'COMMON.CHAIN'
6873 include 'COMMON.NAMES'
6874 include 'COMMON.IOUNITS'
6875 include 'COMMON.FFIELD'
6876 include 'COMMON.TORCNSTR'
6877 include 'COMMON.CONTROL'
6879 C Set lprn=.true. for debugging
6883 do i=iphi_start,iphi_end
6885 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6886 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6887 itori=itortyp(itype(i-2))
6888 itori1=itortyp(itype(i-1))
6891 C Proline-Proline pair is a special case...
6892 if (itori.eq.3 .and. itori1.eq.3) then
6893 if (phii.gt.-dwapi3) then
6895 fac=1.0D0/(1.0D0-cosphi)
6896 etorsi=v1(1,3,3)*fac
6897 etorsi=etorsi+etorsi
6898 etors=etors+etorsi-v1(1,3,3)
6899 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6900 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6903 v1ij=v1(j+1,itori,itori1)
6904 v2ij=v2(j+1,itori,itori1)
6907 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6908 if (energy_dec) etors_ii=etors_ii+
6909 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6910 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6914 v1ij=v1(j,itori,itori1)
6915 v2ij=v2(j,itori,itori1)
6918 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6919 if (energy_dec) etors_ii=etors_ii+
6920 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6921 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6924 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6927 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6928 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6929 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6930 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6931 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6933 ! 6/20/98 - dihedral angle constraints
6936 itori=idih_constr(i)
6939 if (difi.gt.drange(i)) then
6941 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6942 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6943 else if (difi.lt.-drange(i)) then
6945 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
6946 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6948 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6949 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6951 ! write (iout,*) 'edihcnstr',edihcnstr
6954 c------------------------------------------------------------------------------
6955 subroutine etor_d(etors_d)
6959 c----------------------------------------------------------------------------
6961 subroutine etor(etors,edihcnstr)
6962 implicit real*8 (a-h,o-z)
6963 include 'DIMENSIONS'
6964 include 'COMMON.VAR'
6965 include 'COMMON.GEO'
6966 include 'COMMON.LOCAL'
6967 include 'COMMON.TORSION'
6968 include 'COMMON.INTERACT'
6969 include 'COMMON.DERIV'
6970 include 'COMMON.CHAIN'
6971 include 'COMMON.NAMES'
6972 include 'COMMON.IOUNITS'
6973 include 'COMMON.FFIELD'
6974 include 'COMMON.TORCNSTR'
6975 include 'COMMON.CONTROL'
6977 C Set lprn=.true. for debugging
6981 do i=iphi_start,iphi_end
6982 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6983 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6984 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6985 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6986 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6987 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6988 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6989 C For introducing the NH3+ and COO- group please check the etor_d for reference
6992 if (iabs(itype(i)).eq.20) then
6997 itori=itortyp(itype(i-2))
6998 itori1=itortyp(itype(i-1))
7001 C Regular cosine and sine terms
7002 do j=1,nterm(itori,itori1,iblock)
7003 v1ij=v1(j,itori,itori1,iblock)
7004 v2ij=v2(j,itori,itori1,iblock)
7007 etors=etors+v1ij*cosphi+v2ij*sinphi
7008 if (energy_dec) etors_ii=etors_ii+
7009 & v1ij*cosphi+v2ij*sinphi
7010 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7014 C E = SUM ----------------------------------- - v1
7015 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7017 cosphi=dcos(0.5d0*phii)
7018 sinphi=dsin(0.5d0*phii)
7019 do j=1,nlor(itori,itori1,iblock)
7020 vl1ij=vlor1(j,itori,itori1)
7021 vl2ij=vlor2(j,itori,itori1)
7022 vl3ij=vlor3(j,itori,itori1)
7023 pom=vl2ij*cosphi+vl3ij*sinphi
7024 pom1=1.0d0/(pom*pom+1.0d0)
7025 etors=etors+vl1ij*pom1
7026 if (energy_dec) etors_ii=etors_ii+
7029 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7031 C Subtract the constant term
7032 etors=etors-v0(itori,itori1,iblock)
7033 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7034 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
7036 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7037 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7038 & (v1(j,itori,itori1,iblock),j=1,6),
7039 & (v2(j,itori,itori1,iblock),j=1,6)
7040 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7041 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7043 ! 6/20/98 - dihedral angle constraints
7045 c do i=1,ndih_constr
7046 do i=idihconstr_start,idihconstr_end
7047 itori=idih_constr(i)
7049 difi=pinorm(phii-phi0(i))
7050 if (difi.gt.drange(i)) then
7052 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7053 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7054 else if (difi.lt.-drange(i)) then
7056 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7057 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7061 if (energy_dec) then
7062 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
7063 & i,itori,rad2deg*phii,
7064 & rad2deg*phi0(i), rad2deg*drange(i),
7065 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
7068 cd write (iout,*) 'edihcnstr',edihcnstr
7071 c----------------------------------------------------------------------------
7072 subroutine etor_d(etors_d)
7073 C 6/23/01 Compute double torsional energy
7074 implicit real*8 (a-h,o-z)
7075 include 'DIMENSIONS'
7076 include 'COMMON.VAR'
7077 include 'COMMON.GEO'
7078 include 'COMMON.LOCAL'
7079 include 'COMMON.TORSION'
7080 include 'COMMON.INTERACT'
7081 include 'COMMON.DERIV'
7082 include 'COMMON.CHAIN'
7083 include 'COMMON.NAMES'
7084 include 'COMMON.IOUNITS'
7085 include 'COMMON.FFIELD'
7086 include 'COMMON.TORCNSTR'
7088 C Set lprn=.true. for debugging
7092 c write(iout,*) "a tu??"
7093 do i=iphid_start,iphid_end
7094 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7095 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7096 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7097 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7098 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7099 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7100 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7101 & (itype(i+1).eq.ntyp1)) cycle
7102 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7103 itori=itortyp(itype(i-2))
7104 itori1=itortyp(itype(i-1))
7105 itori2=itortyp(itype(i))
7111 if (iabs(itype(i+1)).eq.20) iblock=2
7112 C Iblock=2 Proline type
7113 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7114 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7115 C if (itype(i+1).eq.ntyp1) iblock=3
7116 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7117 C IS or IS NOT need for this
7118 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7119 C is (itype(i-3).eq.ntyp1) ntblock=2
7120 C ntblock is N-terminal blocking group
7122 C Regular cosine and sine terms
7123 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7124 C Example of changes for NH3+ blocking group
7125 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7126 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7127 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7128 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7129 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7130 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7131 cosphi1=dcos(j*phii)
7132 sinphi1=dsin(j*phii)
7133 cosphi2=dcos(j*phii1)
7134 sinphi2=dsin(j*phii1)
7135 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7136 & v2cij*cosphi2+v2sij*sinphi2
7137 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7138 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7140 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7142 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7143 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7144 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7145 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7146 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7147 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7148 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7149 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7150 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7151 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7152 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7153 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7154 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7155 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7158 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7159 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7164 c------------------------------------------------------------------------------
7165 subroutine eback_sc_corr(esccor)
7166 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7167 c conformational states; temporarily implemented as differences
7168 c between UNRES torsional potentials (dependent on three types of
7169 c residues) and the torsional potentials dependent on all 20 types
7170 c of residues computed from AM1 energy surfaces of terminally-blocked
7171 c amino-acid residues.
7172 implicit real*8 (a-h,o-z)
7173 include 'DIMENSIONS'
7174 include 'COMMON.VAR'
7175 include 'COMMON.GEO'
7176 include 'COMMON.LOCAL'
7177 include 'COMMON.TORSION'
7178 include 'COMMON.SCCOR'
7179 include 'COMMON.INTERACT'
7180 include 'COMMON.DERIV'
7181 include 'COMMON.CHAIN'
7182 include 'COMMON.NAMES'
7183 include 'COMMON.IOUNITS'
7184 include 'COMMON.FFIELD'
7185 include 'COMMON.CONTROL'
7187 C Set lprn=.true. for debugging
7190 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7192 do i=itau_start,itau_end
7193 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7195 isccori=isccortyp(itype(i-2))
7196 isccori1=isccortyp(itype(i-1))
7197 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7199 do intertyp=1,3 !intertyp
7200 cc Added 09 May 2012 (Adasko)
7201 cc Intertyp means interaction type of backbone mainchain correlation:
7202 c 1 = SC...Ca...Ca...Ca
7203 c 2 = Ca...Ca...Ca...SC
7204 c 3 = SC...Ca...Ca...SCi
7206 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7207 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7208 & (itype(i-1).eq.ntyp1)))
7209 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7210 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7211 & .or.(itype(i).eq.ntyp1)))
7212 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7213 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7214 & (itype(i-3).eq.ntyp1)))) cycle
7215 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7216 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7218 do j=1,nterm_sccor(isccori,isccori1)
7219 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7220 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7221 cosphi=dcos(j*tauangle(intertyp,i))
7222 sinphi=dsin(j*tauangle(intertyp,i))
7223 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7224 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7226 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7227 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7229 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7230 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
7231 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
7232 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7233 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7239 c----------------------------------------------------------------------------
7240 subroutine multibody(ecorr)
7241 C This subroutine calculates multi-body contributions to energy following
7242 C the idea of Skolnick et al. If side chains I and J make a contact and
7243 C at the same time side chains I+1 and J+1 make a contact, an extra
7244 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7245 implicit real*8 (a-h,o-z)
7246 include 'DIMENSIONS'
7247 include 'COMMON.IOUNITS'
7248 include 'COMMON.DERIV'
7249 include 'COMMON.INTERACT'
7250 include 'COMMON.CONTACTS'
7251 double precision gx(3),gx1(3)
7254 C Set lprn=.true. for debugging
7258 write (iout,'(a)') 'Contact function values:'
7260 write (iout,'(i2,20(1x,i2,f10.5))')
7261 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7276 num_conti=num_cont(i)
7277 num_conti1=num_cont(i1)
7282 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7283 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7284 cd & ' ishift=',ishift
7285 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7286 C The system gains extra energy.
7287 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7288 endif ! j1==j+-ishift
7297 c------------------------------------------------------------------------------
7298 double precision function esccorr(i,j,k,l,jj,kk)
7299 implicit real*8 (a-h,o-z)
7300 include 'DIMENSIONS'
7301 include 'COMMON.IOUNITS'
7302 include 'COMMON.DERIV'
7303 include 'COMMON.INTERACT'
7304 include 'COMMON.CONTACTS'
7305 double precision gx(3),gx1(3)
7310 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7311 C Calculate the multi-body contribution to energy.
7312 C Calculate multi-body contributions to the gradient.
7313 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7314 cd & k,l,(gacont(m,kk,k),m=1,3)
7316 gx(m) =ekl*gacont(m,jj,i)
7317 gx1(m)=eij*gacont(m,kk,k)
7318 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7319 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7320 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7321 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7325 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7330 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7336 c------------------------------------------------------------------------------
7337 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7338 C This subroutine calculates multi-body contributions to hydrogen-bonding
7339 implicit real*8 (a-h,o-z)
7340 include 'DIMENSIONS'
7341 include 'COMMON.IOUNITS'
7344 parameter (max_cont=maxconts)
7345 parameter (max_dim=26)
7346 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7347 double precision zapas(max_dim,maxconts,max_fg_procs),
7348 & zapas_recv(max_dim,maxconts,max_fg_procs)
7349 common /przechowalnia/ zapas
7350 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7351 & status_array(MPI_STATUS_SIZE,maxconts*2)
7353 include 'COMMON.SETUP'
7354 include 'COMMON.FFIELD'
7355 include 'COMMON.DERIV'
7356 include 'COMMON.INTERACT'
7357 include 'COMMON.CONTACTS'
7358 include 'COMMON.CONTROL'
7359 include 'COMMON.LOCAL'
7360 double precision gx(3),gx1(3),time00
7363 C Set lprn=.true. for debugging
7368 if (nfgtasks.le.1) goto 30
7370 write (iout,'(a)') 'Contact function values before RECEIVE:'
7372 write (iout,'(2i3,50(1x,i2,f5.2))')
7373 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7374 & j=1,num_cont_hb(i))
7378 do i=1,ntask_cont_from
7381 do i=1,ntask_cont_to
7384 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7386 C Make the list of contacts to send to send to other procesors
7387 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7389 do i=iturn3_start,iturn3_end
7390 c write (iout,*) "make contact list turn3",i," num_cont",
7392 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7394 do i=iturn4_start,iturn4_end
7395 c write (iout,*) "make contact list turn4",i," num_cont",
7397 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7401 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7403 do j=1,num_cont_hb(i)
7406 iproc=iint_sent_local(k,jjc,ii)
7407 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7408 if (iproc.gt.0) then
7409 ncont_sent(iproc)=ncont_sent(iproc)+1
7410 nn=ncont_sent(iproc)
7412 zapas(2,nn,iproc)=jjc
7413 zapas(3,nn,iproc)=facont_hb(j,i)
7414 zapas(4,nn,iproc)=ees0p(j,i)
7415 zapas(5,nn,iproc)=ees0m(j,i)
7416 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7417 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7418 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7419 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7420 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7421 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7422 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7423 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7424 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7425 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7426 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7427 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7428 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7429 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7430 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7431 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7432 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7433 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7434 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7435 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7436 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7443 & "Numbers of contacts to be sent to other processors",
7444 & (ncont_sent(i),i=1,ntask_cont_to)
7445 write (iout,*) "Contacts sent"
7446 do ii=1,ntask_cont_to
7448 iproc=itask_cont_to(ii)
7449 write (iout,*) nn," contacts to processor",iproc,
7450 & " of CONT_TO_COMM group"
7452 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7460 CorrelID1=nfgtasks+fg_rank+1
7462 C Receive the numbers of needed contacts from other processors
7463 do ii=1,ntask_cont_from
7464 iproc=itask_cont_from(ii)
7466 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7467 & FG_COMM,req(ireq),IERR)
7469 c write (iout,*) "IRECV ended"
7471 C Send the number of contacts needed by other processors
7472 do ii=1,ntask_cont_to
7473 iproc=itask_cont_to(ii)
7475 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7476 & FG_COMM,req(ireq),IERR)
7478 c write (iout,*) "ISEND ended"
7479 c write (iout,*) "number of requests (nn)",ireq
7482 & call MPI_Waitall(ireq,req,status_array,ierr)
7484 c & "Numbers of contacts to be received from other processors",
7485 c & (ncont_recv(i),i=1,ntask_cont_from)
7489 do ii=1,ntask_cont_from
7490 iproc=itask_cont_from(ii)
7492 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7493 c & " of CONT_TO_COMM group"
7497 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7498 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7499 c write (iout,*) "ireq,req",ireq,req(ireq)
7502 C Send the contacts to processors that need them
7503 do ii=1,ntask_cont_to
7504 iproc=itask_cont_to(ii)
7506 c write (iout,*) nn," contacts to processor",iproc,
7507 c & " of CONT_TO_COMM group"
7510 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7511 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7512 c write (iout,*) "ireq,req",ireq,req(ireq)
7514 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7518 c write (iout,*) "number of requests (contacts)",ireq
7519 c write (iout,*) "req",(req(i),i=1,4)
7522 & call MPI_Waitall(ireq,req,status_array,ierr)
7523 do iii=1,ntask_cont_from
7524 iproc=itask_cont_from(iii)
7527 write (iout,*) "Received",nn," contacts from processor",iproc,
7528 & " of CONT_FROM_COMM group"
7531 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7536 ii=zapas_recv(1,i,iii)
7537 c Flag the received contacts to prevent double-counting
7538 jj=-zapas_recv(2,i,iii)
7539 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7541 nnn=num_cont_hb(ii)+1
7544 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7545 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7546 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7547 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7548 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7549 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7550 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7551 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7552 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7553 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7554 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7555 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7556 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7557 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7558 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7559 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7560 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7561 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7562 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7563 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7564 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7565 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7566 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7567 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7572 write (iout,'(a)') 'Contact function values after receive:'
7574 write (iout,'(2i3,50(1x,i3,f5.2))')
7575 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7576 & j=1,num_cont_hb(i))
7583 write (iout,'(a)') 'Contact function values:'
7585 write (iout,'(2i3,50(1x,i3,f5.2))')
7586 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7587 & j=1,num_cont_hb(i))
7591 C Remove the loop below after debugging !!!
7598 C Calculate the local-electrostatic correlation terms
7599 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7601 num_conti=num_cont_hb(i)
7602 num_conti1=num_cont_hb(i+1)
7609 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7610 c & ' jj=',jj,' kk=',kk
7611 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7612 & .or. j.lt.0 .and. j1.gt.0) .and.
7613 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7614 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7615 C The system gains extra energy.
7616 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7617 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7618 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7620 else if (j1.eq.j) then
7621 C Contacts I-J and I-(J+1) occur simultaneously.
7622 C The system loses extra energy.
7623 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7628 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7629 c & ' jj=',jj,' kk=',kk
7631 C Contacts I-J and (I+1)-J occur simultaneously.
7632 C The system loses extra energy.
7633 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7640 c------------------------------------------------------------------------------
7641 subroutine add_hb_contact(ii,jj,itask)
7642 implicit real*8 (a-h,o-z)
7643 include "DIMENSIONS"
7644 include "COMMON.IOUNITS"
7647 parameter (max_cont=maxconts)
7648 parameter (max_dim=26)
7649 include "COMMON.CONTACTS"
7650 double precision zapas(max_dim,maxconts,max_fg_procs),
7651 & zapas_recv(max_dim,maxconts,max_fg_procs)
7652 common /przechowalnia/ zapas
7653 integer i,j,ii,jj,iproc,itask(4),nn
7654 c write (iout,*) "itask",itask
7657 if (iproc.gt.0) then
7658 do j=1,num_cont_hb(ii)
7660 c write (iout,*) "i",ii," j",jj," jjc",jjc
7662 ncont_sent(iproc)=ncont_sent(iproc)+1
7663 nn=ncont_sent(iproc)
7664 zapas(1,nn,iproc)=ii
7665 zapas(2,nn,iproc)=jjc
7666 zapas(3,nn,iproc)=facont_hb(j,ii)
7667 zapas(4,nn,iproc)=ees0p(j,ii)
7668 zapas(5,nn,iproc)=ees0m(j,ii)
7669 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7670 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7671 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7672 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7673 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7674 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7675 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7676 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7677 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7678 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7679 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7680 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7681 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7682 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7683 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7684 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7685 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7686 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7687 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7688 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7689 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7697 c------------------------------------------------------------------------------
7698 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7700 C This subroutine calculates multi-body contributions to hydrogen-bonding
7701 implicit real*8 (a-h,o-z)
7702 include 'DIMENSIONS'
7703 include 'COMMON.IOUNITS'
7706 parameter (max_cont=maxconts)
7707 parameter (max_dim=70)
7708 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7709 double precision zapas(max_dim,maxconts,max_fg_procs),
7710 & zapas_recv(max_dim,maxconts,max_fg_procs)
7711 common /przechowalnia/ zapas
7712 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7713 & status_array(MPI_STATUS_SIZE,maxconts*2)
7715 include 'COMMON.SETUP'
7716 include 'COMMON.FFIELD'
7717 include 'COMMON.DERIV'
7718 include 'COMMON.LOCAL'
7719 include 'COMMON.INTERACT'
7720 include 'COMMON.CONTACTS'
7721 include 'COMMON.CHAIN'
7722 include 'COMMON.CONTROL'
7723 double precision gx(3),gx1(3)
7724 integer num_cont_hb_old(maxres)
7726 double precision eello4,eello5,eelo6,eello_turn6
7727 external eello4,eello5,eello6,eello_turn6
7728 C Set lprn=.true. for debugging
7733 num_cont_hb_old(i)=num_cont_hb(i)
7737 if (nfgtasks.le.1) goto 30
7739 write (iout,'(a)') 'Contact function values before RECEIVE:'
7741 write (iout,'(2i3,50(1x,i2,f5.2))')
7742 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7743 & j=1,num_cont_hb(i))
7747 do i=1,ntask_cont_from
7750 do i=1,ntask_cont_to
7753 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7755 C Make the list of contacts to send to send to other procesors
7756 do i=iturn3_start,iturn3_end
7757 c write (iout,*) "make contact list turn3",i," num_cont",
7759 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7761 do i=iturn4_start,iturn4_end
7762 c write (iout,*) "make contact list turn4",i," num_cont",
7764 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7768 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7770 do j=1,num_cont_hb(i)
7773 iproc=iint_sent_local(k,jjc,ii)
7774 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7775 if (iproc.ne.0) then
7776 ncont_sent(iproc)=ncont_sent(iproc)+1
7777 nn=ncont_sent(iproc)
7779 zapas(2,nn,iproc)=jjc
7780 zapas(3,nn,iproc)=d_cont(j,i)
7784 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7789 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7797 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7808 & "Numbers of contacts to be sent to other processors",
7809 & (ncont_sent(i),i=1,ntask_cont_to)
7810 write (iout,*) "Contacts sent"
7811 do ii=1,ntask_cont_to
7813 iproc=itask_cont_to(ii)
7814 write (iout,*) nn," contacts to processor",iproc,
7815 & " of CONT_TO_COMM group"
7817 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7825 CorrelID1=nfgtasks+fg_rank+1
7827 C Receive the numbers of needed contacts from other processors
7828 do ii=1,ntask_cont_from
7829 iproc=itask_cont_from(ii)
7831 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7832 & FG_COMM,req(ireq),IERR)
7834 c write (iout,*) "IRECV ended"
7836 C Send the number of contacts needed by other processors
7837 do ii=1,ntask_cont_to
7838 iproc=itask_cont_to(ii)
7840 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7841 & FG_COMM,req(ireq),IERR)
7843 c write (iout,*) "ISEND ended"
7844 c write (iout,*) "number of requests (nn)",ireq
7847 & call MPI_Waitall(ireq,req,status_array,ierr)
7849 c & "Numbers of contacts to be received from other processors",
7850 c & (ncont_recv(i),i=1,ntask_cont_from)
7854 do ii=1,ntask_cont_from
7855 iproc=itask_cont_from(ii)
7857 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7858 c & " of CONT_TO_COMM group"
7862 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7863 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7864 c write (iout,*) "ireq,req",ireq,req(ireq)
7867 C Send the contacts to processors that need them
7868 do ii=1,ntask_cont_to
7869 iproc=itask_cont_to(ii)
7871 c write (iout,*) nn," contacts to processor",iproc,
7872 c & " of CONT_TO_COMM group"
7875 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7876 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7877 c write (iout,*) "ireq,req",ireq,req(ireq)
7879 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7883 c write (iout,*) "number of requests (contacts)",ireq
7884 c write (iout,*) "req",(req(i),i=1,4)
7887 & call MPI_Waitall(ireq,req,status_array,ierr)
7888 do iii=1,ntask_cont_from
7889 iproc=itask_cont_from(iii)
7892 write (iout,*) "Received",nn," contacts from processor",iproc,
7893 & " of CONT_FROM_COMM group"
7896 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7901 ii=zapas_recv(1,i,iii)
7902 c Flag the received contacts to prevent double-counting
7903 jj=-zapas_recv(2,i,iii)
7904 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7906 nnn=num_cont_hb(ii)+1
7909 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7913 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7918 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7926 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7935 write (iout,'(a)') 'Contact function values after receive:'
7937 write (iout,'(2i3,50(1x,i3,5f6.3))')
7938 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7939 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7946 write (iout,'(a)') 'Contact function values:'
7948 write (iout,'(2i3,50(1x,i2,5f6.3))')
7949 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7950 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7956 C Remove the loop below after debugging !!!
7963 C Calculate the dipole-dipole interaction energies
7964 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7965 do i=iatel_s,iatel_e+1
7966 num_conti=num_cont_hb(i)
7975 C Calculate the local-electrostatic correlation terms
7976 c write (iout,*) "gradcorr5 in eello5 before loop"
7978 c write (iout,'(i5,3f10.5)')
7979 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7981 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7982 c write (iout,*) "corr loop i",i
7984 num_conti=num_cont_hb(i)
7985 num_conti1=num_cont_hb(i+1)
7992 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7993 c & ' jj=',jj,' kk=',kk
7994 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7995 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7996 & .or. j.lt.0 .and. j1.gt.0) .and.
7997 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7998 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7999 C The system gains extra energy.
8001 sqd1=dsqrt(d_cont(jj,i))
8002 sqd2=dsqrt(d_cont(kk,i1))
8003 sred_geom = sqd1*sqd2
8004 IF (sred_geom.lt.cutoff_corr) THEN
8005 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
8007 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8008 cd & ' jj=',jj,' kk=',kk
8009 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8010 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8012 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8013 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8016 cd write (iout,*) 'sred_geom=',sred_geom,
8017 cd & ' ekont=',ekont,' fprim=',fprimcont,
8018 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8019 cd write (iout,*) "g_contij",g_contij
8020 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8021 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8022 call calc_eello(i,jp,i+1,jp1,jj,kk)
8023 if (wcorr4.gt.0.0d0)
8024 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8025 if (energy_dec.and.wcorr4.gt.0.0d0)
8026 1 write (iout,'(a6,4i5,0pf7.3)')
8027 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8028 c write (iout,*) "gradcorr5 before eello5"
8030 c write (iout,'(i5,3f10.5)')
8031 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8033 if (wcorr5.gt.0.0d0)
8034 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8035 c write (iout,*) "gradcorr5 after eello5"
8037 c write (iout,'(i5,3f10.5)')
8038 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8040 if (energy_dec.and.wcorr5.gt.0.0d0)
8041 1 write (iout,'(a6,4i5,0pf7.3)')
8042 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8043 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8044 cd write(2,*)'ijkl',i,jp,i+1,jp1
8045 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
8046 & .or. wturn6.eq.0.0d0))then
8047 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8048 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8049 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8050 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8051 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8052 cd & 'ecorr6=',ecorr6
8053 cd write (iout,'(4e15.5)') sred_geom,
8054 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8055 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8056 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8057 else if (wturn6.gt.0.0d0
8058 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8059 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8060 eturn6=eturn6+eello_turn6(i,jj,kk)
8061 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8062 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8063 cd write (2,*) 'multibody_eello:eturn6',eturn6
8072 num_cont_hb(i)=num_cont_hb_old(i)
8074 c write (iout,*) "gradcorr5 in eello5"
8076 c write (iout,'(i5,3f10.5)')
8077 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8081 c------------------------------------------------------------------------------
8082 subroutine add_hb_contact_eello(ii,jj,itask)
8083 implicit real*8 (a-h,o-z)
8084 include "DIMENSIONS"
8085 include "COMMON.IOUNITS"
8088 parameter (max_cont=maxconts)
8089 parameter (max_dim=70)
8090 include "COMMON.CONTACTS"
8091 double precision zapas(max_dim,maxconts,max_fg_procs),
8092 & zapas_recv(max_dim,maxconts,max_fg_procs)
8093 common /przechowalnia/ zapas
8094 integer i,j,ii,jj,iproc,itask(4),nn
8095 c write (iout,*) "itask",itask
8098 if (iproc.gt.0) then
8099 do j=1,num_cont_hb(ii)
8101 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8103 ncont_sent(iproc)=ncont_sent(iproc)+1
8104 nn=ncont_sent(iproc)
8105 zapas(1,nn,iproc)=ii
8106 zapas(2,nn,iproc)=jjc
8107 zapas(3,nn,iproc)=d_cont(j,ii)
8111 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8116 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8124 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8136 c------------------------------------------------------------------------------
8137 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8138 implicit real*8 (a-h,o-z)
8139 include 'DIMENSIONS'
8140 include 'COMMON.IOUNITS'
8141 include 'COMMON.DERIV'
8142 include 'COMMON.INTERACT'
8143 include 'COMMON.CONTACTS'
8144 double precision gx(3),gx1(3)
8154 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8155 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8156 C Following 4 lines for diagnostics.
8161 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8162 c & 'Contacts ',i,j,
8163 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8164 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8166 C Calculate the multi-body contribution to energy.
8167 c ecorr=ecorr+ekont*ees
8168 C Calculate multi-body contributions to the gradient.
8169 coeffpees0pij=coeffp*ees0pij
8170 coeffmees0mij=coeffm*ees0mij
8171 coeffpees0pkl=coeffp*ees0pkl
8172 coeffmees0mkl=coeffm*ees0mkl
8174 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8175 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8176 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8177 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8178 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8179 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8180 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8181 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8182 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8183 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8184 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8185 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8186 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8187 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8188 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8189 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8190 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8191 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8192 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8193 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8194 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8195 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8196 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8197 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8198 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8203 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8204 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8205 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8206 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8211 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8212 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8213 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8214 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8217 c write (iout,*) "ehbcorr",ekont*ees
8222 C---------------------------------------------------------------------------
8223 subroutine dipole(i,j,jj)
8224 implicit real*8 (a-h,o-z)
8225 include 'DIMENSIONS'
8226 include 'COMMON.IOUNITS'
8227 include 'COMMON.CHAIN'
8228 include 'COMMON.FFIELD'
8229 include 'COMMON.DERIV'
8230 include 'COMMON.INTERACT'
8231 include 'COMMON.CONTACTS'
8232 include 'COMMON.TORSION'
8233 include 'COMMON.VAR'
8234 include 'COMMON.GEO'
8235 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8237 iti1 = itortyp(itype(i+1))
8238 if (j.lt.nres-1) then
8239 itj1 = itortyp(itype(j+1))
8244 dipi(iii,1)=Ub2(iii,i)
8245 dipderi(iii)=Ub2der(iii,i)
8246 dipi(iii,2)=b1(iii,i+1)
8247 dipj(iii,1)=Ub2(iii,j)
8248 dipderj(iii)=Ub2der(iii,j)
8249 dipj(iii,2)=b1(iii,j+1)
8253 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8256 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8263 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8267 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8272 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8273 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8275 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8277 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8279 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8284 C---------------------------------------------------------------------------
8285 subroutine calc_eello(i,j,k,l,jj,kk)
8287 C This subroutine computes matrices and vectors needed to calculate
8288 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8290 implicit real*8 (a-h,o-z)
8291 include 'DIMENSIONS'
8292 include 'COMMON.IOUNITS'
8293 include 'COMMON.CHAIN'
8294 include 'COMMON.DERIV'
8295 include 'COMMON.INTERACT'
8296 include 'COMMON.CONTACTS'
8297 include 'COMMON.TORSION'
8298 include 'COMMON.VAR'
8299 include 'COMMON.GEO'
8300 include 'COMMON.FFIELD'
8301 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8302 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8305 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8306 cd & ' jj=',jj,' kk=',kk
8307 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8308 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8309 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8312 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8313 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8316 call transpose2(aa1(1,1),aa1t(1,1))
8317 call transpose2(aa2(1,1),aa2t(1,1))
8320 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8321 & aa1tder(1,1,lll,kkk))
8322 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8323 & aa2tder(1,1,lll,kkk))
8327 C parallel orientation of the two CA-CA-CA frames.
8329 iti=itortyp(itype(i))
8333 itk1=itortyp(itype(k+1))
8334 itj=itortyp(itype(j))
8335 if (l.lt.nres-1) then
8336 itl1=itortyp(itype(l+1))
8340 C A1 kernel(j+1) A2T
8342 cd write (iout,'(3f10.5,5x,3f10.5)')
8343 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8345 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8346 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8347 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8348 C Following matrices are needed only for 6-th order cumulants
8349 IF (wcorr6.gt.0.0d0) THEN
8350 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8351 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8352 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8353 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8354 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8355 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8356 & ADtEAderx(1,1,1,1,1,1))
8358 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8359 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8360 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8361 & ADtEA1derx(1,1,1,1,1,1))
8363 C End 6-th order cumulants
8366 cd write (2,*) 'In calc_eello6'
8368 cd write (2,*) 'iii=',iii
8370 cd write (2,*) 'kkk=',kkk
8372 cd write (2,'(3(2f10.5),5x)')
8373 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8378 call transpose2(EUgder(1,1,k),auxmat(1,1))
8379 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8380 call transpose2(EUg(1,1,k),auxmat(1,1))
8381 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8382 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8386 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8387 & EAEAderx(1,1,lll,kkk,iii,1))
8391 C A1T kernel(i+1) A2
8392 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8393 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8394 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8395 C Following matrices are needed only for 6-th order cumulants
8396 IF (wcorr6.gt.0.0d0) THEN
8397 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8398 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8399 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8400 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8401 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8402 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8403 & ADtEAderx(1,1,1,1,1,2))
8404 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8405 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8406 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8407 & ADtEA1derx(1,1,1,1,1,2))
8409 C End 6-th order cumulants
8410 call transpose2(EUgder(1,1,l),auxmat(1,1))
8411 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8412 call transpose2(EUg(1,1,l),auxmat(1,1))
8413 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8414 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8418 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8419 & EAEAderx(1,1,lll,kkk,iii,2))
8424 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8425 C They are needed only when the fifth- or the sixth-order cumulants are
8427 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8428 call transpose2(AEA(1,1,1),auxmat(1,1))
8429 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8430 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8431 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8432 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8433 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8434 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8435 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8436 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8437 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8438 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8439 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8440 call transpose2(AEA(1,1,2),auxmat(1,1))
8441 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8442 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8443 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8444 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8445 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8446 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8447 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8448 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8449 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8450 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8451 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8452 C Calculate the Cartesian derivatives of the vectors.
8456 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8457 call matvec2(auxmat(1,1),b1(1,i),
8458 & AEAb1derx(1,lll,kkk,iii,1,1))
8459 call matvec2(auxmat(1,1),Ub2(1,i),
8460 & AEAb2derx(1,lll,kkk,iii,1,1))
8461 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8462 & AEAb1derx(1,lll,kkk,iii,2,1))
8463 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8464 & AEAb2derx(1,lll,kkk,iii,2,1))
8465 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8466 call matvec2(auxmat(1,1),b1(1,j),
8467 & AEAb1derx(1,lll,kkk,iii,1,2))
8468 call matvec2(auxmat(1,1),Ub2(1,j),
8469 & AEAb2derx(1,lll,kkk,iii,1,2))
8470 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8471 & AEAb1derx(1,lll,kkk,iii,2,2))
8472 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8473 & AEAb2derx(1,lll,kkk,iii,2,2))
8480 C Antiparallel orientation of the two CA-CA-CA frames.
8482 iti=itortyp(itype(i))
8486 itk1=itortyp(itype(k+1))
8487 itl=itortyp(itype(l))
8488 itj=itortyp(itype(j))
8489 if (j.lt.nres-1) then
8490 itj1=itortyp(itype(j+1))
8494 C A2 kernel(j-1)T A1T
8495 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8496 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8497 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8498 C Following matrices are needed only for 6-th order cumulants
8499 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8500 & j.eq.i+4 .and. l.eq.i+3)) THEN
8501 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8502 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8503 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8504 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8505 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8506 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8507 & ADtEAderx(1,1,1,1,1,1))
8508 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8509 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8510 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8511 & ADtEA1derx(1,1,1,1,1,1))
8513 C End 6-th order cumulants
8514 call transpose2(EUgder(1,1,k),auxmat(1,1))
8515 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8516 call transpose2(EUg(1,1,k),auxmat(1,1))
8517 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8518 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8522 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8523 & EAEAderx(1,1,lll,kkk,iii,1))
8527 C A2T kernel(i+1)T A1
8528 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8529 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8530 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8531 C Following matrices are needed only for 6-th order cumulants
8532 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8533 & j.eq.i+4 .and. l.eq.i+3)) THEN
8534 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8535 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8536 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8537 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8538 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8539 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8540 & ADtEAderx(1,1,1,1,1,2))
8541 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8542 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8543 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8544 & ADtEA1derx(1,1,1,1,1,2))
8546 C End 6-th order cumulants
8547 call transpose2(EUgder(1,1,j),auxmat(1,1))
8548 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8549 call transpose2(EUg(1,1,j),auxmat(1,1))
8550 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8551 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8555 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8556 & EAEAderx(1,1,lll,kkk,iii,2))
8561 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8562 C They are needed only when the fifth- or the sixth-order cumulants are
8564 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8565 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8566 call transpose2(AEA(1,1,1),auxmat(1,1))
8567 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8568 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8569 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8570 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8571 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8572 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8573 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8574 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8575 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8576 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8577 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8578 call transpose2(AEA(1,1,2),auxmat(1,1))
8579 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8580 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8581 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8582 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8583 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8584 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8585 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8586 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8587 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8588 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8589 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8590 C Calculate the Cartesian derivatives of the vectors.
8594 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8595 call matvec2(auxmat(1,1),b1(1,i),
8596 & AEAb1derx(1,lll,kkk,iii,1,1))
8597 call matvec2(auxmat(1,1),Ub2(1,i),
8598 & AEAb2derx(1,lll,kkk,iii,1,1))
8599 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8600 & AEAb1derx(1,lll,kkk,iii,2,1))
8601 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8602 & AEAb2derx(1,lll,kkk,iii,2,1))
8603 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8604 call matvec2(auxmat(1,1),b1(1,l),
8605 & AEAb1derx(1,lll,kkk,iii,1,2))
8606 call matvec2(auxmat(1,1),Ub2(1,l),
8607 & AEAb2derx(1,lll,kkk,iii,1,2))
8608 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8609 & AEAb1derx(1,lll,kkk,iii,2,2))
8610 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8611 & AEAb2derx(1,lll,kkk,iii,2,2))
8620 C---------------------------------------------------------------------------
8621 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8622 & KK,KKderg,AKA,AKAderg,AKAderx)
8626 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8627 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8628 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8633 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8635 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8638 cd if (lprn) write (2,*) 'In kernel'
8640 cd if (lprn) write (2,*) 'kkk=',kkk
8642 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8643 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8645 cd write (2,*) 'lll=',lll
8646 cd write (2,*) 'iii=1'
8648 cd write (2,'(3(2f10.5),5x)')
8649 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8652 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8653 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8655 cd write (2,*) 'lll=',lll
8656 cd write (2,*) 'iii=2'
8658 cd write (2,'(3(2f10.5),5x)')
8659 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8666 C---------------------------------------------------------------------------
8667 double precision function eello4(i,j,k,l,jj,kk)
8668 implicit real*8 (a-h,o-z)
8669 include 'DIMENSIONS'
8670 include 'COMMON.IOUNITS'
8671 include 'COMMON.CHAIN'
8672 include 'COMMON.DERIV'
8673 include 'COMMON.INTERACT'
8674 include 'COMMON.CONTACTS'
8675 include 'COMMON.TORSION'
8676 include 'COMMON.VAR'
8677 include 'COMMON.GEO'
8678 double precision pizda(2,2),ggg1(3),ggg2(3)
8679 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8683 cd print *,'eello4:',i,j,k,l,jj,kk
8684 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8685 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8686 cold eij=facont_hb(jj,i)
8687 cold ekl=facont_hb(kk,k)
8689 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8690 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8691 gcorr_loc(k-1)=gcorr_loc(k-1)
8692 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8694 gcorr_loc(l-1)=gcorr_loc(l-1)
8695 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8697 gcorr_loc(j-1)=gcorr_loc(j-1)
8698 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8703 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8704 & -EAEAderx(2,2,lll,kkk,iii,1)
8705 cd derx(lll,kkk,iii)=0.0d0
8709 cd gcorr_loc(l-1)=0.0d0
8710 cd gcorr_loc(j-1)=0.0d0
8711 cd gcorr_loc(k-1)=0.0d0
8713 cd write (iout,*)'Contacts have occurred for peptide groups',
8714 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8715 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8716 if (j.lt.nres-1) then
8723 if (l.lt.nres-1) then
8731 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8732 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8733 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8734 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8735 cgrad ghalf=0.5d0*ggg1(ll)
8736 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8737 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8738 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8739 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8740 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8741 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8742 cgrad ghalf=0.5d0*ggg2(ll)
8743 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8744 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8745 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8746 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8747 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8748 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8752 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8757 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8762 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8767 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8771 cd write (2,*) iii,gcorr_loc(iii)
8774 cd write (2,*) 'ekont',ekont
8775 cd write (iout,*) 'eello4',ekont*eel4
8778 C---------------------------------------------------------------------------
8779 double precision function eello5(i,j,k,l,jj,kk)
8780 implicit real*8 (a-h,o-z)
8781 include 'DIMENSIONS'
8782 include 'COMMON.IOUNITS'
8783 include 'COMMON.CHAIN'
8784 include 'COMMON.DERIV'
8785 include 'COMMON.INTERACT'
8786 include 'COMMON.CONTACTS'
8787 include 'COMMON.TORSION'
8788 include 'COMMON.VAR'
8789 include 'COMMON.GEO'
8790 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8791 double precision ggg1(3),ggg2(3)
8792 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8797 C /l\ / \ \ / \ / \ / C
8798 C / \ / \ \ / \ / \ / C
8799 C j| o |l1 | o | o| o | | o |o C
8800 C \ |/k\| |/ \| / |/ \| |/ \| C
8801 C \i/ \ / \ / / \ / \ C
8803 C (I) (II) (III) (IV) C
8805 C eello5_1 eello5_2 eello5_3 eello5_4 C
8807 C Antiparallel chains C
8810 C /j\ / \ \ / \ / \ / C
8811 C / \ / \ \ / \ / \ / C
8812 C j1| o |l | o | o| o | | o |o C
8813 C \ |/k\| |/ \| / |/ \| |/ \| C
8814 C \i/ \ / \ / / \ / \ C
8816 C (I) (II) (III) (IV) C
8818 C eello5_1 eello5_2 eello5_3 eello5_4 C
8820 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8822 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8823 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8828 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8830 itk=itortyp(itype(k))
8831 itl=itortyp(itype(l))
8832 itj=itortyp(itype(j))
8837 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8838 cd & eel5_3_num,eel5_4_num)
8842 derx(lll,kkk,iii)=0.0d0
8846 cd eij=facont_hb(jj,i)
8847 cd ekl=facont_hb(kk,k)
8849 cd write (iout,*)'Contacts have occurred for peptide groups',
8850 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8852 C Contribution from the graph I.
8853 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8854 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8855 call transpose2(EUg(1,1,k),auxmat(1,1))
8856 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8857 vv(1)=pizda(1,1)-pizda(2,2)
8858 vv(2)=pizda(1,2)+pizda(2,1)
8859 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8860 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8861 C Explicit gradient in virtual-dihedral angles.
8862 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8863 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8864 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8865 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8866 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8867 vv(1)=pizda(1,1)-pizda(2,2)
8868 vv(2)=pizda(1,2)+pizda(2,1)
8869 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8870 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8871 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8872 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8873 vv(1)=pizda(1,1)-pizda(2,2)
8874 vv(2)=pizda(1,2)+pizda(2,1)
8876 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8877 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8878 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8880 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8881 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8882 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8884 C Cartesian gradient
8888 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8890 vv(1)=pizda(1,1)-pizda(2,2)
8891 vv(2)=pizda(1,2)+pizda(2,1)
8892 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8893 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8894 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8900 C Contribution from graph II
8901 call transpose2(EE(1,1,itk),auxmat(1,1))
8902 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8903 vv(1)=pizda(1,1)+pizda(2,2)
8904 vv(2)=pizda(2,1)-pizda(1,2)
8905 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8906 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8907 C Explicit gradient in virtual-dihedral angles.
8908 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8909 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8910 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8911 vv(1)=pizda(1,1)+pizda(2,2)
8912 vv(2)=pizda(2,1)-pizda(1,2)
8914 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8915 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8916 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8918 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8919 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8920 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8922 C Cartesian gradient
8926 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8928 vv(1)=pizda(1,1)+pizda(2,2)
8929 vv(2)=pizda(2,1)-pizda(1,2)
8930 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8931 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8932 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8940 C Parallel orientation
8941 C Contribution from graph III
8942 call transpose2(EUg(1,1,l),auxmat(1,1))
8943 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8944 vv(1)=pizda(1,1)-pizda(2,2)
8945 vv(2)=pizda(1,2)+pizda(2,1)
8946 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8947 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8948 C Explicit gradient in virtual-dihedral angles.
8949 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8950 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8951 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8952 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8953 vv(1)=pizda(1,1)-pizda(2,2)
8954 vv(2)=pizda(1,2)+pizda(2,1)
8955 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8956 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8957 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8958 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8959 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8960 vv(1)=pizda(1,1)-pizda(2,2)
8961 vv(2)=pizda(1,2)+pizda(2,1)
8962 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8963 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8964 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8965 C Cartesian gradient
8969 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8971 vv(1)=pizda(1,1)-pizda(2,2)
8972 vv(2)=pizda(1,2)+pizda(2,1)
8973 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8974 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8975 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8980 C Contribution from graph IV
8982 call transpose2(EE(1,1,itl),auxmat(1,1))
8983 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8984 vv(1)=pizda(1,1)+pizda(2,2)
8985 vv(2)=pizda(2,1)-pizda(1,2)
8986 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8987 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8988 C Explicit gradient in virtual-dihedral angles.
8989 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8990 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8991 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8992 vv(1)=pizda(1,1)+pizda(2,2)
8993 vv(2)=pizda(2,1)-pizda(1,2)
8994 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8995 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8996 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8997 C Cartesian gradient
9001 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9003 vv(1)=pizda(1,1)+pizda(2,2)
9004 vv(2)=pizda(2,1)-pizda(1,2)
9005 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9006 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
9007 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9012 C Antiparallel orientation
9013 C Contribution from graph III
9015 call transpose2(EUg(1,1,j),auxmat(1,1))
9016 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9017 vv(1)=pizda(1,1)-pizda(2,2)
9018 vv(2)=pizda(1,2)+pizda(2,1)
9019 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9020 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9021 C Explicit gradient in virtual-dihedral angles.
9022 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9023 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9024 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9025 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9026 vv(1)=pizda(1,1)-pizda(2,2)
9027 vv(2)=pizda(1,2)+pizda(2,1)
9028 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9029 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9030 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9031 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9032 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9033 vv(1)=pizda(1,1)-pizda(2,2)
9034 vv(2)=pizda(1,2)+pizda(2,1)
9035 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9036 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9037 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9038 C Cartesian gradient
9042 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9044 vv(1)=pizda(1,1)-pizda(2,2)
9045 vv(2)=pizda(1,2)+pizda(2,1)
9046 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9047 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9048 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9053 C Contribution from graph IV
9055 call transpose2(EE(1,1,itj),auxmat(1,1))
9056 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9057 vv(1)=pizda(1,1)+pizda(2,2)
9058 vv(2)=pizda(2,1)-pizda(1,2)
9059 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9060 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9061 C Explicit gradient in virtual-dihedral angles.
9062 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9063 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9064 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9065 vv(1)=pizda(1,1)+pizda(2,2)
9066 vv(2)=pizda(2,1)-pizda(1,2)
9067 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9068 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9069 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9070 C Cartesian gradient
9074 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9076 vv(1)=pizda(1,1)+pizda(2,2)
9077 vv(2)=pizda(2,1)-pizda(1,2)
9078 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9079 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9080 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9086 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9087 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9088 cd write (2,*) 'ijkl',i,j,k,l
9089 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9090 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9092 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9093 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9094 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9095 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9096 if (j.lt.nres-1) then
9103 if (l.lt.nres-1) then
9113 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9114 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9115 C summed up outside the subrouine as for the other subroutines
9116 C handling long-range interactions. The old code is commented out
9117 C with "cgrad" to keep track of changes.
9119 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9120 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9121 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9122 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9123 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9124 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9125 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9126 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9127 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9128 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9130 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9131 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9132 cgrad ghalf=0.5d0*ggg1(ll)
9134 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9135 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9136 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9137 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9138 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9139 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9140 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9141 cgrad ghalf=0.5d0*ggg2(ll)
9143 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
9144 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9145 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
9146 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9147 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9148 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9153 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9154 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9159 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9160 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9166 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9171 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9175 cd write (2,*) iii,g_corr5_loc(iii)
9178 cd write (2,*) 'ekont',ekont
9179 cd write (iout,*) 'eello5',ekont*eel5
9182 c--------------------------------------------------------------------------
9183 double precision function eello6(i,j,k,l,jj,kk)
9184 implicit real*8 (a-h,o-z)
9185 include 'DIMENSIONS'
9186 include 'COMMON.IOUNITS'
9187 include 'COMMON.CHAIN'
9188 include 'COMMON.DERIV'
9189 include 'COMMON.INTERACT'
9190 include 'COMMON.CONTACTS'
9191 include 'COMMON.TORSION'
9192 include 'COMMON.VAR'
9193 include 'COMMON.GEO'
9194 include 'COMMON.FFIELD'
9195 double precision ggg1(3),ggg2(3)
9196 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9201 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9209 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9210 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9214 derx(lll,kkk,iii)=0.0d0
9218 cd eij=facont_hb(jj,i)
9219 cd ekl=facont_hb(kk,k)
9225 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9226 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9227 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9228 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9229 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9230 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9232 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9233 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9234 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9235 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9236 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9237 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9241 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9243 C If turn contributions are considered, they will be handled separately.
9244 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9245 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9246 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9247 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9248 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9249 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9250 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9252 if (j.lt.nres-1) then
9259 if (l.lt.nres-1) then
9267 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9268 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9269 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9270 cgrad ghalf=0.5d0*ggg1(ll)
9272 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9273 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9274 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9275 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9276 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9277 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9278 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9279 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9280 cgrad ghalf=0.5d0*ggg2(ll)
9281 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9283 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9284 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9285 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9286 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9287 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9288 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9293 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9294 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9299 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9300 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9306 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9311 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9315 cd write (2,*) iii,g_corr6_loc(iii)
9318 cd write (2,*) 'ekont',ekont
9319 cd write (iout,*) 'eello6',ekont*eel6
9322 c--------------------------------------------------------------------------
9323 double precision function eello6_graph1(i,j,k,l,imat,swap)
9324 implicit real*8 (a-h,o-z)
9325 include 'DIMENSIONS'
9326 include 'COMMON.IOUNITS'
9327 include 'COMMON.CHAIN'
9328 include 'COMMON.DERIV'
9329 include 'COMMON.INTERACT'
9330 include 'COMMON.CONTACTS'
9331 include 'COMMON.TORSION'
9332 include 'COMMON.VAR'
9333 include 'COMMON.GEO'
9334 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9338 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9340 C Parallel Antiparallel C
9346 C \ j|/k\| / \ |/k\|l / C
9351 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9352 itk=itortyp(itype(k))
9353 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9354 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9355 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9356 call transpose2(EUgC(1,1,k),auxmat(1,1))
9357 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9358 vv1(1)=pizda1(1,1)-pizda1(2,2)
9359 vv1(2)=pizda1(1,2)+pizda1(2,1)
9360 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9361 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9362 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9363 s5=scalar2(vv(1),Dtobr2(1,i))
9364 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9365 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9366 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9367 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9368 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9369 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9370 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9371 & +scalar2(vv(1),Dtobr2der(1,i)))
9372 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9373 vv1(1)=pizda1(1,1)-pizda1(2,2)
9374 vv1(2)=pizda1(1,2)+pizda1(2,1)
9375 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9376 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9378 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9379 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9380 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9381 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9382 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9384 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9385 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9386 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9387 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9388 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9390 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9391 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9392 vv1(1)=pizda1(1,1)-pizda1(2,2)
9393 vv1(2)=pizda1(1,2)+pizda1(2,1)
9394 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9395 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9396 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9397 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9406 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9407 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9408 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9409 call transpose2(EUgC(1,1,k),auxmat(1,1))
9410 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9412 vv1(1)=pizda1(1,1)-pizda1(2,2)
9413 vv1(2)=pizda1(1,2)+pizda1(2,1)
9414 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9415 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9416 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9417 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9418 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9419 s5=scalar2(vv(1),Dtobr2(1,i))
9420 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9426 c----------------------------------------------------------------------------
9427 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9428 implicit real*8 (a-h,o-z)
9429 include 'DIMENSIONS'
9430 include 'COMMON.IOUNITS'
9431 include 'COMMON.CHAIN'
9432 include 'COMMON.DERIV'
9433 include 'COMMON.INTERACT'
9434 include 'COMMON.CONTACTS'
9435 include 'COMMON.TORSION'
9436 include 'COMMON.VAR'
9437 include 'COMMON.GEO'
9439 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9440 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9443 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9445 C Parallel Antiparallel C
9451 C \ j|/k\| \ |/k\|l C
9456 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9457 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9458 C AL 7/4/01 s1 would occur in the sixth-order moment,
9459 C but not in a cluster cumulant
9461 s1=dip(1,jj,i)*dip(1,kk,k)
9463 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9464 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9465 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9466 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9467 call transpose2(EUg(1,1,k),auxmat(1,1))
9468 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9469 vv(1)=pizda(1,1)-pizda(2,2)
9470 vv(2)=pizda(1,2)+pizda(2,1)
9471 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9472 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9474 eello6_graph2=-(s1+s2+s3+s4)
9476 eello6_graph2=-(s2+s3+s4)
9479 C Derivatives in gamma(i-1)
9482 s1=dipderg(1,jj,i)*dip(1,kk,k)
9484 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9485 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9486 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9487 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9489 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9491 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9493 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9495 C Derivatives in gamma(k-1)
9497 s1=dip(1,jj,i)*dipderg(1,kk,k)
9499 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9500 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9501 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9502 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9503 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9504 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9505 vv(1)=pizda(1,1)-pizda(2,2)
9506 vv(2)=pizda(1,2)+pizda(2,1)
9507 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9509 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9511 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9513 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9514 C Derivatives in gamma(j-1) or gamma(l-1)
9517 s1=dipderg(3,jj,i)*dip(1,kk,k)
9519 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9520 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9521 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9522 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9523 vv(1)=pizda(1,1)-pizda(2,2)
9524 vv(2)=pizda(1,2)+pizda(2,1)
9525 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9528 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9530 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9533 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9534 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9536 C Derivatives in gamma(l-1) or gamma(j-1)
9539 s1=dip(1,jj,i)*dipderg(3,kk,k)
9541 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9542 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9543 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9544 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9545 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9546 vv(1)=pizda(1,1)-pizda(2,2)
9547 vv(2)=pizda(1,2)+pizda(2,1)
9548 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9551 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9553 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9556 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9557 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9559 C Cartesian derivatives.
9561 write (2,*) 'In eello6_graph2'
9563 write (2,*) 'iii=',iii
9565 write (2,*) 'kkk=',kkk
9567 write (2,'(3(2f10.5),5x)')
9568 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9578 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9580 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9583 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9585 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9586 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9588 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9589 call transpose2(EUg(1,1,k),auxmat(1,1))
9590 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9592 vv(1)=pizda(1,1)-pizda(2,2)
9593 vv(2)=pizda(1,2)+pizda(2,1)
9594 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9595 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9597 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9599 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9602 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9604 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9611 c----------------------------------------------------------------------------
9612 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9613 implicit real*8 (a-h,o-z)
9614 include 'DIMENSIONS'
9615 include 'COMMON.IOUNITS'
9616 include 'COMMON.CHAIN'
9617 include 'COMMON.DERIV'
9618 include 'COMMON.INTERACT'
9619 include 'COMMON.CONTACTS'
9620 include 'COMMON.TORSION'
9621 include 'COMMON.VAR'
9622 include 'COMMON.GEO'
9623 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9625 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9627 C Parallel Antiparallel C
9633 C j|/k\| / |/k\|l / C
9638 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9640 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9641 C energy moment and not to the cluster cumulant.
9642 iti=itortyp(itype(i))
9643 if (j.lt.nres-1) then
9644 itj1=itortyp(itype(j+1))
9648 itk=itortyp(itype(k))
9649 itk1=itortyp(itype(k+1))
9650 if (l.lt.nres-1) then
9651 itl1=itortyp(itype(l+1))
9656 s1=dip(4,jj,i)*dip(4,kk,k)
9658 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9659 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9660 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9661 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9662 call transpose2(EE(1,1,itk),auxmat(1,1))
9663 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9664 vv(1)=pizda(1,1)+pizda(2,2)
9665 vv(2)=pizda(2,1)-pizda(1,2)
9666 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9667 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9668 cd & "sum",-(s2+s3+s4)
9670 eello6_graph3=-(s1+s2+s3+s4)
9672 eello6_graph3=-(s2+s3+s4)
9675 C Derivatives in gamma(k-1)
9676 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9677 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9678 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9679 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9680 C Derivatives in gamma(l-1)
9681 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9682 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9683 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9684 vv(1)=pizda(1,1)+pizda(2,2)
9685 vv(2)=pizda(2,1)-pizda(1,2)
9686 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9687 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9688 C Cartesian derivatives.
9694 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9696 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9699 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9701 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9702 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9704 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9705 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9707 vv(1)=pizda(1,1)+pizda(2,2)
9708 vv(2)=pizda(2,1)-pizda(1,2)
9709 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9711 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9713 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9716 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9718 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9720 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9726 c----------------------------------------------------------------------------
9727 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9728 implicit real*8 (a-h,o-z)
9729 include 'DIMENSIONS'
9730 include 'COMMON.IOUNITS'
9731 include 'COMMON.CHAIN'
9732 include 'COMMON.DERIV'
9733 include 'COMMON.INTERACT'
9734 include 'COMMON.CONTACTS'
9735 include 'COMMON.TORSION'
9736 include 'COMMON.VAR'
9737 include 'COMMON.GEO'
9738 include 'COMMON.FFIELD'
9739 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9740 & auxvec1(2),auxmat1(2,2)
9742 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9744 C Parallel Antiparallel C
9750 C \ j|/k\| \ |/k\|l C
9755 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9757 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9758 C energy moment and not to the cluster cumulant.
9759 cd write (2,*) 'eello_graph4: wturn6',wturn6
9760 iti=itortyp(itype(i))
9761 itj=itortyp(itype(j))
9762 if (j.lt.nres-1) then
9763 itj1=itortyp(itype(j+1))
9767 itk=itortyp(itype(k))
9768 if (k.lt.nres-1) then
9769 itk1=itortyp(itype(k+1))
9773 itl=itortyp(itype(l))
9774 if (l.lt.nres-1) then
9775 itl1=itortyp(itype(l+1))
9779 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9780 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9781 cd & ' itl',itl,' itl1',itl1
9784 s1=dip(3,jj,i)*dip(3,kk,k)
9786 s1=dip(2,jj,j)*dip(2,kk,l)
9789 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9790 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9792 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9793 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9795 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9796 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9798 call transpose2(EUg(1,1,k),auxmat(1,1))
9799 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9800 vv(1)=pizda(1,1)-pizda(2,2)
9801 vv(2)=pizda(2,1)+pizda(1,2)
9802 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9803 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9805 eello6_graph4=-(s1+s2+s3+s4)
9807 eello6_graph4=-(s2+s3+s4)
9809 C Derivatives in gamma(i-1)
9813 s1=dipderg(2,jj,i)*dip(3,kk,k)
9815 s1=dipderg(4,jj,j)*dip(2,kk,l)
9818 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9820 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9821 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9823 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9824 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9826 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9827 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9828 cd write (2,*) 'turn6 derivatives'
9830 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9832 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9836 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9838 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9842 C Derivatives in gamma(k-1)
9845 s1=dip(3,jj,i)*dipderg(2,kk,k)
9847 s1=dip(2,jj,j)*dipderg(4,kk,l)
9850 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9851 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9853 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9854 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9856 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9857 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9859 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9860 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9861 vv(1)=pizda(1,1)-pizda(2,2)
9862 vv(2)=pizda(2,1)+pizda(1,2)
9863 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9864 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9866 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9868 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9872 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9874 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9877 C Derivatives in gamma(j-1) or gamma(l-1)
9878 if (l.eq.j+1 .and. l.gt.1) then
9879 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9880 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9881 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9882 vv(1)=pizda(1,1)-pizda(2,2)
9883 vv(2)=pizda(2,1)+pizda(1,2)
9884 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9885 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9886 else if (j.gt.1) then
9887 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9888 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9889 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9890 vv(1)=pizda(1,1)-pizda(2,2)
9891 vv(2)=pizda(2,1)+pizda(1,2)
9892 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9893 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9894 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9896 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9899 C Cartesian derivatives.
9906 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9908 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9912 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9914 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9918 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9920 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9922 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9923 & b1(1,j+1),auxvec(1))
9924 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9926 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9927 & b1(1,l+1),auxvec(1))
9928 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9930 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9932 vv(1)=pizda(1,1)-pizda(2,2)
9933 vv(2)=pizda(2,1)+pizda(1,2)
9934 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9936 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9938 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9941 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9944 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9947 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9949 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9951 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9955 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9957 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9960 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9962 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9970 c----------------------------------------------------------------------------
9971 double precision function eello_turn6(i,jj,kk)
9972 implicit real*8 (a-h,o-z)
9973 include 'DIMENSIONS'
9974 include 'COMMON.IOUNITS'
9975 include 'COMMON.CHAIN'
9976 include 'COMMON.DERIV'
9977 include 'COMMON.INTERACT'
9978 include 'COMMON.CONTACTS'
9979 include 'COMMON.TORSION'
9980 include 'COMMON.VAR'
9981 include 'COMMON.GEO'
9982 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9983 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9985 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9986 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9987 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9988 C the respective energy moment and not to the cluster cumulant.
9997 iti=itortyp(itype(i))
9998 itk=itortyp(itype(k))
9999 itk1=itortyp(itype(k+1))
10000 itl=itortyp(itype(l))
10001 itj=itortyp(itype(j))
10002 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10003 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
10004 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10009 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10011 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10015 derx_turn(lll,kkk,iii)=0.0d0
10022 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10024 cd write (2,*) 'eello6_5',eello6_5
10026 call transpose2(AEA(1,1,1),auxmat(1,1))
10027 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10028 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10029 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10031 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10032 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10033 s2 = scalar2(b1(1,k),vtemp1(1))
10035 call transpose2(AEA(1,1,2),atemp(1,1))
10036 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10037 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10038 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10040 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10041 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10042 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10044 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10045 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10046 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10047 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10048 ss13 = scalar2(b1(1,k),vtemp4(1))
10049 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10051 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10057 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10058 C Derivatives in gamma(i+2)
10062 call transpose2(AEA(1,1,1),auxmatd(1,1))
10063 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10064 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10065 call transpose2(AEAderg(1,1,2),atempd(1,1))
10066 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10067 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10069 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10070 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10071 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10077 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10078 C Derivatives in gamma(i+3)
10080 call transpose2(AEA(1,1,1),auxmatd(1,1))
10081 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10082 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10083 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10085 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10086 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10087 s2d = scalar2(b1(1,k),vtemp1d(1))
10089 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10090 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10092 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10094 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10095 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10096 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10104 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10105 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10107 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10108 & -0.5d0*ekont*(s2d+s12d)
10110 C Derivatives in gamma(i+4)
10111 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10112 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10113 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10115 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10116 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10117 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10125 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10127 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10129 C Derivatives in gamma(i+5)
10131 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10132 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10133 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10135 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10136 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10137 s2d = scalar2(b1(1,k),vtemp1d(1))
10139 call transpose2(AEA(1,1,2),atempd(1,1))
10140 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10141 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10143 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10144 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10146 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10147 ss13d = scalar2(b1(1,k),vtemp4d(1))
10148 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10156 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10157 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10159 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10160 & -0.5d0*ekont*(s2d+s12d)
10162 C Cartesian derivatives
10167 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10168 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10169 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10171 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10172 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10174 s2d = scalar2(b1(1,k),vtemp1d(1))
10176 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10177 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10178 s8d = -(atempd(1,1)+atempd(2,2))*
10179 & scalar2(cc(1,1,itl),vtemp2(1))
10181 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10183 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10184 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10191 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10192 & - 0.5d0*(s1d+s2d)
10194 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10198 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10199 & - 0.5d0*(s8d+s12d)
10201 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10210 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10211 & achuj_tempd(1,1))
10212 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10213 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10214 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10215 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10216 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10218 ss13d = scalar2(b1(1,k),vtemp4d(1))
10219 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10220 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10224 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10225 cd & 16*eel_turn6_num
10227 if (j.lt.nres-1) then
10234 if (l.lt.nres-1) then
10242 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10243 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10244 cgrad ghalf=0.5d0*ggg1(ll)
10246 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10247 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10248 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10249 & +ekont*derx_turn(ll,2,1)
10250 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10251 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10252 & +ekont*derx_turn(ll,4,1)
10253 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10254 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10255 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10256 cgrad ghalf=0.5d0*ggg2(ll)
10258 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10259 & +ekont*derx_turn(ll,2,2)
10260 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10261 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10262 & +ekont*derx_turn(ll,4,2)
10263 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10264 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10265 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10270 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10275 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10281 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10286 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10290 cd write (2,*) iii,g_corr6_loc(iii)
10292 eello_turn6=ekont*eel_turn6
10293 cd write (2,*) 'ekont',ekont
10294 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10298 C-----------------------------------------------------------------------------
10299 double precision function scalar(u,v)
10300 !DIR$ INLINEALWAYS scalar
10302 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10305 double precision u(3),v(3)
10306 cd double precision sc
10314 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10317 crc-------------------------------------------------
10318 SUBROUTINE MATVEC2(A1,V1,V2)
10319 !DIR$ INLINEALWAYS MATVEC2
10321 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10323 implicit real*8 (a-h,o-z)
10324 include 'DIMENSIONS'
10325 DIMENSION A1(2,2),V1(2),V2(2)
10329 c 3 VI=VI+A1(I,K)*V1(K)
10333 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10334 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10339 C---------------------------------------
10340 SUBROUTINE MATMAT2(A1,A2,A3)
10342 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10344 implicit real*8 (a-h,o-z)
10345 include 'DIMENSIONS'
10346 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10347 c DIMENSION AI3(2,2)
10351 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10357 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10358 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10359 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10360 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10368 c-------------------------------------------------------------------------
10369 double precision function scalar2(u,v)
10370 !DIR$ INLINEALWAYS scalar2
10372 double precision u(2),v(2)
10373 double precision sc
10375 scalar2=u(1)*v(1)+u(2)*v(2)
10379 C-----------------------------------------------------------------------------
10381 subroutine transpose2(a,at)
10382 !DIR$ INLINEALWAYS transpose2
10384 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10387 double precision a(2,2),at(2,2)
10394 c--------------------------------------------------------------------------
10395 subroutine transpose(n,a,at)
10398 double precision a(n,n),at(n,n)
10406 C---------------------------------------------------------------------------
10407 subroutine prodmat3(a1,a2,kk,transp,prod)
10408 !DIR$ INLINEALWAYS prodmat3
10410 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10414 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10416 crc double precision auxmat(2,2),prod_(2,2)
10419 crc call transpose2(kk(1,1),auxmat(1,1))
10420 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10421 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10423 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10424 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10425 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10426 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10427 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10428 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10429 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10430 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10433 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10434 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10436 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10437 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10438 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10439 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10440 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10441 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10442 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10443 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10446 c call transpose2(a2(1,1),a2t(1,1))
10449 crc print *,((prod_(i,j),i=1,2),j=1,2)
10450 crc print *,((prod(i,j),i=1,2),j=1,2)
10454 CCC----------------------------------------------
10455 subroutine Eliptransfer(eliptran)
10456 implicit real*8 (a-h,o-z)
10457 include 'DIMENSIONS'
10458 include 'COMMON.GEO'
10459 include 'COMMON.VAR'
10460 include 'COMMON.LOCAL'
10461 include 'COMMON.CHAIN'
10462 include 'COMMON.DERIV'
10463 include 'COMMON.NAMES'
10464 include 'COMMON.INTERACT'
10465 include 'COMMON.IOUNITS'
10466 include 'COMMON.CALC'
10467 include 'COMMON.CONTROL'
10468 include 'COMMON.SPLITELE'
10469 include 'COMMON.SBRIDGE'
10470 C this is done by Adasko
10471 C print *,"wchodze"
10472 C structure of box:
10474 C--bordliptop-- buffore starts
10475 C--bufliptop--- here true lipid starts
10477 C--buflipbot--- lipid ends buffore starts
10478 C--bordlipbot--buffore ends
10480 do i=ilip_start,ilip_end
10482 if (itype(i).eq.ntyp1) cycle
10484 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10485 if (positi.le.0) positi=positi+boxzsize
10487 C first for peptide groups
10488 c for each residue check if it is in lipid or lipid water border area
10489 if ((positi.gt.bordlipbot)
10490 &.and.(positi.lt.bordliptop)) then
10491 C the energy transfer exist
10492 if (positi.lt.buflipbot) then
10493 C what fraction I am in
10495 & ((positi-bordlipbot)/lipbufthick)
10496 C lipbufthick is thickenes of lipid buffore
10497 sslip=sscalelip(fracinbuf)
10498 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10499 eliptran=eliptran+sslip*pepliptran
10500 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10501 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10502 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10504 C print *,"doing sccale for lower part"
10505 C print *,i,sslip,fracinbuf,ssgradlip
10506 elseif (positi.gt.bufliptop) then
10507 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10508 sslip=sscalelip(fracinbuf)
10509 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10510 eliptran=eliptran+sslip*pepliptran
10511 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10512 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10513 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10514 C print *, "doing sscalefor top part"
10515 C print *,i,sslip,fracinbuf,ssgradlip
10517 eliptran=eliptran+pepliptran
10518 C print *,"I am in true lipid"
10521 C eliptran=elpitran+0.0 ! I am in water
10524 C print *, "nic nie bylo w lipidzie?"
10525 C now multiply all by the peptide group transfer factor
10526 C eliptran=eliptran*pepliptran
10527 C now the same for side chains
10529 do i=ilip_start,ilip_end
10530 if (itype(i).eq.ntyp1) cycle
10531 positi=(mod(c(3,i+nres),boxzsize))
10532 if (positi.le.0) positi=positi+boxzsize
10533 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10534 c for each residue check if it is in lipid or lipid water border area
10535 C respos=mod(c(3,i+nres),boxzsize)
10536 C print *,positi,bordlipbot,buflipbot
10537 if ((positi.gt.bordlipbot)
10538 & .and.(positi.lt.bordliptop)) then
10539 C the energy transfer exist
10540 if (positi.lt.buflipbot) then
10542 & ((positi-bordlipbot)/lipbufthick)
10543 C lipbufthick is thickenes of lipid buffore
10544 sslip=sscalelip(fracinbuf)
10545 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10546 eliptran=eliptran+sslip*liptranene(itype(i))
10547 gliptranx(3,i)=gliptranx(3,i)
10548 &+ssgradlip*liptranene(itype(i))
10549 gliptranc(3,i-1)= gliptranc(3,i-1)
10550 &+ssgradlip*liptranene(itype(i))
10551 C print *,"doing sccale for lower part"
10552 elseif (positi.gt.bufliptop) then
10554 &((bordliptop-positi)/lipbufthick)
10555 sslip=sscalelip(fracinbuf)
10556 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10557 eliptran=eliptran+sslip*liptranene(itype(i))
10558 gliptranx(3,i)=gliptranx(3,i)
10559 &+ssgradlip*liptranene(itype(i))
10560 gliptranc(3,i-1)= gliptranc(3,i-1)
10561 &+ssgradlip*liptranene(itype(i))
10562 C print *, "doing sscalefor top part",sslip,fracinbuf
10564 eliptran=eliptran+liptranene(itype(i))
10565 C print *,"I am in true lipid"
10567 endif ! if in lipid or buffor
10569 C eliptran=elpitran+0.0 ! I am in water
10573 C---------------------------------------------------------
10574 C AFM soubroutine for constant force
10575 subroutine AFMforce(Eafmforce)
10576 implicit real*8 (a-h,o-z)
10577 include 'DIMENSIONS'
10578 include 'COMMON.GEO'
10579 include 'COMMON.VAR'
10580 include 'COMMON.LOCAL'
10581 include 'COMMON.CHAIN'
10582 include 'COMMON.DERIV'
10583 include 'COMMON.NAMES'
10584 include 'COMMON.INTERACT'
10585 include 'COMMON.IOUNITS'
10586 include 'COMMON.CALC'
10587 include 'COMMON.CONTROL'
10588 include 'COMMON.SPLITELE'
10589 include 'COMMON.SBRIDGE'
10594 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10595 dist=dist+diffafm(i)**2
10598 Eafmforce=-forceAFMconst*(dist-distafminit)
10600 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
10601 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
10603 C print *,'AFM',Eafmforce
10606 C---------------------------------------------------------
10607 C AFM subroutine with pseudoconstant velocity
10608 subroutine AFMvel(Eafmforce)
10609 implicit real*8 (a-h,o-z)
10610 include 'DIMENSIONS'
10611 include 'COMMON.GEO'
10612 include 'COMMON.VAR'
10613 include 'COMMON.LOCAL'
10614 include 'COMMON.CHAIN'
10615 include 'COMMON.DERIV'
10616 include 'COMMON.NAMES'
10617 include 'COMMON.INTERACT'
10618 include 'COMMON.IOUNITS'
10619 include 'COMMON.CALC'
10620 include 'COMMON.CONTROL'
10621 include 'COMMON.SPLITELE'
10622 include 'COMMON.SBRIDGE'
10624 C Only for check grad COMMENT if not used for checkgrad
10626 C--------------------------------------------------------
10627 C print *,"wchodze"
10631 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10632 dist=dist+diffafm(i)**2
10635 Eafmforce=0.5d0*forceAFMconst
10636 & *(distafminit+totTafm*velAFMconst-dist)**2
10637 C Eafmforce=-forceAFMconst*(dist-distafminit)
10639 gradafm(i,afmend-1)=-forceAFMconst*
10640 &(distafminit+totTafm*velAFMconst-dist)
10642 gradafm(i,afmbeg-1)=forceAFMconst*
10643 &(distafminit+totTafm*velAFMconst-dist)
10646 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
10649 C-----------------------------------------------------------
10650 C first for shielding is setting of function of side-chains
10651 subroutine set_shield_fac
10652 implicit real*8 (a-h,o-z)
10653 include 'DIMENSIONS'
10654 include 'COMMON.CHAIN'
10655 include 'COMMON.DERIV'
10656 include 'COMMON.IOUNITS'
10657 include 'COMMON.SHIELD'
10658 include 'COMMON.INTERACT'
10659 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10660 double precision div77_81/0.974996043d0/,
10661 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10663 C the vector between center of side_chain and peptide group
10664 double precision pep_side(3),long,side_calf(3),
10665 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10666 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10667 C the line belowe needs to be changed for FGPROC>1
10669 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10671 Cif there two consequtive dummy atoms there is no peptide group between them
10672 C the line below has to be changed for FGPROC>1
10675 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10679 C first lets set vector conecting the ithe side-chain with kth side-chain
10680 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10681 C pep_side(j)=2.0d0
10682 C and vector conecting the side-chain with its proper calfa
10683 side_calf(j)=c(j,k+nres)-c(j,k)
10684 C side_calf(j)=2.0d0
10685 pept_group(j)=c(j,i)-c(j,i+1)
10686 C lets have their lenght
10687 dist_pep_side=pep_side(j)**2+dist_pep_side
10688 dist_side_calf=dist_side_calf+side_calf(j)**2
10689 dist_pept_group=dist_pept_group+pept_group(j)**2
10691 dist_pep_side=dsqrt(dist_pep_side)
10692 dist_pept_group=dsqrt(dist_pept_group)
10693 dist_side_calf=dsqrt(dist_side_calf)
10695 pep_side_norm(j)=pep_side(j)/dist_pep_side
10696 side_calf_norm(j)=dist_side_calf
10698 C now sscale fraction
10699 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10700 C print *,buff_shield,"buff"
10702 if (sh_frac_dist.le.0.0) cycle
10703 C If we reach here it means that this side chain reaches the shielding sphere
10704 C Lets add him to the list for gradient
10705 ishield_list(i)=ishield_list(i)+1
10706 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10707 C this list is essential otherwise problem would be O3
10708 shield_list(ishield_list(i),i)=k
10709 C Lets have the sscale value
10710 if (sh_frac_dist.gt.1.0) then
10711 scale_fac_dist=1.0d0
10713 sh_frac_dist_grad(j)=0.0d0
10716 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10717 & *(2.0*sh_frac_dist-3.0d0)
10718 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
10719 & /dist_pep_side/buff_shield*0.5
10720 C remember for the final gradient multiply sh_frac_dist_grad(j)
10721 C for side_chain by factor -2 !
10723 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10724 C print *,"jestem",scale_fac_dist,fac_help_scale,
10725 C & sh_frac_dist_grad(j)
10728 C if ((i.eq.3).and.(k.eq.2)) then
10729 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
10733 C this is what is now we have the distance scaling now volume...
10734 short=short_r_sidechain(itype(k))
10735 long=long_r_sidechain(itype(k))
10736 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
10739 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
10740 C costhet_fac=0.0d0
10742 costhet_grad(j)=costhet_fac*pep_side(j)
10744 C remember for the final gradient multiply costhet_grad(j)
10745 C for side_chain by factor -2 !
10746 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10747 C pep_side0pept_group is vector multiplication
10748 pep_side0pept_group=0.0
10750 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10752 cosalfa=(pep_side0pept_group/
10753 & (dist_pep_side*dist_side_calf))
10754 fac_alfa_sin=1.0-cosalfa**2
10755 fac_alfa_sin=dsqrt(fac_alfa_sin)
10756 rkprim=fac_alfa_sin*(long-short)+short
10758 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
10759 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
10762 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10763 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10764 &*(long-short)/fac_alfa_sin*cosalfa/
10765 &((dist_pep_side*dist_side_calf))*
10766 &((side_calf(j))-cosalfa*
10767 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10769 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10770 &*(long-short)/fac_alfa_sin*cosalfa
10771 &/((dist_pep_side*dist_side_calf))*
10773 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10776 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
10778 C now the gradient...
10779 C grad_shield is gradient of Calfa for peptide groups
10780 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
10782 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
10783 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
10785 grad_shield(j,i)=grad_shield(j,i)
10786 C gradient po skalowaniu
10787 & +(sh_frac_dist_grad(j)
10788 C gradient po costhet
10789 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
10790 &-scale_fac_dist*(cosphi_grad_long(j))
10791 &/(1.0-cosphi) )*div77_81
10793 C grad_shield_side is Cbeta sidechain gradient
10794 grad_shield_side(j,ishield_list(i),i)=
10795 & (sh_frac_dist_grad(j)*-2.0d0
10796 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
10797 & +scale_fac_dist*(cosphi_grad_long(j))
10798 & *2.0d0/(1.0-cosphi))
10799 & *div77_81*VofOverlap
10801 grad_shield_loc(j,ishield_list(i),i)=
10802 & scale_fac_dist*cosphi_grad_loc(j)
10803 & *2.0d0/(1.0-cosphi)
10804 & *div77_81*VofOverlap
10806 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10808 fac_shield(i)=VolumeTotal*div77_81+div4_81
10809 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)