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.
59 C FG Master broadcasts the WEIGHTS_ array
60 call MPI_Bcast(weights_(1),n_ene,
61 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
63 C FG slaves receive the WEIGHTS array
64 call MPI_Bcast(weights(1),n_ene,
65 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
87 time_Bcast=time_Bcast+MPI_Wtime()-time00
88 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
89 c call chainbuild_cart
91 c print *,'Processor',myrank,' calling etotal ipot=',ipot
92 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
94 c if (modecalc.eq.12.or.modecalc.eq.14) then
95 c call int_from_cart1(.false.)
102 C Compute the side-chain and electrostatic interaction energy
105 goto (101,102,103,104,105,106) ipot
106 C Lennard-Jones potential.
108 cd print '(a)','Exit ELJ'
110 C Lennard-Jones-Kihara potential (shifted).
113 C Berne-Pechukas potential (dilated LJ, angular dependence).
116 C Gay-Berne potential (shifted LJ, angular dependence).
118 C print *,"bylem w egb"
120 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
123 C Soft-sphere potential
124 106 call e_softsphere(evdw)
126 C Calculate electrostatic (H-bonding) energy of the main chain.
130 cmc Sep-06: egb takes care of dynamic ss bonds too
132 c if (dyn_ss) call dyn_set_nss
134 c print *,"Processor",myrank," computed USCSC"
140 time_vec=time_vec+MPI_Wtime()-time01
142 c print *,"Processor",myrank," left VEC_AND_DERIV"
145 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
146 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
147 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
148 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
150 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
151 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
152 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
153 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
155 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
164 write (iout,*) "Soft-spheer ELEC potential"
165 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
168 c print *,"Processor",myrank," computed UELEC"
170 C Calculate excluded-volume interaction energy between peptide groups
175 call escp(evdw2,evdw2_14)
181 c write (iout,*) "Soft-sphere SCP potential"
182 call escp_soft_sphere(evdw2,evdw2_14)
185 c Calculate the bond-stretching energy
189 C Calculate the disulfide-bridge and other energy and the contributions
190 C from other distance constraints.
191 cd print *,'Calling EHPB'
193 cd print *,'EHPB exitted succesfully.'
195 C Calculate the virtual-bond-angle energy.
197 if (wang.gt.0d0) then
202 c print *,"Processor",myrank," computed UB"
204 C Calculate the SC local energy.
206 C print *,"TU DOCHODZE?"
208 c print *,"Processor",myrank," computed USC"
210 C Calculate the virtual-bond torsional energy.
212 cd print *,'nterm=',nterm
214 call etor(etors,edihcnstr)
220 if (constr_homology.ge.1) then
221 call e_modeller(ehomology_constr)
222 c print *,'iset=',iset,'me=',me,ehomology_constr,
223 c & 'Processor',fg_rank,' CG group',kolor,
224 c & ' absolute rank',MyRank
226 ehomology_constr=0.0d0
230 c write(iout,*) ehomology_constr
231 c print *,"Processor",myrank," computed Utor"
233 C 6/23/01 Calculate double-torsional energy
235 if (wtor_d.gt.0) then
240 c print *,"Processor",myrank," computed Utord"
242 C 21/5/07 Calculate local sicdechain correlation energy
244 if (wsccor.gt.0.0d0) then
245 call eback_sc_corr(esccor)
249 C print *,"PRZED MULIt"
250 c print *,"Processor",myrank," computed Usccorr"
252 C 12/1/95 Multi-body terms
256 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
257 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
258 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
259 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
260 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
267 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
268 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
269 cd write (iout,*) "multibody_hb ecorr",ecorr
271 c write (iout,*) "nsaxs",nsaxs," saxs_mode",saxs_mode
272 if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
273 call e_saxs(Esaxs_constr)
274 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
275 else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then
276 call e_saxsC(Esaxs_constr)
277 c write (iout,*) "From EsaxsC: Esaxs_constr",Esaxs_constr
281 c print *,"Processor",myrank," computed Ucorr"
283 C If performing constraint dynamics, call the constraint energy
284 C after the equilibration time
285 if(usampl.and.totT.gt.eq_time) then
292 C 01/27/2015 added by adasko
293 C the energy component below is energy transfer into lipid environment
294 C based on partition function
295 C print *,"przed lipidami"
296 if (wliptran.gt.0) then
297 call Eliptransfer(eliptran)
299 C print *,"za lipidami"
300 if (AFMlog.gt.0) then
301 call AFMforce(Eafmforce)
302 else if (selfguide.gt.0) then
303 call AFMvel(Eafmforce)
306 time_enecalc=time_enecalc+MPI_Wtime()-time00
308 c print *,"Processor",myrank," computed Uconstr"
317 energia(2)=evdw2-evdw2_14
334 energia(8)=eello_turn3
335 energia(9)=eello_turn4
342 energia(19)=edihcnstr
344 energia(20)=Uconst+Uconst_back
347 energia(23)=Eafmforce
348 energia(24)=ehomology_constr
349 energia(25)=Esaxs_constr
350 c Here are the energies showed per procesor if the are more processors
351 c per molecule then we sum it up in sum_energy subroutine
352 c print *," Processor",myrank," calls SUM_ENERGY"
353 call sum_energy(energia,.true.)
354 if (dyn_ss) call dyn_set_nss
355 c print *," Processor",myrank," left SUM_ENERGY"
357 time_sumene=time_sumene+MPI_Wtime()-time00
361 c-------------------------------------------------------------------------------
362 subroutine sum_energy(energia,reduce)
363 implicit real*8 (a-h,o-z)
368 cMS$ATTRIBUTES C :: proc_proc
374 include 'COMMON.SETUP'
375 include 'COMMON.IOUNITS'
376 double precision energia(0:n_ene),enebuff(0:n_ene+1)
377 include 'COMMON.FFIELD'
378 include 'COMMON.DERIV'
379 include 'COMMON.INTERACT'
380 include 'COMMON.SBRIDGE'
381 include 'COMMON.CHAIN'
383 include 'COMMON.CONTROL'
384 include 'COMMON.TIME1'
387 if (nfgtasks.gt.1 .and. reduce) then
389 write (iout,*) "energies before REDUCE"
390 call enerprint(energia)
394 enebuff(i)=energia(i)
397 call MPI_Barrier(FG_COMM,IERR)
398 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
400 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
401 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
403 write (iout,*) "energies after REDUCE"
404 call enerprint(energia)
407 time_Reduce=time_Reduce+MPI_Wtime()-time00
409 if (fg_rank.eq.0) then
413 evdw2=energia(2)+energia(18)
429 eello_turn3=energia(8)
430 eello_turn4=energia(9)
437 edihcnstr=energia(19)
442 Eafmforce=energia(23)
443 ehomology_constr=energia(24)
444 esaxs_constr=energia(25)
445 c write (iout,*) "sum_energy esaxs_constr",esaxs_constr,
448 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
449 & +wang*ebe+wtor*etors+wscloc*escloc
450 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
451 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
452 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
453 & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
454 & +wsaxs*esaxs_constr+wliptran*eliptran+Eafmforce
456 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
457 & +wang*ebe+wtor*etors+wscloc*escloc
458 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
459 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
460 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
461 & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
462 & +wsaxs*esaxs_constr+wliptran*eliptran
469 if (isnan(etot).ne.0) energia(0)=1.0d+99
471 if (isnan(etot)) energia(0)=1.0d+99
476 idumm=proc_proc(etot,i)
478 call proc_proc(etot,i)
480 if(i.eq.1)energia(0)=1.0d+99
487 c-------------------------------------------------------------------------------
488 subroutine sum_gradient
489 implicit real*8 (a-h,o-z)
494 cMS$ATTRIBUTES C :: proc_proc
500 double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
501 & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
502 & ,gloc_scbuf(3,-1:maxres)
503 include 'COMMON.SETUP'
504 include 'COMMON.IOUNITS'
505 include 'COMMON.FFIELD'
506 include 'COMMON.DERIV'
507 include 'COMMON.INTERACT'
508 include 'COMMON.SBRIDGE'
509 include 'COMMON.CHAIN'
511 include 'COMMON.CONTROL'
512 include 'COMMON.TIME1'
513 include 'COMMON.MAXGRAD'
514 include 'COMMON.SCCOR'
520 write (iout,*) "sum_gradient gvdwc, gvdwx"
522 write (iout,'(i3,3e15.5,5x,3e15.5)')
523 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
528 write (iout,*) "sum_gradient gsaxsc, gsaxsx"
530 write (iout,'(i3,3e15.5,5x,3e15.5)')
531 & i,(gsaxsc(j,i),j=1,3),(gsaxsx(j,i),j=1,3)
536 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
537 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
538 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
541 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
542 C in virtual-bond-vector coordinates
545 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
547 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
548 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
550 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
552 c write (iout,'(i5,3f10.5,2x,f10.5)')
553 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
555 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
557 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
558 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
566 gradbufc(j,i)=wsc*gvdwc(j,i)+
567 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
568 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
569 & wel_loc*gel_loc_long(j,i)+
570 & wcorr*gradcorr_long(j,i)+
571 & wcorr5*gradcorr5_long(j,i)+
572 & wcorr6*gradcorr6_long(j,i)+
573 & wturn6*gcorr6_turn_long(j,i)+
574 & wstrain*ghpbc(j,i)+
576 & +wliptran*gliptranc(j,i)
584 gradbufc(j,i)=wsc*gvdwc(j,i)+
585 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
586 & welec*gelc_long(j,i)+
588 & wel_loc*gel_loc_long(j,i)+
589 & wcorr*gradcorr_long(j,i)+
590 & wcorr5*gradcorr5_long(j,i)+
591 & wcorr6*gradcorr6_long(j,i)+
592 & wturn6*gcorr6_turn_long(j,i)+
593 & wstrain*ghpbc(j,i)+
595 & +wliptran*gliptranc(j,i)
602 if (nfgtasks.gt.1) then
605 write (iout,*) "gradbufc before allreduce"
607 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
613 gradbufc_sum(j,i)=gradbufc(j,i)
616 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
617 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
618 c time_reduce=time_reduce+MPI_Wtime()-time00
620 c write (iout,*) "gradbufc_sum after allreduce"
622 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
627 c time_allreduce=time_allreduce+MPI_Wtime()-time00
635 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
636 write (iout,*) (i," jgrad_start",jgrad_start(i),
637 & " jgrad_end ",jgrad_end(i),
638 & i=igrad_start,igrad_end)
641 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
642 c do not parallelize this part.
644 c do i=igrad_start,igrad_end
645 c do j=jgrad_start(i),jgrad_end(i)
647 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
652 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
657 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
661 write (iout,*) "gradbufc after summing"
663 write (iout,'(i3,3e15.5)') i,(gradbufc(j,i),j=1,3)
670 write (iout,*) "gradbufc"
672 write (iout,'(i3,3e15.5)') i,(gradbufc(j,i),j=1,3)
678 gradbufc_sum(j,i)=gradbufc(j,i)
683 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
688 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
693 c gradbufc(k,i)=0.0d0
697 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
702 write (iout,*) "gradbufc after summing"
704 write (iout,'(i3,3e15.5)') i,(gradbufc(j,i),j=1,3)
712 gradbufc(k,nres)=0.0d0
717 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
718 & wel_loc*gel_loc(j,i)+
719 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
720 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
721 & wel_loc*gel_loc_long(j,i)+
722 & wcorr*gradcorr_long(j,i)+
723 & wcorr5*gradcorr5_long(j,i)+
724 & wcorr6*gradcorr6_long(j,i)+
725 & wturn6*gcorr6_turn_long(j,i))+
727 & wcorr*gradcorr(j,i)+
728 & wturn3*gcorr3_turn(j,i)+
729 & wturn4*gcorr4_turn(j,i)+
730 & wcorr5*gradcorr5(j,i)+
731 & wcorr6*gradcorr6(j,i)+
732 & wturn6*gcorr6_turn(j,i)+
733 & wsccor*gsccorc(j,i)
734 & +wscloc*gscloc(j,i)
735 & +wliptran*gliptranc(j,i)
738 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
739 & wel_loc*gel_loc(j,i)+
740 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
741 & welec*gelc_long(j,i)+
742 & wel_loc*gel_loc_long(j,i)+
743 & wcorr*gcorr_long(j,i)+
744 & wcorr5*gradcorr5_long(j,i)+
745 & wcorr6*gradcorr6_long(j,i)+
746 & wturn6*gcorr6_turn_long(j,i))+
748 & wcorr*gradcorr(j,i)+
749 & wturn3*gcorr3_turn(j,i)+
750 & wturn4*gcorr4_turn(j,i)+
751 & wcorr5*gradcorr5(j,i)+
752 & wcorr6*gradcorr6(j,i)+
753 & wturn6*gcorr6_turn(j,i)+
754 & wsccor*gsccorc(j,i)
755 & +wscloc*gscloc(j,i)
756 & +wliptran*gliptranc(j,i)
760 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
762 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
764 & +wsccor*gsccorx(j,i)
765 & +wscloc*gsclocx(j,i)
766 & +wliptran*gliptranx(j,i)
769 if (constr_homology.gt.0) then
772 gradc(j,i,icg)=gradc(j,i,icg)+duscdiff(j,i)
773 gradx(j,i,icg)=gradx(j,i,icg)+duscdiffx(j,i)
778 write (iout,*) "gloc before adding corr"
780 write (iout,*) i,gloc(i,icg)
784 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
785 & +wcorr5*g_corr5_loc(i)
786 & +wcorr6*g_corr6_loc(i)
787 & +wturn4*gel_loc_turn4(i)
788 & +wturn3*gel_loc_turn3(i)
789 & +wturn6*gel_loc_turn6(i)
790 & +wel_loc*gel_loc_loc(i)
793 write (iout,*) "gloc after adding corr"
795 write (iout,*) i,gloc(i,icg)
799 if (nfgtasks.gt.1) then
802 gradbufc(j,i)=gradc(j,i,icg)
803 gradbufx(j,i)=gradx(j,i,icg)
807 glocbuf(i)=gloc(i,icg)
811 write (iout,*) "gloc_sc before reduce"
814 write (iout,*) i,j,gloc_sc(j,i,icg)
821 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
825 call MPI_Barrier(FG_COMM,IERR)
826 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
828 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
829 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
830 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
831 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
832 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
833 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
834 time_reduce=time_reduce+MPI_Wtime()-time00
835 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
836 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
837 time_reduce=time_reduce+MPI_Wtime()-time00
840 write (iout,*) "gloc_sc after reduce"
843 write (iout,*) i,j,gloc_sc(j,i,icg)
849 write (iout,*) "gloc after reduce"
851 write (iout,*) i,gloc(i,icg)
856 if (gnorm_check) then
858 c Compute the maximum elements of the gradient
868 gcorr3_turn_max=0.0d0
869 gcorr4_turn_max=0.0d0
872 gcorr6_turn_max=0.0d0
882 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
883 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
884 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
885 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
886 & gvdwc_scp_max=gvdwc_scp_norm
887 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
888 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
889 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
890 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
891 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
892 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
893 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
894 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
895 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
896 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
897 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
898 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
899 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
901 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
902 & gcorr3_turn_max=gcorr3_turn_norm
903 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
905 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
906 & gcorr4_turn_max=gcorr4_turn_norm
907 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
908 if (gradcorr5_norm.gt.gradcorr5_max)
909 & gradcorr5_max=gradcorr5_norm
910 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
911 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
912 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
914 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
915 & gcorr6_turn_max=gcorr6_turn_norm
916 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
917 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
918 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
919 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
920 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
921 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
922 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
923 if (gradx_scp_norm.gt.gradx_scp_max)
924 & gradx_scp_max=gradx_scp_norm
925 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
926 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
927 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
928 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
929 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
930 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
931 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
932 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
936 open(istat,file=statname,position="append")
938 open(istat,file=statname,access="append")
940 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
941 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
942 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
943 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
944 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
945 & gsccorx_max,gsclocx_max
947 if (gvdwc_max.gt.1.0d4) then
948 write (iout,*) "gvdwc gvdwx gradb gradbx"
950 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
951 & gradb(j,i),gradbx(j,i),j=1,3)
953 call pdbout(0.0d0,'cipiszcze',iout)
959 write (iout,*) "gradc gradx gloc"
961 write (iout,'(i5,3e15.5,5x,3e15.5,5x,e15.5)')
962 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
966 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
970 c-------------------------------------------------------------------------------
971 subroutine rescale_weights(t_bath)
972 implicit real*8 (a-h,o-z)
974 include 'COMMON.IOUNITS'
975 include 'COMMON.FFIELD'
976 include 'COMMON.SBRIDGE'
977 double precision kfac /2.4d0/
978 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
980 c facT=2*temp0/(t_bath+temp0)
981 if (rescale_mode.eq.0) then
987 else if (rescale_mode.eq.1) then
988 facT=kfac/(kfac-1.0d0+t_bath/temp0)
989 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
990 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
991 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
992 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
993 else if (rescale_mode.eq.2) then
999 facT=licznik/dlog(dexp(x)+dexp(-x))
1000 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
1001 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
1002 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
1003 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
1005 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1006 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1008 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1012 welec=weights(3)*fact
1013 wcorr=weights(4)*fact3
1014 wcorr5=weights(5)*fact4
1015 wcorr6=weights(6)*fact5
1016 wel_loc=weights(7)*fact2
1017 wturn3=weights(8)*fact2
1018 wturn4=weights(9)*fact3
1019 wturn6=weights(10)*fact5
1020 wtor=weights(13)*fact
1021 wtor_d=weights(14)*fact2
1022 wsccor=weights(21)*fact
1026 C------------------------------------------------------------------------
1027 subroutine enerprint(energia)
1028 implicit real*8 (a-h,o-z)
1029 include 'DIMENSIONS'
1030 include 'COMMON.IOUNITS'
1031 include 'COMMON.FFIELD'
1032 include 'COMMON.SBRIDGE'
1034 double precision energia(0:n_ene)
1039 evdw2=energia(2)+energia(18)
1051 eello_turn3=energia(8)
1052 eello_turn4=energia(9)
1053 eello_turn6=energia(10)
1059 edihcnstr=energia(19)
1063 ehomology_constr=energia(24)
1064 esaxs_constr=energia(25)
1065 eliptran=energia(22)
1066 Eafmforce=energia(23)
1068 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1069 & estr,wbond,ebe,wang,
1070 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1072 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1073 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1074 & edihcnstr,ehomology_constr,esaxs_constr*wsaxs, ebr*nss,
1075 & Uconst,eliptran,wliptran,Eafmforce,etot
1076 10 format (/'Virtual-chain energies:'//
1077 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1078 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1079 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1080 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1081 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1082 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1083 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1084 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1085 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1086 & 'EHPB= ',1pE16.6,' WEIGHT=',1pD16.6,
1087 & ' (SS bridges & dist. cnstr.)'/
1088 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1089 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1090 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1091 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1092 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1093 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1094 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1095 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1096 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1097 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1098 & 'E_SAXS=',1pE16.6,' (SAXS restraints)'/
1099 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1100 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1101 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1102 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1103 & 'ETOT= ',1pE16.6,' (total)')
1106 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1107 & estr,wbond,ebe,wang,
1108 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1110 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1111 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1112 & ehomology_constr,esaxs_constr*wsaxs,ebr*nss,Uconst,
1113 & eliptran,wliptran,Eafmforc,
1115 10 format (/'Virtual-chain energies:'//
1116 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1117 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1118 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1119 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1120 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1121 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1122 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1123 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1124 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1125 & ' (SS bridges & dist. cnstr.)'/
1126 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1127 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1128 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1129 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1130 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1131 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1132 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1133 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1134 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1135 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1136 & 'E_SAXS=',1pE16.6,' (SAXS restraints)'/
1137 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1138 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1139 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1140 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1141 & 'ETOT= ',1pE16.6,' (total)')
1145 C-----------------------------------------------------------------------
1146 subroutine elj(evdw)
1148 C This subroutine calculates the interaction energy of nonbonded side chains
1149 C assuming the LJ potential of interaction.
1151 implicit real*8 (a-h,o-z)
1152 include 'DIMENSIONS'
1153 parameter (accur=1.0d-10)
1154 include 'COMMON.GEO'
1155 include 'COMMON.VAR'
1156 include 'COMMON.LOCAL'
1157 include 'COMMON.CHAIN'
1158 include 'COMMON.DERIV'
1159 include 'COMMON.INTERACT'
1160 include 'COMMON.TORSION'
1161 include 'COMMON.SBRIDGE'
1162 include 'COMMON.NAMES'
1163 include 'COMMON.IOUNITS'
1164 include 'COMMON.CONTACTS'
1166 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1168 do i=iatsc_s,iatsc_e
1169 itypi=iabs(itype(i))
1170 if (itypi.eq.ntyp1) cycle
1171 itypi1=iabs(itype(i+1))
1178 C Calculate SC interaction energy.
1180 do iint=1,nint_gr(i)
1181 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1182 cd & 'iend=',iend(i,iint)
1183 do j=istart(i,iint),iend(i,iint)
1184 itypj=iabs(itype(j))
1185 if (itypj.eq.ntyp1) cycle
1189 C Change 12/1/95 to calculate four-body interactions
1190 rij=xj*xj+yj*yj+zj*zj
1192 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1193 eps0ij=eps(itypi,itypj)
1195 C have you changed here?
1199 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1200 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1201 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1202 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1203 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1204 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1207 C Calculate the components of the gradient in DC and X
1209 fac=-rrij*(e1+evdwij)
1214 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1215 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1216 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1217 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1221 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1225 C 12/1/95, revised on 5/20/97
1227 C Calculate the contact function. The ith column of the array JCONT will
1228 C contain the numbers of atoms that make contacts with the atom I (of numbers
1229 C greater than I). The arrays FACONT and GACONT will contain the values of
1230 C the contact function and its derivative.
1232 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1233 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1234 C Uncomment next line, if the correlation interactions are contact function only
1235 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1237 sigij=sigma(itypi,itypj)
1238 r0ij=rs0(itypi,itypj)
1240 C Check whether the SC's are not too far to make a contact.
1243 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1244 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1246 if (fcont.gt.0.0D0) then
1247 C If the SC-SC distance if close to sigma, apply spline.
1248 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1249 cAdam & fcont1,fprimcont1)
1250 cAdam fcont1=1.0d0-fcont1
1251 cAdam if (fcont1.gt.0.0d0) then
1252 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1253 cAdam fcont=fcont*fcont1
1255 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1256 cga eps0ij=1.0d0/dsqrt(eps0ij)
1258 cga gg(k)=gg(k)*eps0ij
1260 cga eps0ij=-evdwij*eps0ij
1261 C Uncomment for AL's type of SC correlation interactions.
1262 cadam eps0ij=-evdwij
1263 num_conti=num_conti+1
1264 jcont(num_conti,i)=j
1265 facont(num_conti,i)=fcont*eps0ij
1266 fprimcont=eps0ij*fprimcont/rij
1268 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1269 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1270 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1271 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1272 gacont(1,num_conti,i)=-fprimcont*xj
1273 gacont(2,num_conti,i)=-fprimcont*yj
1274 gacont(3,num_conti,i)=-fprimcont*zj
1275 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1276 cd write (iout,'(2i3,3f10.5)')
1277 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1283 num_cont(i)=num_conti
1287 gvdwc(j,i)=expon*gvdwc(j,i)
1288 gvdwx(j,i)=expon*gvdwx(j,i)
1291 C******************************************************************************
1295 C To save time, the factor of EXPON has been extracted from ALL components
1296 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1299 C******************************************************************************
1302 C-----------------------------------------------------------------------------
1303 subroutine eljk(evdw)
1305 C This subroutine calculates the interaction energy of nonbonded side chains
1306 C assuming the LJK potential of interaction.
1308 implicit real*8 (a-h,o-z)
1309 include 'DIMENSIONS'
1310 include 'COMMON.GEO'
1311 include 'COMMON.VAR'
1312 include 'COMMON.LOCAL'
1313 include 'COMMON.CHAIN'
1314 include 'COMMON.DERIV'
1315 include 'COMMON.INTERACT'
1316 include 'COMMON.IOUNITS'
1317 include 'COMMON.NAMES'
1320 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1322 do i=iatsc_s,iatsc_e
1323 itypi=iabs(itype(i))
1324 if (itypi.eq.ntyp1) cycle
1325 itypi1=iabs(itype(i+1))
1330 C Calculate SC interaction energy.
1332 do iint=1,nint_gr(i)
1333 do j=istart(i,iint),iend(i,iint)
1334 itypj=iabs(itype(j))
1335 if (itypj.eq.ntyp1) cycle
1339 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1340 fac_augm=rrij**expon
1341 e_augm=augm(itypi,itypj)*fac_augm
1342 r_inv_ij=dsqrt(rrij)
1344 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1345 fac=r_shift_inv**expon
1346 C have you changed here?
1350 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1351 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1352 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1353 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1354 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1355 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1356 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1359 C Calculate the components of the gradient in DC and X
1361 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1366 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1367 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1368 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1369 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1373 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1381 gvdwc(j,i)=expon*gvdwc(j,i)
1382 gvdwx(j,i)=expon*gvdwx(j,i)
1387 C-----------------------------------------------------------------------------
1388 subroutine ebp(evdw)
1390 C This subroutine calculates the interaction energy of nonbonded side chains
1391 C assuming the Berne-Pechukas potential of interaction.
1393 implicit real*8 (a-h,o-z)
1394 include 'DIMENSIONS'
1395 include 'COMMON.GEO'
1396 include 'COMMON.VAR'
1397 include 'COMMON.LOCAL'
1398 include 'COMMON.CHAIN'
1399 include 'COMMON.DERIV'
1400 include 'COMMON.NAMES'
1401 include 'COMMON.INTERACT'
1402 include 'COMMON.IOUNITS'
1403 include 'COMMON.CALC'
1404 common /srutu/ icall
1405 c double precision rrsave(maxdim)
1408 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1410 c if (icall.eq.0) then
1416 do i=iatsc_s,iatsc_e
1417 itypi=iabs(itype(i))
1418 if (itypi.eq.ntyp1) cycle
1419 itypi1=iabs(itype(i+1))
1423 dxi=dc_norm(1,nres+i)
1424 dyi=dc_norm(2,nres+i)
1425 dzi=dc_norm(3,nres+i)
1426 c dsci_inv=dsc_inv(itypi)
1427 dsci_inv=vbld_inv(i+nres)
1429 C Calculate SC interaction energy.
1431 do iint=1,nint_gr(i)
1432 do j=istart(i,iint),iend(i,iint)
1434 itypj=iabs(itype(j))
1435 if (itypj.eq.ntyp1) cycle
1436 c dscj_inv=dsc_inv(itypj)
1437 dscj_inv=vbld_inv(j+nres)
1438 chi1=chi(itypi,itypj)
1439 chi2=chi(itypj,itypi)
1446 alf12=0.5D0*(alf1+alf2)
1447 C For diagnostics only!!!
1460 dxj=dc_norm(1,nres+j)
1461 dyj=dc_norm(2,nres+j)
1462 dzj=dc_norm(3,nres+j)
1463 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1464 cd if (icall.eq.0) then
1470 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1472 C Calculate whole angle-dependent part of epsilon and contributions
1473 C to its derivatives
1474 C have you changed here?
1475 fac=(rrij*sigsq)**expon2
1478 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1479 eps2der=evdwij*eps3rt
1480 eps3der=evdwij*eps2rt
1481 evdwij=evdwij*eps2rt*eps3rt
1484 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1486 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1487 cd & restyp(itypi),i,restyp(itypj),j,
1488 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1489 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1490 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1493 C Calculate gradient components.
1494 e1=e1*eps1*eps2rt**2*eps3rt**2
1495 fac=-expon*(e1+evdwij)
1498 C Calculate radial part of the gradient
1502 C Calculate the angular part of the gradient and sum add the contributions
1503 C to the appropriate components of the Cartesian gradient.
1511 C-----------------------------------------------------------------------------
1512 subroutine egb(evdw)
1514 C This subroutine calculates the interaction energy of nonbonded side chains
1515 C assuming the Gay-Berne potential of interaction.
1517 implicit real*8 (a-h,o-z)
1518 include 'DIMENSIONS'
1519 include 'COMMON.GEO'
1520 include 'COMMON.VAR'
1521 include 'COMMON.LOCAL'
1522 include 'COMMON.CHAIN'
1523 include 'COMMON.DERIV'
1524 include 'COMMON.NAMES'
1525 include 'COMMON.INTERACT'
1526 include 'COMMON.IOUNITS'
1527 include 'COMMON.CALC'
1528 include 'COMMON.CONTROL'
1529 include 'COMMON.SPLITELE'
1530 include 'COMMON.SBRIDGE'
1532 integer xshift,yshift,zshift
1535 ccccc energy_dec=.false.
1536 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1539 c if (icall.eq.0) lprn=.false.
1541 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1542 C we have the original box)
1546 do i=iatsc_s,iatsc_e
1547 itypi=iabs(itype(i))
1548 if (itypi.eq.ntyp1) cycle
1549 itypi1=iabs(itype(i+1))
1553 C Return atom into box, boxxsize is size of box in x dimension
1555 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1556 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1557 C Condition for being inside the proper box
1558 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1559 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1563 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1564 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1565 C Condition for being inside the proper box
1566 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1567 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1571 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1572 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1573 C Condition for being inside the proper box
1574 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1575 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1579 if (xi.lt.0) xi=xi+boxxsize
1581 if (yi.lt.0) yi=yi+boxysize
1583 if (zi.lt.0) zi=zi+boxzsize
1584 C define scaling factor for lipids
1586 C if (positi.le.0) positi=positi+boxzsize
1588 C first for peptide groups
1589 c for each residue check if it is in lipid or lipid water border area
1590 if ((zi.gt.bordlipbot)
1591 &.and.(zi.lt.bordliptop)) then
1592 C the energy transfer exist
1593 if (zi.lt.buflipbot) then
1594 C what fraction I am in
1596 & ((zi-bordlipbot)/lipbufthick)
1597 C lipbufthick is thickenes of lipid buffore
1598 sslipi=sscalelip(fracinbuf)
1599 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1600 elseif (zi.gt.bufliptop) then
1601 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1602 sslipi=sscalelip(fracinbuf)
1603 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1613 C xi=xi+xshift*boxxsize
1614 C yi=yi+yshift*boxysize
1615 C zi=zi+zshift*boxzsize
1617 dxi=dc_norm(1,nres+i)
1618 dyi=dc_norm(2,nres+i)
1619 dzi=dc_norm(3,nres+i)
1620 c dsci_inv=dsc_inv(itypi)
1621 dsci_inv=vbld_inv(i+nres)
1622 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1623 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1625 C Calculate SC interaction energy.
1627 do iint=1,nint_gr(i)
1628 do j=istart(i,iint),iend(i,iint)
1629 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1630 call dyn_ssbond_ene(i,j,evdwij)
1632 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1633 & 'evdw',i,j,evdwij,' ss'
1636 itypj=iabs(itype(j))
1637 if (itypj.eq.ntyp1) cycle
1638 c dscj_inv=dsc_inv(itypj)
1639 dscj_inv=vbld_inv(j+nres)
1640 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1641 c & 1.0d0/vbld(j+nres)
1642 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1643 sig0ij=sigma(itypi,itypj)
1644 chi1=chi(itypi,itypj)
1645 chi2=chi(itypj,itypi)
1652 alf12=0.5D0*(alf1+alf2)
1653 C For diagnostics only!!!
1666 C Return atom J into box the original box
1668 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1669 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1670 C Condition for being inside the proper box
1671 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1672 c & (xj.lt.((-0.5d0)*boxxsize))) then
1676 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1677 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1678 C Condition for being inside the proper box
1679 c if ((yj.gt.((0.5d0)*boxysize)).or.
1680 c & (yj.lt.((-0.5d0)*boxysize))) then
1684 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1685 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1686 C Condition for being inside the proper box
1687 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1688 c & (zj.lt.((-0.5d0)*boxzsize))) then
1692 if (xj.lt.0) xj=xj+boxxsize
1694 if (yj.lt.0) yj=yj+boxysize
1696 if (zj.lt.0) zj=zj+boxzsize
1697 if ((zj.gt.bordlipbot)
1698 &.and.(zj.lt.bordliptop)) then
1699 C the energy transfer exist
1700 if (zj.lt.buflipbot) then
1701 C what fraction I am in
1703 & ((zj-bordlipbot)/lipbufthick)
1704 C lipbufthick is thickenes of lipid buffore
1705 sslipj=sscalelip(fracinbuf)
1706 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1707 elseif (zj.gt.bufliptop) then
1708 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1709 sslipj=sscalelip(fracinbuf)
1710 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1719 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1720 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1721 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1722 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1723 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1724 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1725 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1726 C print *,sslipi,sslipj,bordlipbot,zi,zj
1727 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1735 xj=xj_safe+xshift*boxxsize
1736 yj=yj_safe+yshift*boxysize
1737 zj=zj_safe+zshift*boxzsize
1738 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1739 if(dist_temp.lt.dist_init) then
1749 if (subchap.eq.1) then
1758 dxj=dc_norm(1,nres+j)
1759 dyj=dc_norm(2,nres+j)
1760 dzj=dc_norm(3,nres+j)
1764 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1765 c write (iout,*) "j",j," dc_norm",
1766 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1767 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1769 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1770 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1772 c write (iout,'(a7,4f8.3)')
1773 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1774 if (sss.gt.0.0d0) then
1775 C Calculate angle-dependent terms of energy and contributions to their
1779 sig=sig0ij*dsqrt(sigsq)
1780 rij_shift=1.0D0/rij-sig+sig0ij
1781 c for diagnostics; uncomment
1782 c rij_shift=1.2*sig0ij
1783 C I hate to put IF's in the loops, but here don't have another choice!!!!
1784 if (rij_shift.le.0.0D0) then
1786 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1787 cd & restyp(itypi),i,restyp(itypj),j,
1788 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1792 c---------------------------------------------------------------
1793 rij_shift=1.0D0/rij_shift
1794 fac=rij_shift**expon
1795 C here to start with
1800 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1801 eps2der=evdwij*eps3rt
1802 eps3der=evdwij*eps2rt
1803 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1804 C &((sslipi+sslipj)/2.0d0+
1805 C &(2.0d0-sslipi-sslipj)/2.0d0)
1806 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1807 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1808 evdwij=evdwij*eps2rt*eps3rt
1809 evdw=evdw+evdwij*sss
1811 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1813 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1814 & restyp(itypi),i,restyp(itypj),j,
1815 & epsi,sigm,chi1,chi2,chip1,chip2,
1816 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1817 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1821 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1824 C Calculate gradient components.
1825 e1=e1*eps1*eps2rt**2*eps3rt**2
1826 fac=-expon*(e1+evdwij)*rij_shift
1829 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1830 c & evdwij,fac,sigma(itypi,itypj),expon
1831 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1833 C Calculate the radial part of the gradient
1834 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1835 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1836 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1837 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1838 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1839 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1845 C Calculate angular part of the gradient.
1855 c write (iout,*) "Number of loop steps in EGB:",ind
1856 cccc energy_dec=.false.
1859 C-----------------------------------------------------------------------------
1860 subroutine egbv(evdw)
1862 C This subroutine calculates the interaction energy of nonbonded side chains
1863 C assuming the Gay-Berne-Vorobjev potential of interaction.
1865 implicit real*8 (a-h,o-z)
1866 include 'DIMENSIONS'
1867 include 'COMMON.GEO'
1868 include 'COMMON.VAR'
1869 include 'COMMON.LOCAL'
1870 include 'COMMON.CHAIN'
1871 include 'COMMON.DERIV'
1872 include 'COMMON.NAMES'
1873 include 'COMMON.INTERACT'
1874 include 'COMMON.IOUNITS'
1875 include 'COMMON.CALC'
1876 common /srutu/ icall
1879 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1882 c if (icall.eq.0) lprn=.true.
1884 do i=iatsc_s,iatsc_e
1885 itypi=iabs(itype(i))
1886 if (itypi.eq.ntyp1) cycle
1887 itypi1=iabs(itype(i+1))
1892 if (xi.lt.0) xi=xi+boxxsize
1894 if (yi.lt.0) yi=yi+boxysize
1896 if (zi.lt.0) zi=zi+boxzsize
1897 C define scaling factor for lipids
1899 C if (positi.le.0) positi=positi+boxzsize
1901 C first for peptide groups
1902 c for each residue check if it is in lipid or lipid water border area
1903 if ((zi.gt.bordlipbot)
1904 &.and.(zi.lt.bordliptop)) then
1905 C the energy transfer exist
1906 if (zi.lt.buflipbot) then
1907 C what fraction I am in
1909 & ((zi-bordlipbot)/lipbufthick)
1910 C lipbufthick is thickenes of lipid buffore
1911 sslipi=sscalelip(fracinbuf)
1912 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1913 elseif (zi.gt.bufliptop) then
1914 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1915 sslipi=sscalelip(fracinbuf)
1916 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1926 dxi=dc_norm(1,nres+i)
1927 dyi=dc_norm(2,nres+i)
1928 dzi=dc_norm(3,nres+i)
1929 c dsci_inv=dsc_inv(itypi)
1930 dsci_inv=vbld_inv(i+nres)
1932 C Calculate SC interaction energy.
1934 do iint=1,nint_gr(i)
1935 do j=istart(i,iint),iend(i,iint)
1937 itypj=iabs(itype(j))
1938 if (itypj.eq.ntyp1) cycle
1939 c dscj_inv=dsc_inv(itypj)
1940 dscj_inv=vbld_inv(j+nres)
1941 sig0ij=sigma(itypi,itypj)
1942 r0ij=r0(itypi,itypj)
1943 chi1=chi(itypi,itypj)
1944 chi2=chi(itypj,itypi)
1951 alf12=0.5D0*(alf1+alf2)
1952 C For diagnostics only!!!
1966 if (xj.lt.0) xj=xj+boxxsize
1968 if (yj.lt.0) yj=yj+boxysize
1970 if (zj.lt.0) zj=zj+boxzsize
1971 if ((zj.gt.bordlipbot)
1972 &.and.(zj.lt.bordliptop)) then
1973 C the energy transfer exist
1974 if (zj.lt.buflipbot) then
1975 C what fraction I am in
1977 & ((zj-bordlipbot)/lipbufthick)
1978 C lipbufthick is thickenes of lipid buffore
1979 sslipj=sscalelip(fracinbuf)
1980 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1981 elseif (zj.gt.bufliptop) then
1982 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1983 sslipj=sscalelip(fracinbuf)
1984 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1993 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1994 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1995 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1996 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1997 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
1998 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1999 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2007 xj=xj_safe+xshift*boxxsize
2008 yj=yj_safe+yshift*boxysize
2009 zj=zj_safe+zshift*boxzsize
2010 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2011 if(dist_temp.lt.dist_init) then
2021 if (subchap.eq.1) then
2030 dxj=dc_norm(1,nres+j)
2031 dyj=dc_norm(2,nres+j)
2032 dzj=dc_norm(3,nres+j)
2033 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2035 C Calculate angle-dependent terms of energy and contributions to their
2039 sig=sig0ij*dsqrt(sigsq)
2040 rij_shift=1.0D0/rij-sig+r0ij
2041 C I hate to put IF's in the loops, but here don't have another choice!!!!
2042 if (rij_shift.le.0.0D0) then
2047 c---------------------------------------------------------------
2048 rij_shift=1.0D0/rij_shift
2049 fac=rij_shift**expon
2052 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2053 eps2der=evdwij*eps3rt
2054 eps3der=evdwij*eps2rt
2055 fac_augm=rrij**expon
2056 e_augm=augm(itypi,itypj)*fac_augm
2057 evdwij=evdwij*eps2rt*eps3rt
2058 evdw=evdw+evdwij+e_augm
2060 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2062 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2063 & restyp(itypi),i,restyp(itypj),j,
2064 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2065 & chi1,chi2,chip1,chip2,
2066 & eps1,eps2rt**2,eps3rt**2,
2067 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2070 C Calculate gradient components.
2071 e1=e1*eps1*eps2rt**2*eps3rt**2
2072 fac=-expon*(e1+evdwij)*rij_shift
2074 fac=rij*fac-2*expon*rrij*e_augm
2075 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2076 C Calculate the radial part of the gradient
2080 C Calculate angular part of the gradient.
2086 C-----------------------------------------------------------------------------
2087 subroutine sc_angular
2088 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2089 C om12. Called by ebp, egb, and egbv.
2091 include 'COMMON.CALC'
2092 include 'COMMON.IOUNITS'
2096 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2097 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2098 om12=dxi*dxj+dyi*dyj+dzi*dzj
2100 C Calculate eps1(om12) and its derivative in om12
2101 faceps1=1.0D0-om12*chiom12
2102 faceps1_inv=1.0D0/faceps1
2103 eps1=dsqrt(faceps1_inv)
2104 C Following variable is eps1*deps1/dom12
2105 eps1_om12=faceps1_inv*chiom12
2110 c write (iout,*) "om12",om12," eps1",eps1
2111 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2116 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2117 sigsq=1.0D0-facsig*faceps1_inv
2118 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2119 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2120 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2126 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2127 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2129 C Calculate eps2 and its derivatives in om1, om2, and om12.
2132 chipom12=chip12*om12
2133 facp=1.0D0-om12*chipom12
2135 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2136 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2137 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2138 C Following variable is the square root of eps2
2139 eps2rt=1.0D0-facp1*facp_inv
2140 C Following three variables are the derivatives of the square root of eps
2141 C in om1, om2, and om12.
2142 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2143 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2144 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2145 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2146 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2147 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2148 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2149 c & " eps2rt_om12",eps2rt_om12
2150 C Calculate whole angle-dependent part of epsilon and contributions
2151 C to its derivatives
2154 C----------------------------------------------------------------------------
2156 implicit real*8 (a-h,o-z)
2157 include 'DIMENSIONS'
2158 include 'COMMON.CHAIN'
2159 include 'COMMON.DERIV'
2160 include 'COMMON.CALC'
2161 include 'COMMON.IOUNITS'
2162 double precision dcosom1(3),dcosom2(3)
2163 cc print *,'sss=',sss
2164 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2165 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2166 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2167 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2171 c eom12=evdwij*eps1_om12
2173 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2174 c & " sigder",sigder
2175 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2176 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2178 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2179 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2182 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2184 c write (iout,*) "gg",(gg(k),k=1,3)
2186 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2187 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2188 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2189 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2190 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2191 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2192 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2193 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2194 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2195 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2198 C Calculate the components of the gradient in DC and X
2202 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2206 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2207 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2211 C-----------------------------------------------------------------------
2212 subroutine e_softsphere(evdw)
2214 C This subroutine calculates the interaction energy of nonbonded side chains
2215 C assuming the LJ potential of interaction.
2217 implicit real*8 (a-h,o-z)
2218 include 'DIMENSIONS'
2219 parameter (accur=1.0d-10)
2220 include 'COMMON.GEO'
2221 include 'COMMON.VAR'
2222 include 'COMMON.LOCAL'
2223 include 'COMMON.CHAIN'
2224 include 'COMMON.DERIV'
2225 include 'COMMON.INTERACT'
2226 include 'COMMON.TORSION'
2227 include 'COMMON.SBRIDGE'
2228 include 'COMMON.NAMES'
2229 include 'COMMON.IOUNITS'
2230 include 'COMMON.CONTACTS'
2232 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2234 do i=iatsc_s,iatsc_e
2235 itypi=iabs(itype(i))
2236 if (itypi.eq.ntyp1) cycle
2237 itypi1=iabs(itype(i+1))
2242 C Calculate SC interaction energy.
2244 do iint=1,nint_gr(i)
2245 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2246 cd & 'iend=',iend(i,iint)
2247 do j=istart(i,iint),iend(i,iint)
2248 itypj=iabs(itype(j))
2249 if (itypj.eq.ntyp1) cycle
2253 rij=xj*xj+yj*yj+zj*zj
2254 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2255 r0ij=r0(itypi,itypj)
2257 c print *,i,j,r0ij,dsqrt(rij)
2258 if (rij.lt.r0ijsq) then
2259 evdwij=0.25d0*(rij-r0ijsq)**2
2267 C Calculate the components of the gradient in DC and X
2273 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2274 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2275 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2276 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2280 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2288 C--------------------------------------------------------------------------
2289 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2292 C Soft-sphere potential of p-p interaction
2294 implicit real*8 (a-h,o-z)
2295 include 'DIMENSIONS'
2296 include 'COMMON.CONTROL'
2297 include 'COMMON.IOUNITS'
2298 include 'COMMON.GEO'
2299 include 'COMMON.VAR'
2300 include 'COMMON.LOCAL'
2301 include 'COMMON.CHAIN'
2302 include 'COMMON.DERIV'
2303 include 'COMMON.INTERACT'
2304 include 'COMMON.CONTACTS'
2305 include 'COMMON.TORSION'
2306 include 'COMMON.VECTORS'
2307 include 'COMMON.FFIELD'
2309 C write(iout,*) 'In EELEC_soft_sphere'
2316 do i=iatel_s,iatel_e
2317 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2321 xmedi=c(1,i)+0.5d0*dxi
2322 ymedi=c(2,i)+0.5d0*dyi
2323 zmedi=c(3,i)+0.5d0*dzi
2324 xmedi=mod(xmedi,boxxsize)
2325 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2326 ymedi=mod(ymedi,boxysize)
2327 if (ymedi.lt.0) ymedi=ymedi+boxysize
2328 zmedi=mod(zmedi,boxzsize)
2329 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2331 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2332 do j=ielstart(i),ielend(i)
2333 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2337 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2338 r0ij=rpp(iteli,itelj)
2347 if (xj.lt.0) xj=xj+boxxsize
2349 if (yj.lt.0) yj=yj+boxysize
2351 if (zj.lt.0) zj=zj+boxzsize
2352 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2360 xj=xj_safe+xshift*boxxsize
2361 yj=yj_safe+yshift*boxysize
2362 zj=zj_safe+zshift*boxzsize
2363 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2364 if(dist_temp.lt.dist_init) then
2374 if (isubchap.eq.1) then
2383 rij=xj*xj+yj*yj+zj*zj
2384 sss=sscale(sqrt(rij))
2385 sssgrad=sscagrad(sqrt(rij))
2386 if (rij.lt.r0ijsq) then
2387 evdw1ij=0.25d0*(rij-r0ijsq)**2
2393 evdw1=evdw1+evdw1ij*sss
2395 C Calculate contributions to the Cartesian gradient.
2397 ggg(1)=fac*xj*sssgrad
2398 ggg(2)=fac*yj*sssgrad
2399 ggg(3)=fac*zj*sssgrad
2401 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2402 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2405 * Loop over residues i+1 thru j-1.
2409 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2414 cgrad do i=nnt,nct-1
2416 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2418 cgrad do j=i+1,nct-1
2420 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2426 c------------------------------------------------------------------------------
2427 subroutine vec_and_deriv
2428 implicit real*8 (a-h,o-z)
2429 include 'DIMENSIONS'
2433 include 'COMMON.IOUNITS'
2434 include 'COMMON.GEO'
2435 include 'COMMON.VAR'
2436 include 'COMMON.LOCAL'
2437 include 'COMMON.CHAIN'
2438 include 'COMMON.VECTORS'
2439 include 'COMMON.SETUP'
2440 include 'COMMON.TIME1'
2441 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2442 C Compute the local reference systems. For reference system (i), the
2443 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2444 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2446 do i=ivec_start,ivec_end
2450 if (i.eq.nres-1) then
2451 C Case of the last full residue
2452 C Compute the Z-axis
2453 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2454 costh=dcos(pi-theta(nres))
2455 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2459 C Compute the derivatives of uz
2461 uzder(2,1,1)=-dc_norm(3,i-1)
2462 uzder(3,1,1)= dc_norm(2,i-1)
2463 uzder(1,2,1)= dc_norm(3,i-1)
2465 uzder(3,2,1)=-dc_norm(1,i-1)
2466 uzder(1,3,1)=-dc_norm(2,i-1)
2467 uzder(2,3,1)= dc_norm(1,i-1)
2470 uzder(2,1,2)= dc_norm(3,i)
2471 uzder(3,1,2)=-dc_norm(2,i)
2472 uzder(1,2,2)=-dc_norm(3,i)
2474 uzder(3,2,2)= dc_norm(1,i)
2475 uzder(1,3,2)= dc_norm(2,i)
2476 uzder(2,3,2)=-dc_norm(1,i)
2478 C Compute the Y-axis
2481 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2483 C Compute the derivatives of uy
2486 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2487 & -dc_norm(k,i)*dc_norm(j,i-1)
2488 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2490 uyder(j,j,1)=uyder(j,j,1)-costh
2491 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2496 uygrad(l,k,j,i)=uyder(l,k,j)
2497 uzgrad(l,k,j,i)=uzder(l,k,j)
2501 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2502 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2503 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2504 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2507 C Compute the Z-axis
2508 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2509 costh=dcos(pi-theta(i+2))
2510 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2514 C Compute the derivatives of uz
2516 uzder(2,1,1)=-dc_norm(3,i+1)
2517 uzder(3,1,1)= dc_norm(2,i+1)
2518 uzder(1,2,1)= dc_norm(3,i+1)
2520 uzder(3,2,1)=-dc_norm(1,i+1)
2521 uzder(1,3,1)=-dc_norm(2,i+1)
2522 uzder(2,3,1)= dc_norm(1,i+1)
2525 uzder(2,1,2)= dc_norm(3,i)
2526 uzder(3,1,2)=-dc_norm(2,i)
2527 uzder(1,2,2)=-dc_norm(3,i)
2529 uzder(3,2,2)= dc_norm(1,i)
2530 uzder(1,3,2)= dc_norm(2,i)
2531 uzder(2,3,2)=-dc_norm(1,i)
2533 C Compute the Y-axis
2536 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2538 C Compute the derivatives of uy
2541 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2542 & -dc_norm(k,i)*dc_norm(j,i+1)
2543 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2545 uyder(j,j,1)=uyder(j,j,1)-costh
2546 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2551 uygrad(l,k,j,i)=uyder(l,k,j)
2552 uzgrad(l,k,j,i)=uzder(l,k,j)
2556 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2557 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2558 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2559 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2563 vbld_inv_temp(1)=vbld_inv(i+1)
2564 if (i.lt.nres-1) then
2565 vbld_inv_temp(2)=vbld_inv(i+2)
2567 vbld_inv_temp(2)=vbld_inv(i)
2572 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2573 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2578 #if defined(PARVEC) && defined(MPI)
2579 if (nfgtasks1.gt.1) then
2581 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2582 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2583 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2584 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2585 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2587 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2588 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2590 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2591 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2592 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2593 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2594 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2595 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2596 time_gather=time_gather+MPI_Wtime()-time00
2598 c if (fg_rank.eq.0) then
2599 c write (iout,*) "Arrays UY and UZ"
2601 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2608 C-----------------------------------------------------------------------------
2609 subroutine check_vecgrad
2610 implicit real*8 (a-h,o-z)
2611 include 'DIMENSIONS'
2612 include 'COMMON.IOUNITS'
2613 include 'COMMON.GEO'
2614 include 'COMMON.VAR'
2615 include 'COMMON.LOCAL'
2616 include 'COMMON.CHAIN'
2617 include 'COMMON.VECTORS'
2618 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2619 dimension uyt(3,maxres),uzt(3,maxres)
2620 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2621 double precision delta /1.0d-7/
2624 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2625 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2626 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2627 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2628 cd & (dc_norm(if90,i),if90=1,3)
2629 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2630 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2631 cd write(iout,'(a)')
2637 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2638 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2651 cd write (iout,*) 'i=',i
2653 erij(k)=dc_norm(k,i)
2657 dc_norm(k,i)=erij(k)
2659 dc_norm(j,i)=dc_norm(j,i)+delta
2660 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2662 c dc_norm(k,i)=dc_norm(k,i)/fac
2664 c write (iout,*) (dc_norm(k,i),k=1,3)
2665 c write (iout,*) (erij(k),k=1,3)
2668 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2669 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2670 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2671 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2673 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2674 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2675 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2678 dc_norm(k,i)=erij(k)
2681 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2682 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2683 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2684 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2685 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2686 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2687 cd write (iout,'(a)')
2692 C--------------------------------------------------------------------------
2693 subroutine set_matrices
2694 implicit real*8 (a-h,o-z)
2695 include 'DIMENSIONS'
2698 include "COMMON.SETUP"
2700 integer status(MPI_STATUS_SIZE)
2702 include 'COMMON.IOUNITS'
2703 include 'COMMON.GEO'
2704 include 'COMMON.VAR'
2705 include 'COMMON.LOCAL'
2706 include 'COMMON.CHAIN'
2707 include 'COMMON.DERIV'
2708 include 'COMMON.INTERACT'
2709 include 'COMMON.CONTACTS'
2710 include 'COMMON.TORSION'
2711 include 'COMMON.VECTORS'
2712 include 'COMMON.FFIELD'
2713 double precision auxvec(2),auxmat(2,2)
2715 C Compute the virtual-bond-torsional-angle dependent quantities needed
2716 C to calculate the el-loc multibody terms of various order.
2718 c write(iout,*) 'nphi=',nphi,nres
2720 do i=ivec_start+2,ivec_end+2
2725 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2726 iti = itortyp(itype(i-2))
2730 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2731 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2732 iti1 = itortyp(itype(i-1))
2737 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2738 & +bnew1(2,1,iti)*dsin(theta(i-1))
2739 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2740 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2741 & +bnew1(2,1,iti)*dcos(theta(i-1))
2742 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2743 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2744 c &*(cos(theta(i)/2.0)
2745 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2746 & +bnew2(2,1,iti)*dsin(theta(i-1))
2747 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2748 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2749 c &*(cos(theta(i)/2.0)
2750 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2751 & +bnew2(2,1,iti)*dcos(theta(i-1))
2752 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2753 c if (ggb1(1,i).eq.0.0d0) then
2754 c write(iout,*) 'i=',i,ggb1(1,i),
2755 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2756 c &bnew1(2,1,iti)*cos(theta(i)),
2757 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2759 b1(2,i-2)=bnew1(1,2,iti)
2761 b2(2,i-2)=bnew2(1,2,iti)
2763 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2764 EE(1,2,i-2)=eeold(1,2,iti)
2765 EE(2,1,i-2)=eeold(2,1,iti)
2766 EE(2,2,i-2)=eeold(2,2,iti)
2767 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2772 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2773 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2774 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2775 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2776 b1tilde(1,i-2)=b1(1,i-2)
2777 b1tilde(2,i-2)=-b1(2,i-2)
2778 b2tilde(1,i-2)=b2(1,i-2)
2779 b2tilde(2,i-2)=-b2(2,i-2)
2780 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2781 c write(iout,*) 'b1=',b1(1,i-2)
2782 c write (iout,*) 'theta=', theta(i-1)
2785 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2786 iti = itortyp(itype(i-2))
2790 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2791 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2792 iti1 = itortyp(itype(i-1))
2800 b1tilde(1,i-2)= b1(1,i-2)
2801 b1tilde(2,i-2)=-b1(2,i-2)
2802 b2tilde(1,i-2)= b2(1,i-2)
2803 b2tilde(2,i-2)=-b2(2,i-2)
2804 EE(1,2,i-2)=eeold(1,2,iti)
2805 EE(2,1,i-2)=eeold(2,1,iti)
2806 EE(2,2,i-2)=eeold(2,2,iti)
2807 EE(1,1,i-2)=eeold(1,1,iti)
2811 do i=ivec_start+2,ivec_end+2
2815 if (i .lt. nres+1) then
2852 if (i .gt. 3 .and. i .lt. nres+1) then
2853 obrot_der(1,i-2)=-sin1
2854 obrot_der(2,i-2)= cos1
2855 Ugder(1,1,i-2)= sin1
2856 Ugder(1,2,i-2)=-cos1
2857 Ugder(2,1,i-2)=-cos1
2858 Ugder(2,2,i-2)=-sin1
2861 obrot2_der(1,i-2)=-dwasin2
2862 obrot2_der(2,i-2)= dwacos2
2863 Ug2der(1,1,i-2)= dwasin2
2864 Ug2der(1,2,i-2)=-dwacos2
2865 Ug2der(2,1,i-2)=-dwacos2
2866 Ug2der(2,2,i-2)=-dwasin2
2868 obrot_der(1,i-2)=0.0d0
2869 obrot_der(2,i-2)=0.0d0
2870 Ugder(1,1,i-2)=0.0d0
2871 Ugder(1,2,i-2)=0.0d0
2872 Ugder(2,1,i-2)=0.0d0
2873 Ugder(2,2,i-2)=0.0d0
2874 obrot2_der(1,i-2)=0.0d0
2875 obrot2_der(2,i-2)=0.0d0
2876 Ug2der(1,1,i-2)=0.0d0
2877 Ug2der(1,2,i-2)=0.0d0
2878 Ug2der(2,1,i-2)=0.0d0
2879 Ug2der(2,2,i-2)=0.0d0
2881 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2882 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2883 iti = itortyp(itype(i-2))
2887 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2888 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2889 iti1 = itortyp(itype(i-1))
2893 cd write (iout,*) '*******i',i,' iti1',iti
2894 cd write (iout,*) 'b1',b1(:,iti)
2895 cd write (iout,*) 'b2',b2(:,iti)
2896 cd write (iout,*) "phi(",i,")=",phi(i)," sin1",sin1," cos1",cos1
2897 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2898 c if (i .gt. iatel_s+2) then
2899 if (i .gt. nnt+2) then
2900 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2902 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2903 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2905 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2906 c & EE(1,2,iti),EE(2,2,iti)
2907 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2908 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2909 c write(iout,*) "Macierz EUG",
2910 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2912 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2914 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2915 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2916 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2917 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2918 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2929 DtUg2(l,k,i-2)=0.0d0
2933 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2934 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2936 muder(k,i-2)=Ub2der(k,i-2)
2938 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2939 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2940 if (itype(i-1).le.ntyp) then
2941 iti1 = itortyp(itype(i-1))
2949 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2951 C write (iout,*) 'mumu',i,b1(1,i-1),Ub2(1,i-2)
2952 cd write (iout,*) 'mu ',mu(:,i-2),i-2
2953 cd write (iout,*) 'b1 ',b1(:,i-1),i-2
2954 cd write (iout,*) 'Ub2 ',Ub2(:,i-2),i-2
2955 cd write (iout,*) 'Ug ',Ug(:,:,i-2),i-2
2956 cd write (iout,*) 'b2 ',b2(:,i-2),i-2
2957 cd write (iout,*) 'mu1',mu1(:,i-2)
2958 cd write (iout,*) 'mu2',mu2(:,i-2)
2959 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2961 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2962 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2963 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2964 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2965 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2966 C Vectors and matrices dependent on a single virtual-bond dihedral.
2967 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2968 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2969 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2970 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2971 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2972 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2973 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2974 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2975 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2978 C Matrices dependent on two consecutive virtual-bond dihedrals.
2979 C The order of matrices is from left to right.
2980 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2982 c do i=max0(ivec_start,2),ivec_end
2984 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2985 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2986 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2987 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2988 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2989 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2990 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2991 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2994 #if defined(MPI) && defined(PARMAT)
2996 c if (fg_rank.eq.0) then
2997 write (iout,*) "Arrays UG and UGDER before GATHER"
2999 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3000 & ((ug(l,k,i),l=1,2),k=1,2),
3001 & ((ugder(l,k,i),l=1,2),k=1,2)
3003 write (iout,*) "Arrays UG2 and UG2DER"
3005 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3006 & ((ug2(l,k,i),l=1,2),k=1,2),
3007 & ((ug2der(l,k,i),l=1,2),k=1,2)
3009 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3011 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3012 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3013 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3015 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3017 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3018 & costab(i),sintab(i),costab2(i),sintab2(i)
3020 write (iout,*) "Array MUDER"
3022 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3026 if (nfgtasks.gt.1) then
3028 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
3029 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
3030 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
3032 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
3033 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3035 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
3036 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3038 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
3039 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3041 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
3042 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3044 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
3045 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3047 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
3048 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3050 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
3051 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
3052 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3053 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
3054 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
3055 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3056 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
3057 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
3058 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3059 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
3060 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
3061 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3062 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3064 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
3065 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3067 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
3068 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3070 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
3071 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3073 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3074 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3076 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3077 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3079 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3080 & ivec_count(fg_rank1),
3081 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3083 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3084 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3086 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3087 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3089 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3090 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3092 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3093 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3095 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3096 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3098 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3099 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3101 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3102 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3104 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3105 & ivec_count(fg_rank1),
3106 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3108 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3109 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3111 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3112 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3114 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3115 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3117 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3118 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3120 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3121 & ivec_count(fg_rank1),
3122 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3124 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3125 & ivec_count(fg_rank1),
3126 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3128 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3129 & ivec_count(fg_rank1),
3130 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3131 & MPI_MAT2,FG_COMM1,IERR)
3132 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3133 & ivec_count(fg_rank1),
3134 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3135 & MPI_MAT2,FG_COMM1,IERR)
3138 c Passes matrix info through the ring
3141 if (irecv.lt.0) irecv=nfgtasks1-1
3144 if (inext.ge.nfgtasks1) inext=0
3146 c write (iout,*) "isend",isend," irecv",irecv
3148 lensend=lentyp(isend)
3149 lenrecv=lentyp(irecv)
3150 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3151 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3152 c & MPI_ROTAT1(lensend),inext,2200+isend,
3153 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3154 c & iprev,2200+irecv,FG_COMM,status,IERR)
3155 c write (iout,*) "Gather ROTAT1"
3157 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3158 c & MPI_ROTAT2(lensend),inext,3300+isend,
3159 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3160 c & iprev,3300+irecv,FG_COMM,status,IERR)
3161 c write (iout,*) "Gather ROTAT2"
3163 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3164 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3165 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3166 & iprev,4400+irecv,FG_COMM,status,IERR)
3167 c write (iout,*) "Gather ROTAT_OLD"
3169 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3170 & MPI_PRECOMP11(lensend),inext,5500+isend,
3171 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3172 & iprev,5500+irecv,FG_COMM,status,IERR)
3173 c write (iout,*) "Gather PRECOMP11"
3175 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3176 & MPI_PRECOMP12(lensend),inext,6600+isend,
3177 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3178 & iprev,6600+irecv,FG_COMM,status,IERR)
3179 c write (iout,*) "Gather PRECOMP12"
3181 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3183 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3184 & MPI_ROTAT2(lensend),inext,7700+isend,
3185 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3186 & iprev,7700+irecv,FG_COMM,status,IERR)
3187 c write (iout,*) "Gather PRECOMP21"
3189 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3190 & MPI_PRECOMP22(lensend),inext,8800+isend,
3191 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3192 & iprev,8800+irecv,FG_COMM,status,IERR)
3193 c write (iout,*) "Gather PRECOMP22"
3195 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3196 & MPI_PRECOMP23(lensend),inext,9900+isend,
3197 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3198 & MPI_PRECOMP23(lenrecv),
3199 & iprev,9900+irecv,FG_COMM,status,IERR)
3200 c write (iout,*) "Gather PRECOMP23"
3205 if (irecv.lt.0) irecv=nfgtasks1-1
3208 time_gather=time_gather+MPI_Wtime()-time00
3211 c if (fg_rank.eq.0) then
3212 write (iout,*) "Arrays UG and UGDER"
3214 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3215 & ((ug(l,k,i),l=1,2),k=1,2),
3216 & ((ugder(l,k,i),l=1,2),k=1,2)
3218 write (iout,*) "Arrays UG2 and UG2DER"
3220 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3221 & ((ug2(l,k,i),l=1,2),k=1,2),
3222 & ((ug2der(l,k,i),l=1,2),k=1,2)
3224 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3226 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3227 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3228 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3230 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3232 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3233 & costab(i),sintab(i),costab2(i),sintab2(i)
3235 write (iout,*) "Array MUDER"
3237 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3243 cd iti = itortyp(itype(i))
3246 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3247 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3252 C--------------------------------------------------------------------------
3253 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3255 C This subroutine calculates the average interaction energy and its gradient
3256 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3257 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3258 C The potential depends both on the distance of peptide-group centers and on
3259 C the orientation of the CA-CA virtual bonds.
3261 implicit real*8 (a-h,o-z)
3265 include 'DIMENSIONS'
3266 include 'COMMON.CONTROL'
3267 include 'COMMON.SETUP'
3268 include 'COMMON.IOUNITS'
3269 include 'COMMON.GEO'
3270 include 'COMMON.VAR'
3271 include 'COMMON.LOCAL'
3272 include 'COMMON.CHAIN'
3273 include 'COMMON.DERIV'
3274 include 'COMMON.INTERACT'
3275 include 'COMMON.CONTACTS'
3276 include 'COMMON.TORSION'
3277 include 'COMMON.VECTORS'
3278 include 'COMMON.FFIELD'
3279 include 'COMMON.TIME1'
3280 include 'COMMON.SPLITELE'
3281 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3282 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3283 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3284 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3285 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3286 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3288 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3290 double precision scal_el /1.0d0/
3292 double precision scal_el /0.5d0/
3295 C 13-go grudnia roku pamietnego...
3296 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3297 & 0.0d0,1.0d0,0.0d0,
3298 & 0.0d0,0.0d0,1.0d0/
3299 cd write(iout,*) 'In EELEC'
3301 cd write(iout,*) 'Type',i
3302 cd write(iout,*) 'B1',B1(:,i)
3303 cd write(iout,*) 'B2',B2(:,i)
3304 cd write(iout,*) 'CC',CC(:,:,i)
3305 cd write(iout,*) 'DD',DD(:,:,i)
3306 cd write(iout,*) 'EE',EE(:,:,i)
3308 cd call check_vecgrad
3310 if (icheckgrad.eq.1) then
3312 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3314 dc_norm(k,i)=dc(k,i)*fac
3316 c write (iout,*) 'i',i,' fac',fac
3319 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3320 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3321 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3322 c call vec_and_deriv
3328 time_mat=time_mat+MPI_Wtime()-time01
3332 cd write (iout,*) 'i=',i
3334 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3337 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3338 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3351 cd print '(a)','Enter EELEC'
3352 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3354 gel_loc_loc(i)=0.0d0
3359 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3361 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3363 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3364 do i=iturn3_start,iturn3_end
3365 CAna if (i.le.1) cycle
3366 C write(iout,*) "tu jest i",i
3367 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3368 C changes suggested by Ana to avoid out of bounds
3369 CAna & .or.((i+4).gt.nres)
3370 CAna & .or.((i-1).le.0)
3371 C end of changes by Ana
3372 & .or. itype(i+2).eq.ntyp1
3373 & .or. itype(i+3).eq.ntyp1) cycle
3375 CAna if(itype(i-1).eq.ntyp1)cycle
3377 CAna if(i.LT.nres-3)then
3378 CAna if (itype(i+4).eq.ntyp1) cycle
3383 dx_normi=dc_norm(1,i)
3384 dy_normi=dc_norm(2,i)
3385 dz_normi=dc_norm(3,i)
3386 xmedi=c(1,i)+0.5d0*dxi
3387 ymedi=c(2,i)+0.5d0*dyi
3388 zmedi=c(3,i)+0.5d0*dzi
3389 xmedi=mod(xmedi,boxxsize)
3390 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3391 ymedi=mod(ymedi,boxysize)
3392 if (ymedi.lt.0) ymedi=ymedi+boxysize
3393 zmedi=mod(zmedi,boxzsize)
3394 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3396 call eelecij(i,i+2,ees,evdw1,eel_loc)
3397 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3398 num_cont_hb(i)=num_conti
3400 do i=iturn4_start,iturn4_end
3401 cAna if (i.le.1) cycle
3402 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3403 C changes suggested by Ana to avoid out of bounds
3404 cAna & .or.((i+5).gt.nres)
3405 cAna & .or.((i-1).le.0)
3406 C end of changes suggested by Ana
3407 & .or. itype(i+3).eq.ntyp1
3408 & .or. itype(i+4).eq.ntyp1
3409 cAna & .or. itype(i+5).eq.ntyp1
3410 cAna & .or. itype(i).eq.ntyp1
3411 cAna & .or. itype(i-1).eq.ntyp1
3416 dx_normi=dc_norm(1,i)
3417 dy_normi=dc_norm(2,i)
3418 dz_normi=dc_norm(3,i)
3419 xmedi=c(1,i)+0.5d0*dxi
3420 ymedi=c(2,i)+0.5d0*dyi
3421 zmedi=c(3,i)+0.5d0*dzi
3422 C Return atom into box, boxxsize is size of box in x dimension
3424 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3425 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3426 C Condition for being inside the proper box
3427 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3428 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3432 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3433 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3434 C Condition for being inside the proper box
3435 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3436 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3440 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3441 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3442 C Condition for being inside the proper box
3443 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3444 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3447 xmedi=mod(xmedi,boxxsize)
3448 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3449 ymedi=mod(ymedi,boxysize)
3450 if (ymedi.lt.0) ymedi=ymedi+boxysize
3451 zmedi=mod(zmedi,boxzsize)
3452 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3454 num_conti=num_cont_hb(i)
3455 c write(iout,*) "JESTEM W PETLI"
3456 call eelecij(i,i+3,ees,evdw1,eel_loc)
3457 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3458 & call eturn4(i,eello_turn4)
3459 num_cont_hb(i)=num_conti
3461 C Loop over all neighbouring boxes
3466 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3468 do i=iatel_s,iatel_e
3469 cAna if (i.le.1) cycle
3470 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3471 C changes suggested by Ana to avoid out of bounds
3472 cAna & .or.((i+2).gt.nres)
3473 cAna & .or.((i-1).le.0)
3474 C end of changes by Ana
3475 cAna & .or. itype(i+2).eq.ntyp1
3476 cAna & .or. itype(i-1).eq.ntyp1
3481 dx_normi=dc_norm(1,i)
3482 dy_normi=dc_norm(2,i)
3483 dz_normi=dc_norm(3,i)
3484 xmedi=c(1,i)+0.5d0*dxi
3485 ymedi=c(2,i)+0.5d0*dyi
3486 zmedi=c(3,i)+0.5d0*dzi
3487 xmedi=mod(xmedi,boxxsize)
3488 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3489 ymedi=mod(ymedi,boxysize)
3490 if (ymedi.lt.0) ymedi=ymedi+boxysize
3491 zmedi=mod(zmedi,boxzsize)
3492 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3493 C xmedi=xmedi+xshift*boxxsize
3494 C ymedi=ymedi+yshift*boxysize
3495 C zmedi=zmedi+zshift*boxzsize
3497 C Return tom into box, boxxsize is size of box in x dimension
3499 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3500 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3501 C Condition for being inside the proper box
3502 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3503 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3507 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3508 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3509 C Condition for being inside the proper box
3510 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3511 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3515 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3516 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3517 cC Condition for being inside the proper box
3518 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3519 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3523 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3524 num_conti=num_cont_hb(i)
3525 do j=ielstart(i),ielend(i)
3526 C write (iout,*) i,j
3527 cAna if (j.le.1) cycle
3528 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3529 C changes suggested by Ana to avoid out of bounds
3530 cAna & .or.((j+2).gt.nres)
3531 cAna & .or.((j-1).le.0)
3532 C end of changes by Ana
3533 cAna & .or.itype(j+2).eq.ntyp1
3534 cAna & .or.itype(j-1).eq.ntyp1
3536 call eelecij(i,j,ees,evdw1,eel_loc)
3538 num_cont_hb(i)=num_conti
3544 c write (iout,*) "Number of loop steps in EELEC:",ind
3546 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3547 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3549 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3550 ccc eel_loc=eel_loc+eello_turn3
3551 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3554 C-------------------------------------------------------------------------------
3555 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3556 implicit real*8 (a-h,o-z)
3557 include 'DIMENSIONS'
3561 include 'COMMON.CONTROL'
3562 include 'COMMON.IOUNITS'
3563 include 'COMMON.GEO'
3564 include 'COMMON.VAR'
3565 include 'COMMON.LOCAL'
3566 include 'COMMON.CHAIN'
3567 include 'COMMON.DERIV'
3568 include 'COMMON.INTERACT'
3569 include 'COMMON.CONTACTS'
3570 include 'COMMON.TORSION'
3571 include 'COMMON.VECTORS'
3572 include 'COMMON.FFIELD'
3573 include 'COMMON.TIME1'
3574 include 'COMMON.SPLITELE'
3575 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3576 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3577 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3578 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3579 & gmuij2(4),gmuji2(4)
3580 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3581 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3583 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3585 double precision scal_el /1.0d0/
3587 double precision scal_el /0.5d0/
3590 C 13-go grudnia roku pamietnego...
3591 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3592 & 0.0d0,1.0d0,0.0d0,
3593 & 0.0d0,0.0d0,1.0d0/
3594 c time00=MPI_Wtime()
3595 cd write (iout,*) "eelecij",i,j
3599 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3600 aaa=app(iteli,itelj)
3601 bbb=bpp(iteli,itelj)
3602 ael6i=ael6(iteli,itelj)
3603 ael3i=ael3(iteli,itelj)
3607 dx_normj=dc_norm(1,j)
3608 dy_normj=dc_norm(2,j)
3609 dz_normj=dc_norm(3,j)
3610 C xj=c(1,j)+0.5D0*dxj-xmedi
3611 C yj=c(2,j)+0.5D0*dyj-ymedi
3612 C zj=c(3,j)+0.5D0*dzj-zmedi
3617 if (xj.lt.0) xj=xj+boxxsize
3619 if (yj.lt.0) yj=yj+boxysize
3621 if (zj.lt.0) zj=zj+boxzsize
3622 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3623 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3631 xj=xj_safe+xshift*boxxsize
3632 yj=yj_safe+yshift*boxysize
3633 zj=zj_safe+zshift*boxzsize
3634 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3635 if(dist_temp.lt.dist_init) then
3645 if (isubchap.eq.1) then
3654 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3656 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3657 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3658 C Condition for being inside the proper box
3659 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3660 c & (xj.lt.((-0.5d0)*boxxsize))) then
3664 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3665 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3666 C Condition for being inside the proper box
3667 c if ((yj.gt.((0.5d0)*boxysize)).or.
3668 c & (yj.lt.((-0.5d0)*boxysize))) then
3672 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3673 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3674 C Condition for being inside the proper box
3675 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3676 c & (zj.lt.((-0.5d0)*boxzsize))) then
3679 C endif !endPBC condintion
3683 rij=xj*xj+yj*yj+zj*zj
3685 sss=sscale(sqrt(rij))
3686 sssgrad=sscagrad(sqrt(rij))
3687 c if (sss.gt.0.0d0) then
3693 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3694 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3695 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3696 fac=cosa-3.0D0*cosb*cosg
3698 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3699 if (j.eq.i+2) ev1=scal_el*ev1
3704 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3708 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3709 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3711 evdw1=evdw1+evdwij*sss
3712 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3713 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3714 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3715 cd & xmedi,ymedi,zmedi,xj,yj,zj
3717 if (energy_dec) then
3718 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3720 c &,iteli,itelj,aaa,evdw1
3721 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3725 C Calculate contributions to the Cartesian gradient.
3728 facvdw=-6*rrmij*(ev1+evdwij)*sss
3729 facel=-3*rrmij*(el1+eesij)
3736 * Radial derivatives. First process both termini of the fragment (i,j)
3742 c ghalf=0.5D0*ggg(k)
3743 c gelc(k,i)=gelc(k,i)+ghalf
3744 c gelc(k,j)=gelc(k,j)+ghalf
3746 c 9/28/08 AL Gradient compotents will be summed only at the end
3748 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3749 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3752 * Loop over residues i+1 thru j-1.
3756 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3759 if (sss.gt.0.0) then
3760 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3761 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3762 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3769 c ghalf=0.5D0*ggg(k)
3770 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3771 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3773 c 9/28/08 AL Gradient compotents will be summed only at the end
3775 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3776 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3779 * Loop over residues i+1 thru j-1.
3783 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3788 facvdw=(ev1+evdwij)*sss
3791 fac=-3*rrmij*(facvdw+facvdw+facel)
3796 * Radial derivatives. First process both termini of the fragment (i,j)
3802 c ghalf=0.5D0*ggg(k)
3803 c gelc(k,i)=gelc(k,i)+ghalf
3804 c gelc(k,j)=gelc(k,j)+ghalf
3806 c 9/28/08 AL Gradient compotents will be summed only at the end
3808 gelc_long(k,j)=gelc(k,j)+ggg(k)
3809 gelc_long(k,i)=gelc(k,i)-ggg(k)
3812 * Loop over residues i+1 thru j-1.
3816 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3819 c 9/28/08 AL Gradient compotents will be summed only at the end
3820 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3821 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3822 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3824 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3825 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3831 ecosa=2.0D0*fac3*fac1+fac4
3834 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3835 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3837 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3838 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3840 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3841 cd & (dcosg(k),k=1,3)
3843 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3846 c ghalf=0.5D0*ggg(k)
3847 c gelc(k,i)=gelc(k,i)+ghalf
3848 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3849 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3850 c gelc(k,j)=gelc(k,j)+ghalf
3851 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3852 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3856 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3861 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3862 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3864 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3865 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3866 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3867 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3871 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3872 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3873 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3875 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3876 C energy of a peptide unit is assumed in the form of a second-order
3877 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3878 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3879 C are computed for EVERY pair of non-contiguous peptide groups.
3882 if (j.lt.nres-1) then
3894 muij(kkk)=mu(k,i)*mu(l,j)
3895 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3897 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3898 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3899 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3900 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3901 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3902 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3906 cd write (iout,*) 'EELEC: i',i,' j',j
3907 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3908 cd write(iout,*) 'muij',muij
3909 ury=scalar(uy(1,i),erij)
3910 urz=scalar(uz(1,i),erij)
3911 vry=scalar(uy(1,j),erij)
3912 vrz=scalar(uz(1,j),erij)
3913 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3914 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3915 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3916 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3917 fac=dsqrt(-ael6i)*r3ij
3922 cd write (iout,'(4i5,4f10.5)')
3923 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3924 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3925 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3926 cd & uy(:,j),uz(:,j)
3927 cd write (iout,'(4f10.5)')
3928 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3929 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3930 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3931 cd write (iout,'(9f10.5/)')
3932 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3933 C Derivatives of the elements of A in virtual-bond vectors
3934 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3936 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3937 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3938 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3939 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3940 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3941 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3942 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3943 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3944 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3945 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3946 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3947 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3949 C Compute radial contributions to the gradient
3967 C Add the contributions coming from er
3970 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3971 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3972 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3973 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3976 C Derivatives in DC(i)
3977 cgrad ghalf1=0.5d0*agg(k,1)
3978 cgrad ghalf2=0.5d0*agg(k,2)
3979 cgrad ghalf3=0.5d0*agg(k,3)
3980 cgrad ghalf4=0.5d0*agg(k,4)
3981 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3982 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3983 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3984 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3985 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3986 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3987 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3988 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3989 C Derivatives in DC(i+1)
3990 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3991 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3992 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3993 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3994 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3995 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3996 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3997 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3998 C Derivatives in DC(j)
3999 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
4000 & -3.0d0*vryg(k,2)*ury)!+ghalf1
4001 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4002 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4003 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4004 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4005 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4006 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4007 C Derivatives in DC(j+1) or DC(nres-1)
4008 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4009 & -3.0d0*vryg(k,3)*ury)
4010 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4011 & -3.0d0*vrzg(k,3)*ury)
4012 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4013 & -3.0d0*vryg(k,3)*urz)
4014 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4015 & -3.0d0*vrzg(k,3)*urz)
4016 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4018 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4031 aggi(k,l)=-aggi(k,l)
4032 aggi1(k,l)=-aggi1(k,l)
4033 aggj(k,l)=-aggj(k,l)
4034 aggj1(k,l)=-aggj1(k,l)
4037 if (j.lt.nres-1) then
4043 aggi(k,l)=-aggi(k,l)
4044 aggi1(k,l)=-aggi1(k,l)
4045 aggj(k,l)=-aggj(k,l)
4046 aggj1(k,l)=-aggj1(k,l)
4057 aggi(k,l)=-aggi(k,l)
4058 aggi1(k,l)=-aggi1(k,l)
4059 aggj(k,l)=-aggj(k,l)
4060 aggj1(k,l)=-aggj1(k,l)
4065 IF (wel_loc.gt.0.0d0) THEN
4066 C Contribution to the local-electrostatic energy coming from the i-j pair
4067 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4069 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4070 c & ' eel_loc_ij',eel_loc_ij
4071 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4072 C Calculate patrial derivative for theta angle
4074 geel_loc_ij=a22*gmuij1(1)
4078 c write(iout,*) "derivative over thatai"
4079 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4081 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4082 & geel_loc_ij*wel_loc
4083 c write(iout,*) "derivative over thatai-1"
4084 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4091 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4092 & geel_loc_ij*wel_loc
4093 c Derivative over j residue
4094 geel_loc_ji=a22*gmuji1(1)
4098 c write(iout,*) "derivative over thataj"
4099 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4102 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4103 & geel_loc_ji*wel_loc
4109 c write(iout,*) "derivative over thataj-1"
4110 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4112 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4113 & geel_loc_ji*wel_loc
4115 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4117 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4118 & 'eelloc',i,j,eel_loc_ij
4119 c if (eel_loc_ij.ne.0)
4120 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4121 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4123 eel_loc=eel_loc+eel_loc_ij
4124 C Partial derivatives in virtual-bond dihedral angles gamma
4126 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4127 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4128 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
4129 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4130 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4131 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
4132 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4134 ggg(l)=agg(l,1)*muij(1)+
4135 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
4136 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4137 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4138 cgrad ghalf=0.5d0*ggg(l)
4139 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4140 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4144 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4147 C Remaining derivatives of eello
4149 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4150 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4151 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4152 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4153 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4154 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4155 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4156 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4159 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4160 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4161 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4162 & .and. num_conti.le.maxconts) then
4163 c write (iout,*) i,j," entered corr"
4165 C Calculate the contact function. The ith column of the array JCONT will
4166 C contain the numbers of atoms that make contacts with the atom I (of numbers
4167 C greater than I). The arrays FACONT and GACONT will contain the values of
4168 C the contact function and its derivative.
4169 c r0ij=1.02D0*rpp(iteli,itelj)
4170 c r0ij=1.11D0*rpp(iteli,itelj)
4171 r0ij=2.20D0*rpp(iteli,itelj)
4172 c r0ij=1.55D0*rpp(iteli,itelj)
4173 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4174 if (fcont.gt.0.0D0) then
4175 num_conti=num_conti+1
4176 if (num_conti.gt.maxconts) then
4177 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4178 & ' will skip next contacts for this conf.'
4180 jcont_hb(num_conti,i)=j
4181 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4182 cd & " jcont_hb",jcont_hb(num_conti,i)
4183 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4184 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4185 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4187 d_cont(num_conti,i)=rij
4188 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4189 C --- Electrostatic-interaction matrix ---
4190 a_chuj(1,1,num_conti,i)=a22
4191 a_chuj(1,2,num_conti,i)=a23
4192 a_chuj(2,1,num_conti,i)=a32
4193 a_chuj(2,2,num_conti,i)=a33
4194 C --- Gradient of rij
4196 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4203 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4204 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4205 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4206 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4207 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4212 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4213 C Calculate contact energies
4215 wij=cosa-3.0D0*cosb*cosg
4218 c fac3=dsqrt(-ael6i)/r0ij**3
4219 fac3=dsqrt(-ael6i)*r3ij
4220 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4221 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4222 if (ees0tmp.gt.0) then
4223 ees0pij=dsqrt(ees0tmp)
4227 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4228 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4229 if (ees0tmp.gt.0) then
4230 ees0mij=dsqrt(ees0tmp)
4235 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4236 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4237 C Diagnostics. Comment out or remove after debugging!
4238 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4239 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4240 c ees0m(num_conti,i)=0.0D0
4242 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4243 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4244 C Angular derivatives of the contact function
4245 ees0pij1=fac3/ees0pij
4246 ees0mij1=fac3/ees0mij
4247 fac3p=-3.0D0*fac3*rrmij
4248 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4249 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4251 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4252 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4253 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4254 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4255 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4256 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4257 ecosap=ecosa1+ecosa2
4258 ecosbp=ecosb1+ecosb2
4259 ecosgp=ecosg1+ecosg2
4260 ecosam=ecosa1-ecosa2
4261 ecosbm=ecosb1-ecosb2
4262 ecosgm=ecosg1-ecosg2
4271 facont_hb(num_conti,i)=fcont
4272 fprimcont=fprimcont/rij
4273 cd facont_hb(num_conti,i)=1.0D0
4274 C Following line is for diagnostics.
4277 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4278 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4281 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4282 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4284 gggp(1)=gggp(1)+ees0pijp*xj
4285 gggp(2)=gggp(2)+ees0pijp*yj
4286 gggp(3)=gggp(3)+ees0pijp*zj
4287 gggm(1)=gggm(1)+ees0mijp*xj
4288 gggm(2)=gggm(2)+ees0mijp*yj
4289 gggm(3)=gggm(3)+ees0mijp*zj
4290 C Derivatives due to the contact function
4291 gacont_hbr(1,num_conti,i)=fprimcont*xj
4292 gacont_hbr(2,num_conti,i)=fprimcont*yj
4293 gacont_hbr(3,num_conti,i)=fprimcont*zj
4296 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4297 c following the change of gradient-summation algorithm.
4299 cgrad ghalfp=0.5D0*gggp(k)
4300 cgrad ghalfm=0.5D0*gggm(k)
4301 gacontp_hb1(k,num_conti,i)=!ghalfp
4302 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4303 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4304 gacontp_hb2(k,num_conti,i)=!ghalfp
4305 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4306 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4307 gacontp_hb3(k,num_conti,i)=gggp(k)
4308 gacontm_hb1(k,num_conti,i)=!ghalfm
4309 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4310 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4311 gacontm_hb2(k,num_conti,i)=!ghalfm
4312 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4313 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4314 gacontm_hb3(k,num_conti,i)=gggm(k)
4316 C Diagnostics. Comment out or remove after debugging!
4318 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4319 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4320 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4321 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4322 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4323 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4326 endif ! num_conti.le.maxconts
4329 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4332 ghalf=0.5d0*agg(l,k)
4333 aggi(l,k)=aggi(l,k)+ghalf
4334 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4335 aggj(l,k)=aggj(l,k)+ghalf
4338 if (j.eq.nres-1 .and. i.lt.j-2) then
4341 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4346 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4349 C-----------------------------------------------------------------------------
4350 subroutine eturn3(i,eello_turn3)
4351 C Third- and fourth-order contributions from turns
4352 implicit real*8 (a-h,o-z)
4353 include 'DIMENSIONS'
4354 include 'COMMON.IOUNITS'
4355 include 'COMMON.GEO'
4356 include 'COMMON.VAR'
4357 include 'COMMON.LOCAL'
4358 include 'COMMON.CHAIN'
4359 include 'COMMON.DERIV'
4360 include 'COMMON.INTERACT'
4361 include 'COMMON.CONTACTS'
4362 include 'COMMON.TORSION'
4363 include 'COMMON.VECTORS'
4364 include 'COMMON.FFIELD'
4365 include 'COMMON.CONTROL'
4367 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4368 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4369 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4370 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4371 & auxgmat2(2,2),auxgmatt2(2,2)
4372 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4373 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4374 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4375 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4378 c write (iout,*) "eturn3",i,j,j1,j2
4383 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4385 C Third-order contributions
4392 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4393 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4394 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4395 c auxalary matices for theta gradient
4396 c auxalary matrix for i+1 and constant i+2
4397 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4398 c auxalary matrix for i+2 and constant i+1
4399 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4400 call transpose2(auxmat(1,1),auxmat1(1,1))
4401 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4402 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4403 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4404 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4405 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4406 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4407 C Derivatives in theta
4408 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4409 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4410 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4411 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4413 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4414 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4415 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4416 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4417 cd & ' eello_turn3_num',4*eello_turn3_num
4418 C Derivatives in gamma(i)
4419 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4420 call transpose2(auxmat2(1,1),auxmat3(1,1))
4421 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4422 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4423 C Derivatives in gamma(i+1)
4424 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4425 call transpose2(auxmat2(1,1),auxmat3(1,1))
4426 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4427 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4428 & +0.5d0*(pizda(1,1)+pizda(2,2))
4429 C Cartesian derivatives
4432 c ghalf1=0.5d0*agg(l,1)
4433 c ghalf2=0.5d0*agg(l,2)
4434 c ghalf3=0.5d0*agg(l,3)
4435 c ghalf4=0.5d0*agg(l,4)
4436 a_temp(1,1)=aggi(l,1)!+ghalf1
4437 a_temp(1,2)=aggi(l,2)!+ghalf2
4438 a_temp(2,1)=aggi(l,3)!+ghalf3
4439 a_temp(2,2)=aggi(l,4)!+ghalf4
4440 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4441 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4442 & +0.5d0*(pizda(1,1)+pizda(2,2))
4443 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4444 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4445 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4446 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4447 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4448 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4449 & +0.5d0*(pizda(1,1)+pizda(2,2))
4450 a_temp(1,1)=aggj(l,1)!+ghalf1
4451 a_temp(1,2)=aggj(l,2)!+ghalf2
4452 a_temp(2,1)=aggj(l,3)!+ghalf3
4453 a_temp(2,2)=aggj(l,4)!+ghalf4
4454 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4455 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4456 & +0.5d0*(pizda(1,1)+pizda(2,2))
4457 a_temp(1,1)=aggj1(l,1)
4458 a_temp(1,2)=aggj1(l,2)
4459 a_temp(2,1)=aggj1(l,3)
4460 a_temp(2,2)=aggj1(l,4)
4461 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4462 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4463 & +0.5d0*(pizda(1,1)+pizda(2,2))
4467 C-------------------------------------------------------------------------------
4468 subroutine eturn4(i,eello_turn4)
4469 C Third- and fourth-order contributions from turns
4470 implicit real*8 (a-h,o-z)
4471 include 'DIMENSIONS'
4472 include 'COMMON.IOUNITS'
4473 include 'COMMON.GEO'
4474 include 'COMMON.VAR'
4475 include 'COMMON.LOCAL'
4476 include 'COMMON.CHAIN'
4477 include 'COMMON.DERIV'
4478 include 'COMMON.INTERACT'
4479 include 'COMMON.CONTACTS'
4480 include 'COMMON.TORSION'
4481 include 'COMMON.VECTORS'
4482 include 'COMMON.FFIELD'
4483 include 'COMMON.CONTROL'
4485 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4486 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4487 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4488 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4489 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4490 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4491 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4492 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4493 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4494 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4495 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4498 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4500 C Fourth-order contributions
4508 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4509 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4510 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4511 c write(iout,*)"WCHODZE W PROGRAM"
4516 iti1=itortyp(itype(i+1))
4517 iti2=itortyp(itype(i+2))
4518 iti3=itortyp(itype(i+3))
4519 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4520 call transpose2(EUg(1,1,i+1),e1t(1,1))
4521 call transpose2(Eug(1,1,i+2),e2t(1,1))
4522 call transpose2(Eug(1,1,i+3),e3t(1,1))
4523 C Ematrix derivative in theta
4524 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4525 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4526 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4527 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4528 c eta1 in derivative theta
4529 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4530 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4531 c auxgvec is derivative of Ub2 so i+3 theta
4532 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4533 c auxalary matrix of E i+1
4534 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4537 s1=scalar2(b1(1,i+2),auxvec(1))
4538 c derivative of theta i+2 with constant i+3
4539 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4540 c derivative of theta i+2 with constant i+2
4541 gs32=scalar2(b1(1,i+2),auxgvec(1))
4542 c derivative of E matix in theta of i+1
4543 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4545 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4546 c ea31 in derivative theta
4547 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4548 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4549 c auxilary matrix auxgvec of Ub2 with constant E matirx
4550 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4551 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4552 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4556 s2=scalar2(b1(1,i+1),auxvec(1))
4557 c derivative of theta i+1 with constant i+3
4558 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4559 c derivative of theta i+2 with constant i+1
4560 gs21=scalar2(b1(1,i+1),auxgvec(1))
4561 c derivative of theta i+3 with constant i+1
4562 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4563 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4565 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4566 c two derivatives over diffetent matrices
4567 c gtae3e2 is derivative over i+3
4568 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4569 c ae3gte2 is derivative over i+2
4570 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4571 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4572 c three possible derivative over theta E matices
4574 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4576 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4578 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4579 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4581 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4582 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4583 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4585 eello_turn4=eello_turn4-(s1+s2+s3)
4586 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4587 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4588 c & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4589 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4590 cd & ' eello_turn4_num',8*eello_turn4_num
4592 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4593 & -(gs13+gsE13+gsEE1)*wturn4
4594 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4595 & -(gs23+gs21+gsEE2)*wturn4
4596 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4597 & -(gs32+gsE31+gsEE3)*wturn4
4598 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4601 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4602 & 'eturn4',i,j,-(s1+s2+s3)
4603 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4604 c & ' eello_turn4_num',8*eello_turn4_num
4605 C Derivatives in gamma(i)
4606 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4607 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4608 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4609 s1=scalar2(b1(1,i+2),auxvec(1))
4610 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4611 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4612 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4613 C Derivatives in gamma(i+1)
4614 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4615 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4616 s2=scalar2(b1(1,i+1),auxvec(1))
4617 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4618 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4619 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4620 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4621 C Derivatives in gamma(i+2)
4622 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4623 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4624 s1=scalar2(b1(1,i+2),auxvec(1))
4625 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4626 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4627 s2=scalar2(b1(1,i+1),auxvec(1))
4628 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4629 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4630 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4631 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4632 C Cartesian derivatives
4633 C Derivatives of this turn contributions in DC(i+2)
4634 if (j.lt.nres-1) then
4636 a_temp(1,1)=agg(l,1)
4637 a_temp(1,2)=agg(l,2)
4638 a_temp(2,1)=agg(l,3)
4639 a_temp(2,2)=agg(l,4)
4640 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4641 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4642 s1=scalar2(b1(1,i+2),auxvec(1))
4643 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4644 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4645 s2=scalar2(b1(1,i+1),auxvec(1))
4646 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4647 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4648 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4650 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4653 C Remaining derivatives of this turn contribution
4655 a_temp(1,1)=aggi(l,1)
4656 a_temp(1,2)=aggi(l,2)
4657 a_temp(2,1)=aggi(l,3)
4658 a_temp(2,2)=aggi(l,4)
4659 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4660 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4661 s1=scalar2(b1(1,i+2),auxvec(1))
4662 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4663 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4664 s2=scalar2(b1(1,i+1),auxvec(1))
4665 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4666 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4667 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4668 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4669 a_temp(1,1)=aggi1(l,1)
4670 a_temp(1,2)=aggi1(l,2)
4671 a_temp(2,1)=aggi1(l,3)
4672 a_temp(2,2)=aggi1(l,4)
4673 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4674 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4675 s1=scalar2(b1(1,i+2),auxvec(1))
4676 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4677 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4678 s2=scalar2(b1(1,i+1),auxvec(1))
4679 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4680 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4681 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4682 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4683 a_temp(1,1)=aggj(l,1)
4684 a_temp(1,2)=aggj(l,2)
4685 a_temp(2,1)=aggj(l,3)
4686 a_temp(2,2)=aggj(l,4)
4687 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4688 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4689 s1=scalar2(b1(1,i+2),auxvec(1))
4690 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4691 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4692 s2=scalar2(b1(1,i+1),auxvec(1))
4693 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4694 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4695 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4696 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4697 a_temp(1,1)=aggj1(l,1)
4698 a_temp(1,2)=aggj1(l,2)
4699 a_temp(2,1)=aggj1(l,3)
4700 a_temp(2,2)=aggj1(l,4)
4701 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4702 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4703 s1=scalar2(b1(1,i+2),auxvec(1))
4704 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4705 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4706 s2=scalar2(b1(1,i+1),auxvec(1))
4707 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4708 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4709 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4710 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4711 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4715 C-----------------------------------------------------------------------------
4716 subroutine vecpr(u,v,w)
4717 implicit real*8(a-h,o-z)
4718 dimension u(3),v(3),w(3)
4719 w(1)=u(2)*v(3)-u(3)*v(2)
4720 w(2)=-u(1)*v(3)+u(3)*v(1)
4721 w(3)=u(1)*v(2)-u(2)*v(1)
4724 C-----------------------------------------------------------------------------
4725 subroutine unormderiv(u,ugrad,unorm,ungrad)
4726 C This subroutine computes the derivatives of a normalized vector u, given
4727 C the derivatives computed without normalization conditions, ugrad. Returns
4730 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4731 double precision vec(3)
4732 double precision scalar
4734 c write (2,*) 'ugrad',ugrad
4737 vec(i)=scalar(ugrad(1,i),u(1))
4739 c write (2,*) 'vec',vec
4742 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4745 c write (2,*) 'ungrad',ungrad
4748 C-----------------------------------------------------------------------------
4749 subroutine escp_soft_sphere(evdw2,evdw2_14)
4751 C This subroutine calculates the excluded-volume interaction energy between
4752 C peptide-group centers and side chains and its gradient in virtual-bond and
4753 C side-chain vectors.
4755 implicit real*8 (a-h,o-z)
4756 include 'DIMENSIONS'
4757 include 'COMMON.GEO'
4758 include 'COMMON.VAR'
4759 include 'COMMON.LOCAL'
4760 include 'COMMON.CHAIN'
4761 include 'COMMON.DERIV'
4762 include 'COMMON.INTERACT'
4763 include 'COMMON.FFIELD'
4764 include 'COMMON.IOUNITS'
4765 include 'COMMON.CONTROL'
4770 cd print '(a)','Enter ESCP'
4771 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4775 do i=iatscp_s,iatscp_e
4776 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4778 xi=0.5D0*(c(1,i)+c(1,i+1))
4779 yi=0.5D0*(c(2,i)+c(2,i+1))
4780 zi=0.5D0*(c(3,i)+c(3,i+1))
4781 C Return atom into box, boxxsize is size of box in x dimension
4783 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4784 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4785 C Condition for being inside the proper box
4786 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4787 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4791 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4792 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4793 C Condition for being inside the proper box
4794 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4795 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4799 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4800 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4801 cC Condition for being inside the proper box
4802 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4803 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4807 if (xi.lt.0) xi=xi+boxxsize
4809 if (yi.lt.0) yi=yi+boxysize
4811 if (zi.lt.0) zi=zi+boxzsize
4812 C xi=xi+xshift*boxxsize
4813 C yi=yi+yshift*boxysize
4814 C zi=zi+zshift*boxzsize
4815 do iint=1,nscp_gr(i)
4817 do j=iscpstart(i,iint),iscpend(i,iint)
4818 if (itype(j).eq.ntyp1) cycle
4819 itypj=iabs(itype(j))
4820 C Uncomment following three lines for SC-p interactions
4824 C Uncomment following three lines for Ca-p interactions
4829 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4830 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4831 C Condition for being inside the proper box
4832 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4833 c & (xj.lt.((-0.5d0)*boxxsize))) then
4837 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4838 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4839 cC Condition for being inside the proper box
4840 c if ((yj.gt.((0.5d0)*boxysize)).or.
4841 c & (yj.lt.((-0.5d0)*boxysize))) then
4845 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4846 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4847 C Condition for being inside the proper box
4848 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4849 c & (zj.lt.((-0.5d0)*boxzsize))) then
4852 if (xj.lt.0) xj=xj+boxxsize
4854 if (yj.lt.0) yj=yj+boxysize
4856 if (zj.lt.0) zj=zj+boxzsize
4857 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4865 xj=xj_safe+xshift*boxxsize
4866 yj=yj_safe+yshift*boxysize
4867 zj=zj_safe+zshift*boxzsize
4868 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4869 if(dist_temp.lt.dist_init) then
4879 if (subchap.eq.1) then
4892 rij=xj*xj+yj*yj+zj*zj
4896 if (rij.lt.r0ijsq) then
4897 evdwij=0.25d0*(rij-r0ijsq)**2
4905 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4910 cgrad if (j.lt.i) then
4911 cd write (iout,*) 'j<i'
4912 C Uncomment following three lines for SC-p interactions
4914 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4917 cd write (iout,*) 'j>i'
4919 cgrad ggg(k)=-ggg(k)
4920 C Uncomment following line for SC-p interactions
4921 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4925 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4927 cgrad kstart=min0(i+1,j)
4928 cgrad kend=max0(i-1,j-1)
4929 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4930 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4931 cgrad do k=kstart,kend
4933 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4937 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4938 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4949 C-----------------------------------------------------------------------------
4950 subroutine escp(evdw2,evdw2_14)
4952 C This subroutine calculates the excluded-volume interaction energy between
4953 C peptide-group centers and side chains and its gradient in virtual-bond and
4954 C side-chain vectors.
4956 implicit real*8 (a-h,o-z)
4957 include 'DIMENSIONS'
4958 include 'COMMON.GEO'
4959 include 'COMMON.VAR'
4960 include 'COMMON.LOCAL'
4961 include 'COMMON.CHAIN'
4962 include 'COMMON.DERIV'
4963 include 'COMMON.INTERACT'
4964 include 'COMMON.FFIELD'
4965 include 'COMMON.IOUNITS'
4966 include 'COMMON.CONTROL'
4967 include 'COMMON.SPLITELE'
4971 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4972 cd print '(a)','Enter ESCP'
4973 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4977 do i=iatscp_s,iatscp_e
4978 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4980 xi=0.5D0*(c(1,i)+c(1,i+1))
4981 yi=0.5D0*(c(2,i)+c(2,i+1))
4982 zi=0.5D0*(c(3,i)+c(3,i+1))
4984 if (xi.lt.0) xi=xi+boxxsize
4986 if (yi.lt.0) yi=yi+boxysize
4988 if (zi.lt.0) zi=zi+boxzsize
4989 c xi=xi+xshift*boxxsize
4990 c yi=yi+yshift*boxysize
4991 c zi=zi+zshift*boxzsize
4992 c print *,xi,yi,zi,'polozenie i'
4993 C Return atom into box, boxxsize is size of box in x dimension
4995 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4996 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4997 C Condition for being inside the proper box
4998 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4999 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5003 c print *,xi,boxxsize,"pierwszy"
5005 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5006 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5007 C Condition for being inside the proper box
5008 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5009 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5013 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5014 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5015 C Condition for being inside the proper box
5016 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5017 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5020 do iint=1,nscp_gr(i)
5022 do j=iscpstart(i,iint),iscpend(i,iint)
5023 itypj=iabs(itype(j))
5024 if (itypj.eq.ntyp1) cycle
5025 C Uncomment following three lines for SC-p interactions
5029 C Uncomment following three lines for Ca-p interactions
5034 if (xj.lt.0) xj=xj+boxxsize
5036 if (yj.lt.0) yj=yj+boxysize
5038 if (zj.lt.0) zj=zj+boxzsize
5040 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5041 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5042 C Condition for being inside the proper box
5043 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5044 c & (xj.lt.((-0.5d0)*boxxsize))) then
5048 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5049 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5050 cC Condition for being inside the proper box
5051 c if ((yj.gt.((0.5d0)*boxysize)).or.
5052 c & (yj.lt.((-0.5d0)*boxysize))) then
5056 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5057 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5058 C Condition for being inside the proper box
5059 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5060 c & (zj.lt.((-0.5d0)*boxzsize))) then
5063 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5064 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5072 xj=xj_safe+xshift*boxxsize
5073 yj=yj_safe+yshift*boxysize
5074 zj=zj_safe+zshift*boxzsize
5075 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5076 if(dist_temp.lt.dist_init) then
5086 if (subchap.eq.1) then
5095 c print *,xj,yj,zj,'polozenie j'
5096 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5098 sss=sscale(1.0d0/(dsqrt(rrij)))
5099 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5100 c if (sss.eq.0) print *,'czasem jest OK'
5101 if (sss.le.0.0d0) cycle
5102 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5104 e1=fac*fac*aad(itypj,iteli)
5105 e2=fac*bad(itypj,iteli)
5106 if (iabs(j-i) .le. 2) then
5109 evdw2_14=evdw2_14+(e1+e2)*sss
5112 evdw2=evdw2+evdwij*sss
5113 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5114 & 'evdw2',i,j,evdwij
5115 c & ,iteli,itypj,fac,aad(itypj,iteli),bad(itypj,iteli)
5117 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5119 fac=-(evdwij+e1)*rrij*sss
5120 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5124 cgrad if (j.lt.i) then
5125 cd write (iout,*) 'j<i'
5126 C Uncomment following three lines for SC-p interactions
5128 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5131 cd write (iout,*) 'j>i'
5133 cgrad ggg(k)=-ggg(k)
5134 C Uncomment following line for SC-p interactions
5135 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5136 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5140 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5142 cgrad kstart=min0(i+1,j)
5143 cgrad kend=max0(i-1,j-1)
5144 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5145 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5146 cgrad do k=kstart,kend
5148 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5152 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5153 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5155 c endif !endif for sscale cutoff
5165 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5166 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5167 gradx_scp(j,i)=expon*gradx_scp(j,i)
5170 C******************************************************************************
5174 C To save time the factor EXPON has been extracted from ALL components
5175 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5178 C******************************************************************************
5181 C--------------------------------------------------------------------------
5182 subroutine edis(ehpb)
5184 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5186 implicit real*8 (a-h,o-z)
5187 include 'DIMENSIONS'
5188 include 'COMMON.SBRIDGE'
5189 include 'COMMON.CHAIN'
5190 include 'COMMON.DERIV'
5191 include 'COMMON.VAR'
5192 include 'COMMON.INTERACT'
5193 include 'COMMON.IOUNITS'
5194 include 'COMMON.CONTROL'
5195 dimension ggg(3),ggg_peak(3,100)
5200 C write (iout,*) ,"link_end",link_end,constr_dist
5201 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5202 if (energy_dec) write(iout,*)'link_start=',link_start,
5203 & ' link_end=',link_end,
5204 & " constr_dist",constr_dist," link_start_peak",link_start_peak,
5205 & " link_end_peak",link_end_peak
5206 if (link_end.eq.0.and.link_end_peak.eq.0) return
5207 do i=link_start_peak,link_end_peak
5209 c print *,"i",i," link_end_peak",link_end_peak," ipeak",
5210 c & ipeak(1,i),ipeak(2,i)
5211 do ip=ipeak(1,i),ipeak(2,i)
5216 C iii and jjj point to the residues for which the distance is assigned.
5217 if (ii.gt.nres) then
5224 aux=rlornmr1(dd,dhpb_peak(ip),dhpb1_peak(ip),forcon_peak(ip))
5225 aux=dexp(-scal_peak*aux)
5226 ehpb_peak=ehpb_peak+aux
5227 fac=rlornmr1prim(dd,dhpb_peak(ip),dhpb1_peak(ip),
5228 & forcon_peak(ip))*aux/dd
5230 ggg_peak(j,iip)=fac*(c(j,jj)-c(j,ii))
5232 if (energy_dec) write (iout,'(a6,3i5,6f10.3,i5)')
5233 & "edisL",i,ii,jj,dd,dhpb_peak(ip),dhpb1_peak(ip),
5234 & forcon_peak(ip),fordepth_peak(ip),ehpb_peak
5236 c write (iout,*) "ehpb_peak",ehpb_peak," scal_peak",scal_peak
5237 ehpb=ehpb-fordepth_peak(ipeak(1,i))*dlog(ehpb_peak)/scal_peak
5238 do ip=ipeak(1,i),ipeak(2,i)
5241 ggg(j)=ggg_peak(j,iip)/ehpb_peak
5245 C iii and jjj point to the residues for which the distance is assigned.
5246 if (ii.gt.nres) then
5255 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5256 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5260 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5261 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5265 if (link_end.eq.0) return
5266 do i=link_start,link_end
5267 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5268 C CA-CA distance used in regularization of structure.
5271 C iii and jjj point to the residues for which the distance is assigned.
5272 if (ii.gt.nres) then
5279 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5280 c & dhpb(i),dhpb1(i),forcon(i)
5281 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5282 C distance and angle dependent SS bond potential.
5283 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5284 C & iabs(itype(jjj)).eq.1) then
5285 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5286 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5287 if (.not.dyn_ss .and. i.le.nss) then
5288 C 15/02/13 CC dynamic SSbond - additional check
5289 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5290 & iabs(itype(jjj)).eq.1) then
5291 call ssbond_ene(iii,jjj,eij)
5294 cd write (iout,*) "eij",eij
5295 cd & ' waga=',waga,' fac=',fac
5296 ! else if (ii.gt.nres .and. jj.gt.nres) then
5298 C Calculate the distance between the two points and its difference from the
5301 if (irestr_type(i).eq.11) then
5302 ehpb=ehpb+fordepth(i)!**4.0d0
5303 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5304 fac=fordepth(i)!**4.0d0
5305 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5306 if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
5307 & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
5308 & ehpb,irestr_type(i)
5309 else if (irestr_type(i).eq.10) then
5310 c AL 6//19/2018 cross-link restraints
5311 xdis = 0.5d0*(dd/forcon(i))**2
5312 expdis = dexp(-xdis)
5313 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
5314 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
5315 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
5316 c & " wboltzd",wboltzd
5317 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
5318 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
5319 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
5320 & *expdis/(aux*forcon(i)**2)
5321 if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
5322 & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
5323 & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
5324 else if (irestr_type(i).eq.2) then
5325 c Quartic restraints
5326 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5327 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
5328 & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
5329 & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
5330 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5332 c Quadratic restraints
5334 C Get the force constant corresponding to this distance.
5336 C Calculate the contribution to energy.
5337 ehpb=ehpb+0.5d0*waga*rdis*rdis
5338 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
5339 & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
5340 & 0.5d0*waga*rdis*rdis,irestr_type(i)
5342 C Evaluate gradient.
5346 c Calculate Cartesian gradient
5348 ggg(j)=fac*(c(j,jj)-c(j,ii))
5350 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5351 C If this is a SC-SC distance, we need to calculate the contributions to the
5352 C Cartesian gradient in the SC vectors (ghpbx).
5355 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5356 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5359 cgrad do j=iii,jjj-1
5361 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5365 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5366 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5372 C--------------------------------------------------------------------------
5373 subroutine ssbond_ene(i,j,eij)
5375 C Calculate the distance and angle dependent SS-bond potential energy
5376 C using a free-energy function derived based on RHF/6-31G** ab initio
5377 C calculations of diethyl disulfide.
5379 C A. Liwo and U. Kozlowska, 11/24/03
5381 implicit real*8 (a-h,o-z)
5382 include 'DIMENSIONS'
5383 include 'COMMON.SBRIDGE'
5384 include 'COMMON.CHAIN'
5385 include 'COMMON.DERIV'
5386 include 'COMMON.LOCAL'
5387 include 'COMMON.INTERACT'
5388 include 'COMMON.VAR'
5389 include 'COMMON.IOUNITS'
5390 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5391 itypi=iabs(itype(i))
5395 dxi=dc_norm(1,nres+i)
5396 dyi=dc_norm(2,nres+i)
5397 dzi=dc_norm(3,nres+i)
5398 c dsci_inv=dsc_inv(itypi)
5399 dsci_inv=vbld_inv(nres+i)
5400 itypj=iabs(itype(j))
5401 c dscj_inv=dsc_inv(itypj)
5402 dscj_inv=vbld_inv(nres+j)
5406 dxj=dc_norm(1,nres+j)
5407 dyj=dc_norm(2,nres+j)
5408 dzj=dc_norm(3,nres+j)
5409 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5414 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5415 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5416 om12=dxi*dxj+dyi*dyj+dzi*dzj
5418 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5419 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5425 deltat12=om2-om1+2.0d0
5427 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5428 & +akct*deltad*deltat12
5429 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5430 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5431 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5432 c & " deltat12",deltat12," eij",eij
5433 ed=2*akcm*deltad+akct*deltat12
5435 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5436 eom1=-2*akth*deltat1-pom1-om2*pom2
5437 eom2= 2*akth*deltat2+pom1-om1*pom2
5440 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5441 ghpbx(k,i)=ghpbx(k,i)-ggk
5442 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5443 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5444 ghpbx(k,j)=ghpbx(k,j)+ggk
5445 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5446 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5447 ghpbc(k,i)=ghpbc(k,i)-ggk
5448 ghpbc(k,j)=ghpbc(k,j)+ggk
5451 C Calculate the components of the gradient in DC and X
5455 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5460 C--------------------------------------------------------------------------
5461 subroutine ebond(estr)
5463 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5465 implicit real*8 (a-h,o-z)
5466 include 'DIMENSIONS'
5467 include 'COMMON.LOCAL'
5468 include 'COMMON.GEO'
5469 include 'COMMON.INTERACT'
5470 include 'COMMON.DERIV'
5471 include 'COMMON.VAR'
5472 include 'COMMON.CHAIN'
5473 include 'COMMON.IOUNITS'
5474 include 'COMMON.NAMES'
5475 include 'COMMON.FFIELD'
5476 include 'COMMON.CONTROL'
5477 include 'COMMON.SETUP'
5478 double precision u(3),ud(3)
5481 do i=ibondp_start,ibondp_end
5482 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5483 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5485 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5486 c & *dc(j,i-1)/vbld(i)
5488 c if (energy_dec) write(iout,*)
5489 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5491 C Checking if it involves dummy (NH3+ or COO-) group
5492 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5493 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5494 diff = vbld(i)-vbldpDUM
5496 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5497 diff = vbld(i)-vbldp0
5499 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5500 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5503 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5505 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5509 estr=0.5d0*AKP*estr+estr1
5511 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5513 do i=ibond_start,ibond_end
5515 if (iti.ne.10 .and. iti.ne.ntyp1) then
5518 diff=vbld(i+nres)-vbldsc0(1,iti)
5519 if (energy_dec) write (iout,*)
5520 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5521 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5522 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5524 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5528 diff=vbld(i+nres)-vbldsc0(j,iti)
5529 ud(j)=aksc(j,iti)*diff
5530 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5544 uprod2=uprod2*u(k)*u(k)
5548 usumsqder=usumsqder+ud(j)*uprod2
5550 estr=estr+uprod/usum
5552 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5560 C--------------------------------------------------------------------------
5561 subroutine ebend(etheta)
5563 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5564 C angles gamma and its derivatives in consecutive thetas and gammas.
5566 implicit real*8 (a-h,o-z)
5567 include 'DIMENSIONS'
5568 include 'COMMON.LOCAL'
5569 include 'COMMON.GEO'
5570 include 'COMMON.INTERACT'
5571 include 'COMMON.DERIV'
5572 include 'COMMON.VAR'
5573 include 'COMMON.CHAIN'
5574 include 'COMMON.IOUNITS'
5575 include 'COMMON.NAMES'
5576 include 'COMMON.FFIELD'
5577 include 'COMMON.CONTROL'
5578 common /calcthet/ term1,term2,termm,diffak,ratak,
5579 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5580 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5581 double precision y(2),z(2)
5583 c time11=dexp(-2*time)
5586 c write (*,'(a,i2)') 'EBEND ICG=',icg
5587 do i=ithet_start,ithet_end
5588 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5589 & .or.itype(i).eq.ntyp1) cycle
5590 C Zero the energy function and its derivative at 0 or pi.
5591 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5593 ichir1=isign(1,itype(i-2))
5594 ichir2=isign(1,itype(i))
5595 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5596 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5597 if (itype(i-1).eq.10) then
5598 itype1=isign(10,itype(i-2))
5599 ichir11=isign(1,itype(i-2))
5600 ichir12=isign(1,itype(i-2))
5601 itype2=isign(10,itype(i))
5602 ichir21=isign(1,itype(i))
5603 ichir22=isign(1,itype(i))
5606 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5609 if (phii.ne.phii) phii=150.0
5619 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5622 if (phii1.ne.phii1) phii1=150.0
5634 C Calculate the "mean" value of theta from the part of the distribution
5635 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5636 C In following comments this theta will be referred to as t_c.
5637 thet_pred_mean=0.0d0
5639 athetk=athet(k,it,ichir1,ichir2)
5640 bthetk=bthet(k,it,ichir1,ichir2)
5642 athetk=athet(k,itype1,ichir11,ichir12)
5643 bthetk=bthet(k,itype2,ichir21,ichir22)
5645 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5646 c write(iout,*) 'chuj tu', y(k),z(k)
5648 dthett=thet_pred_mean*ssd
5649 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5650 C Derivatives of the "mean" values in gamma1 and gamma2.
5651 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5652 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5653 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5654 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5656 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5657 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5658 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5659 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5661 if (theta(i).gt.pi-delta) then
5662 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5664 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5665 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5666 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5668 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5670 else if (theta(i).lt.delta) then
5671 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5672 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5673 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5675 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5676 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5679 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5682 etheta=etheta+ethetai
5683 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5684 & 'ebend',i,ethetai,theta(i),itype(i)
5685 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5686 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5687 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5690 C Ufff.... We've done all this!!!
5693 C---------------------------------------------------------------------------
5694 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5696 implicit real*8 (a-h,o-z)
5697 include 'DIMENSIONS'
5698 include 'COMMON.LOCAL'
5699 include 'COMMON.IOUNITS'
5700 common /calcthet/ term1,term2,termm,diffak,ratak,
5701 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5702 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5703 C Calculate the contributions to both Gaussian lobes.
5704 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5705 C The "polynomial part" of the "standard deviation" of this part of
5706 C the distributioni.
5707 ccc write (iout,*) thetai,thet_pred_mean
5710 sig=sig*thet_pred_mean+polthet(j,it)
5712 C Derivative of the "interior part" of the "standard deviation of the"
5713 C gamma-dependent Gaussian lobe in t_c.
5714 sigtc=3*polthet(3,it)
5716 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5719 C Set the parameters of both Gaussian lobes of the distribution.
5720 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5721 fac=sig*sig+sigc0(it)
5724 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5725 sigsqtc=-4.0D0*sigcsq*sigtc
5726 c print *,i,sig,sigtc,sigsqtc
5727 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5728 sigtc=-sigtc/(fac*fac)
5729 C Following variable is sigma(t_c)**(-2)
5730 sigcsq=sigcsq*sigcsq
5732 sig0inv=1.0D0/sig0i**2
5733 delthec=thetai-thet_pred_mean
5734 delthe0=thetai-theta0i
5735 term1=-0.5D0*sigcsq*delthec*delthec
5736 term2=-0.5D0*sig0inv*delthe0*delthe0
5737 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5738 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5739 C NaNs in taking the logarithm. We extract the largest exponent which is added
5740 C to the energy (this being the log of the distribution) at the end of energy
5741 C term evaluation for this virtual-bond angle.
5742 if (term1.gt.term2) then
5744 term2=dexp(term2-termm)
5748 term1=dexp(term1-termm)
5751 C The ratio between the gamma-independent and gamma-dependent lobes of
5752 C the distribution is a Gaussian function of thet_pred_mean too.
5753 diffak=gthet(2,it)-thet_pred_mean
5754 ratak=diffak/gthet(3,it)**2
5755 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5756 C Let's differentiate it in thet_pred_mean NOW.
5758 C Now put together the distribution terms to make complete distribution.
5759 termexp=term1+ak*term2
5760 termpre=sigc+ak*sig0i
5761 C Contribution of the bending energy from this theta is just the -log of
5762 C the sum of the contributions from the two lobes and the pre-exponential
5763 C factor. Simple enough, isn't it?
5764 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5765 C write (iout,*) 'termexp',termexp,termm,termpre,i
5766 C NOW the derivatives!!!
5767 C 6/6/97 Take into account the deformation.
5768 E_theta=(delthec*sigcsq*term1
5769 & +ak*delthe0*sig0inv*term2)/termexp
5770 E_tc=((sigtc+aktc*sig0i)/termpre
5771 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5772 & aktc*term2)/termexp)
5775 c-----------------------------------------------------------------------------
5776 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
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 delthec=thetai-thet_pred_mean
5785 delthe0=thetai-theta0i
5786 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5787 t3 = thetai-thet_pred_mean
5791 t14 = t12+t6*sigsqtc
5793 t21 = thetai-theta0i
5799 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5800 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5801 & *(-t12*t9-ak*sig0inv*t27)
5805 C--------------------------------------------------------------------------
5806 subroutine ebend(etheta)
5808 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5809 C angles gamma and its derivatives in consecutive thetas and gammas.
5810 C ab initio-derived potentials from
5811 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5813 implicit real*8 (a-h,o-z)
5814 include 'DIMENSIONS'
5815 include 'COMMON.LOCAL'
5816 include 'COMMON.GEO'
5817 include 'COMMON.INTERACT'
5818 include 'COMMON.DERIV'
5819 include 'COMMON.VAR'
5820 include 'COMMON.CHAIN'
5821 include 'COMMON.IOUNITS'
5822 include 'COMMON.NAMES'
5823 include 'COMMON.FFIELD'
5824 include 'COMMON.CONTROL'
5825 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5826 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5827 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5828 & sinph1ph2(maxdouble,maxdouble)
5829 logical lprn /.false./, lprn1 /.false./
5831 do i=ithet_start,ithet_end
5833 c print *,i,itype(i-1),itype(i),itype(i-2)
5834 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1)
5835 & .or.(itype(i).eq.ntyp1)) cycle
5836 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5838 if (iabs(itype(i+1)).eq.20) iblock=2
5839 if (iabs(itype(i+1)).ne.20) iblock=1
5843 theti2=0.5d0*theta(i)
5844 ityp2=ithetyp((itype(i-1)))
5846 coskt(k)=dcos(k*theti2)
5847 sinkt(k)=dsin(k*theti2)
5849 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
5852 if (phii.ne.phii) phii=150.0
5856 ityp1=ithetyp((itype(i-2)))
5857 C propagation of chirality for glycine type
5859 cosph1(k)=dcos(k*phii)
5860 sinph1(k)=dsin(k*phii)
5864 ityp1=ithetyp(itype(i-2))
5870 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5873 if (phii1.ne.phii1) phii1=150.0
5878 ityp3=ithetyp((itype(i)))
5880 cosph2(k)=dcos(k*phii1)
5881 sinph2(k)=dsin(k*phii1)
5885 ityp3=ithetyp(itype(i))
5891 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5894 ccl=cosph1(l)*cosph2(k-l)
5895 ssl=sinph1(l)*sinph2(k-l)
5896 scl=sinph1(l)*cosph2(k-l)
5897 csl=cosph1(l)*sinph2(k-l)
5898 cosph1ph2(l,k)=ccl-ssl
5899 cosph1ph2(k,l)=ccl+ssl
5900 sinph1ph2(l,k)=scl+csl
5901 sinph1ph2(k,l)=scl-csl
5905 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5906 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5907 write (iout,*) "coskt and sinkt"
5909 write (iout,*) k,coskt(k),sinkt(k)
5913 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5914 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5917 & write (iout,*) "k",k,"
5918 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5919 & " ethetai",ethetai
5922 write (iout,*) "cosph and sinph"
5924 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5926 write (iout,*) "cosph1ph2 and sinph2ph2"
5929 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5930 & sinph1ph2(l,k),sinph1ph2(k,l)
5933 write(iout,*) "ethetai",ethetai
5937 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5938 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5939 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5940 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5941 ethetai=ethetai+sinkt(m)*aux
5942 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5943 dephii=dephii+k*sinkt(m)*(
5944 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5945 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5946 dephii1=dephii1+k*sinkt(m)*(
5947 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5948 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5950 & write (iout,*) "m",m," k",k," bbthet",
5951 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5952 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5953 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5954 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5958 & write(iout,*) "ethetai",ethetai
5962 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5963 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5964 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5965 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5966 ethetai=ethetai+sinkt(m)*aux
5967 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5968 dephii=dephii+l*sinkt(m)*(
5969 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5970 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5971 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5972 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5973 dephii1=dephii1+(k-l)*sinkt(m)*(
5974 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5975 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5976 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5977 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5979 write (iout,*) "m",m," k",k," l",l," ffthet",
5980 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5981 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5982 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5983 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5984 & " ethetai",ethetai
5985 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5986 & cosph1ph2(k,l)*sinkt(m),
5987 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5995 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5996 & i,theta(i)*rad2deg,phii*rad2deg,
5997 & phii1*rad2deg,ethetai
5999 etheta=etheta+ethetai
6000 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6002 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6003 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6004 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
6011 c-----------------------------------------------------------------------------
6012 subroutine esc(escloc)
6013 C Calculate the local energy of a side chain and its derivatives in the
6014 C corresponding virtual-bond valence angles THETA and the spherical angles
6016 implicit real*8 (a-h,o-z)
6017 include 'DIMENSIONS'
6018 include 'COMMON.GEO'
6019 include 'COMMON.LOCAL'
6020 include 'COMMON.VAR'
6021 include 'COMMON.INTERACT'
6022 include 'COMMON.DERIV'
6023 include 'COMMON.CHAIN'
6024 include 'COMMON.IOUNITS'
6025 include 'COMMON.NAMES'
6026 include 'COMMON.FFIELD'
6027 include 'COMMON.CONTROL'
6028 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6029 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6030 common /sccalc/ time11,time12,time112,theti,it,nlobit
6033 c write (iout,'(a)') 'ESC'
6034 do i=loc_start,loc_end
6036 if (it.eq.ntyp1) cycle
6037 if (it.eq.10) goto 1
6038 nlobit=nlob(iabs(it))
6039 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6040 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6041 theti=theta(i+1)-pipol
6046 if (x(2).gt.pi-delta) then
6050 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6052 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6053 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6055 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6056 & ddersc0(1),dersc(1))
6057 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6058 & ddersc0(3),dersc(3))
6060 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6062 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6063 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6064 & dersc0(2),esclocbi,dersc02)
6065 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6067 call splinthet(x(2),0.5d0*delta,ss,ssd)
6072 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6074 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6075 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6077 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6079 c write (iout,*) escloci
6080 else if (x(2).lt.delta) then
6084 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6086 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6087 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6089 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6090 & ddersc0(1),dersc(1))
6091 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6092 & ddersc0(3),dersc(3))
6094 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6096 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6097 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6098 & dersc0(2),esclocbi,dersc02)
6099 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6104 call splinthet(x(2),0.5d0*delta,ss,ssd)
6106 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6108 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6109 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6111 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6112 c write (iout,*) escloci
6114 call enesc(x,escloci,dersc,ddummy,.false.)
6117 escloc=escloc+escloci
6118 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6119 & 'escloc',i,escloci
6120 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6122 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6124 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6125 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6130 C---------------------------------------------------------------------------
6131 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6132 implicit real*8 (a-h,o-z)
6133 include 'DIMENSIONS'
6134 include 'COMMON.GEO'
6135 include 'COMMON.LOCAL'
6136 include 'COMMON.IOUNITS'
6137 common /sccalc/ time11,time12,time112,theti,it,nlobit
6138 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6139 double precision contr(maxlob,-1:1)
6141 c write (iout,*) 'it=',it,' nlobit=',nlobit
6145 if (mixed) ddersc(j)=0.0d0
6149 C Because of periodicity of the dependence of the SC energy in omega we have
6150 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6151 C To avoid underflows, first compute & store the exponents.
6159 z(k)=x(k)-censc(k,j,it)
6164 Axk=Axk+gaussc(l,k,j,it)*z(l)
6170 expfac=expfac+Ax(k,j,iii)*z(k)
6178 C As in the case of ebend, we want to avoid underflows in exponentiation and
6179 C subsequent NaNs and INFs in energy calculation.
6180 C Find the largest exponent
6184 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6188 cd print *,'it=',it,' emin=',emin
6190 C Compute the contribution to SC energy and derivatives
6195 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6196 if(adexp.ne.adexp) adexp=1.0
6199 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6201 cd print *,'j=',j,' expfac=',expfac
6202 escloc_i=escloc_i+expfac
6204 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6208 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6209 & +gaussc(k,2,j,it))*expfac
6216 dersc(1)=dersc(1)/cos(theti)**2
6217 ddersc(1)=ddersc(1)/cos(theti)**2
6220 escloci=-(dlog(escloc_i)-emin)
6222 dersc(j)=dersc(j)/escloc_i
6226 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6231 C------------------------------------------------------------------------------
6232 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6233 implicit real*8 (a-h,o-z)
6234 include 'DIMENSIONS'
6235 include 'COMMON.GEO'
6236 include 'COMMON.LOCAL'
6237 include 'COMMON.IOUNITS'
6238 common /sccalc/ time11,time12,time112,theti,it,nlobit
6239 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6240 double precision contr(maxlob)
6251 z(k)=x(k)-censc(k,j,it)
6257 Axk=Axk+gaussc(l,k,j,it)*z(l)
6263 expfac=expfac+Ax(k,j)*z(k)
6268 C As in the case of ebend, we want to avoid underflows in exponentiation and
6269 C subsequent NaNs and INFs in energy calculation.
6270 C Find the largest exponent
6273 if (emin.gt.contr(j)) emin=contr(j)
6277 C Compute the contribution to SC energy and derivatives
6281 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6282 escloc_i=escloc_i+expfac
6284 dersc(k)=dersc(k)+Ax(k,j)*expfac
6286 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6287 & +gaussc(1,2,j,it))*expfac
6291 dersc(1)=dersc(1)/cos(theti)**2
6292 dersc12=dersc12/cos(theti)**2
6293 escloci=-(dlog(escloc_i)-emin)
6295 dersc(j)=dersc(j)/escloc_i
6297 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6301 c----------------------------------------------------------------------------------
6302 subroutine esc(escloc)
6303 C Calculate the local energy of a side chain and its derivatives in the
6304 C corresponding virtual-bond valence angles THETA and the spherical angles
6305 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6306 C added by Urszula Kozlowska. 07/11/2007
6308 implicit real*8 (a-h,o-z)
6309 include 'DIMENSIONS'
6310 include 'COMMON.GEO'
6311 include 'COMMON.LOCAL'
6312 include 'COMMON.VAR'
6313 include 'COMMON.SCROT'
6314 include 'COMMON.INTERACT'
6315 include 'COMMON.DERIV'
6316 include 'COMMON.CHAIN'
6317 include 'COMMON.IOUNITS'
6318 include 'COMMON.NAMES'
6319 include 'COMMON.FFIELD'
6320 include 'COMMON.CONTROL'
6321 include 'COMMON.VECTORS'
6322 double precision x_prime(3),y_prime(3),z_prime(3)
6323 & , sumene,dsc_i,dp2_i,x(65),
6324 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6325 & de_dxx,de_dyy,de_dzz,de_dt
6326 double precision s1_t,s1_6_t,s2_t,s2_6_t
6328 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6329 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6330 & dt_dCi(3),dt_dCi1(3)
6331 common /sccalc/ time11,time12,time112,theti,it,nlobit
6334 do i=loc_start,loc_end
6335 if (itype(i).eq.ntyp1) cycle
6336 costtab(i+1) =dcos(theta(i+1))
6337 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6338 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6339 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6340 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6341 cosfac=dsqrt(cosfac2)
6342 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6343 sinfac=dsqrt(sinfac2)
6345 if (it.eq.10) goto 1
6347 C Compute the axes of tghe local cartesian coordinates system; store in
6348 c x_prime, y_prime and z_prime
6355 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6356 C & dc_norm(3,i+nres)
6358 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6359 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6362 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6365 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6366 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6367 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6368 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6369 c & " xy",scalar(x_prime(1),y_prime(1)),
6370 c & " xz",scalar(x_prime(1),z_prime(1)),
6371 c & " yy",scalar(y_prime(1),y_prime(1)),
6372 c & " yz",scalar(y_prime(1),z_prime(1)),
6373 c & " zz",scalar(z_prime(1),z_prime(1))
6375 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6376 C to local coordinate system. Store in xx, yy, zz.
6382 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6383 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6384 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6391 C Compute the energy of the ith side cbain
6393 c write (2,*) "xx",xx," yy",yy," zz",zz
6396 x(j) = sc_parmin(j,it)
6399 Cc diagnostics - remove later
6401 yy1 = dsin(alph(2))*dcos(omeg(2))
6402 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6403 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6404 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6406 C," --- ", xx_w,yy_w,zz_w
6409 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6410 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6412 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6413 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6415 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6416 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6417 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6418 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6419 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6421 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6422 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6423 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6424 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6425 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6427 dsc_i = 0.743d0+x(61)
6429 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6430 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6431 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6432 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6433 s1=(1+x(63))/(0.1d0 + dscp1)
6434 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6435 s2=(1+x(65))/(0.1d0 + dscp2)
6436 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6437 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6438 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6439 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6441 c & dscp1,dscp2,sumene
6442 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6443 escloc = escloc + sumene
6444 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6446 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6451 C This section to check the numerical derivatives of the energy of ith side
6452 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6453 C #define DEBUG in the code to turn it on.
6455 write (2,*) "sumene =",sumene
6459 write (2,*) xx,yy,zz
6460 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6461 de_dxx_num=(sumenep-sumene)/aincr
6463 write (2,*) "xx+ sumene from enesc=",sumenep
6466 write (2,*) xx,yy,zz
6467 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6468 de_dyy_num=(sumenep-sumene)/aincr
6470 write (2,*) "yy+ sumene from enesc=",sumenep
6473 write (2,*) xx,yy,zz
6474 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6475 de_dzz_num=(sumenep-sumene)/aincr
6477 write (2,*) "zz+ sumene from enesc=",sumenep
6478 costsave=cost2tab(i+1)
6479 sintsave=sint2tab(i+1)
6480 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6481 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6482 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6483 de_dt_num=(sumenep-sumene)/aincr
6484 write (2,*) " t+ sumene from enesc=",sumenep
6485 cost2tab(i+1)=costsave
6486 sint2tab(i+1)=sintsave
6487 C End of diagnostics section.
6490 C Compute the gradient of esc
6492 c zz=zz*dsign(1.0,dfloat(itype(i)))
6493 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6494 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6495 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6496 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6497 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6498 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6499 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6500 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6501 pom1=(sumene3*sint2tab(i+1)+sumene1)
6502 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6503 pom2=(sumene4*cost2tab(i+1)+sumene2)
6504 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6505 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6506 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6507 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6509 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6510 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6511 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6513 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6514 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6515 & +(pom1+pom2)*pom_dx
6517 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6520 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6521 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6522 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6524 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6525 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6526 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6527 & +x(59)*zz**2 +x(60)*xx*zz
6528 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6529 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6530 & +(pom1-pom2)*pom_dy
6532 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6535 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6536 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6537 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6538 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6539 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6540 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6541 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6542 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6544 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6547 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6548 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6549 & +pom1*pom_dt1+pom2*pom_dt2
6551 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6556 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6557 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6558 cosfac2xx=cosfac2*xx
6559 sinfac2yy=sinfac2*yy
6561 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6563 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6565 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6566 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6567 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6568 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6569 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6570 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6571 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6572 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6573 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6574 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6578 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6579 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6580 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6581 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6584 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6585 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6586 dZZ_XYZ(k)=vbld_inv(i+nres)*
6587 & (z_prime(k)-zz*dC_norm(k,i+nres))
6589 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6590 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6594 dXX_Ctab(k,i)=dXX_Ci(k)
6595 dXX_C1tab(k,i)=dXX_Ci1(k)
6596 dYY_Ctab(k,i)=dYY_Ci(k)
6597 dYY_C1tab(k,i)=dYY_Ci1(k)
6598 dZZ_Ctab(k,i)=dZZ_Ci(k)
6599 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6600 dXX_XYZtab(k,i)=dXX_XYZ(k)
6601 dYY_XYZtab(k,i)=dYY_XYZ(k)
6602 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6606 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6607 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6608 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6609 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6610 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6612 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6613 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6614 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6615 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6616 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6617 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6618 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6619 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6621 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6622 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6624 C to check gradient call subroutine check_grad
6630 c------------------------------------------------------------------------------
6631 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6633 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6634 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6635 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6636 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6638 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6639 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6641 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6642 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6643 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6644 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6645 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6647 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6648 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6649 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6650 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6651 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6653 dsc_i = 0.743d0+x(61)
6655 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6656 & *(xx*cost2+yy*sint2))
6657 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6658 & *(xx*cost2-yy*sint2))
6659 s1=(1+x(63))/(0.1d0 + dscp1)
6660 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6661 s2=(1+x(65))/(0.1d0 + dscp2)
6662 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6663 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6664 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6669 c------------------------------------------------------------------------------
6670 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6672 C This procedure calculates two-body contact function g(rij) and its derivative:
6675 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6678 C where x=(rij-r0ij)/delta
6680 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6683 double precision rij,r0ij,eps0ij,fcont,fprimcont
6684 double precision x,x2,x4,delta
6688 if (x.lt.-1.0D0) then
6691 else if (x.le.1.0D0) then
6694 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6695 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6702 c------------------------------------------------------------------------------
6703 subroutine splinthet(theti,delta,ss,ssder)
6704 implicit real*8 (a-h,o-z)
6705 include 'DIMENSIONS'
6706 include 'COMMON.VAR'
6707 include 'COMMON.GEO'
6710 if (theti.gt.pipol) then
6711 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6713 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6718 c------------------------------------------------------------------------------
6719 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6721 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6722 double precision ksi,ksi2,ksi3,a1,a2,a3
6723 a1=fprim0*delta/(f1-f0)
6729 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6730 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6733 c------------------------------------------------------------------------------
6734 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6736 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6737 double precision ksi,ksi2,ksi3,a1,a2,a3
6742 a2=3*(f1x-f0x)-2*fprim0x*delta
6743 a3=fprim0x*delta-2*(f1x-f0x)
6744 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6747 C-----------------------------------------------------------------------------
6749 C-----------------------------------------------------------------------------
6750 subroutine etor(etors,edihcnstr)
6751 implicit real*8 (a-h,o-z)
6752 include 'DIMENSIONS'
6753 include 'COMMON.VAR'
6754 include 'COMMON.GEO'
6755 include 'COMMON.LOCAL'
6756 include 'COMMON.TORSION'
6757 include 'COMMON.INTERACT'
6758 include 'COMMON.DERIV'
6759 include 'COMMON.CHAIN'
6760 include 'COMMON.NAMES'
6761 include 'COMMON.IOUNITS'
6762 include 'COMMON.FFIELD'
6763 include 'COMMON.TORCNSTR'
6764 include 'COMMON.CONTROL'
6766 C Set lprn=.true. for debugging
6770 do i=iphi_start,iphi_end
6772 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6773 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6774 itori=itortyp(itype(i-2))
6775 itori1=itortyp(itype(i-1))
6778 C Proline-Proline pair is a special case...
6779 if (itori.eq.3 .and. itori1.eq.3) then
6780 if (phii.gt.-dwapi3) then
6782 fac=1.0D0/(1.0D0-cosphi)
6783 etorsi=v1(1,3,3)*fac
6784 etorsi=etorsi+etorsi
6785 etors=etors+etorsi-v1(1,3,3)
6786 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6787 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6790 v1ij=v1(j+1,itori,itori1)
6791 v2ij=v2(j+1,itori,itori1)
6794 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6795 if (energy_dec) etors_ii=etors_ii+
6796 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6797 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6801 v1ij=v1(j,itori,itori1)
6802 v2ij=v2(j,itori,itori1)
6805 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6806 if (energy_dec) etors_ii=etors_ii+
6807 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6808 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6811 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6814 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6815 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6816 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6817 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6818 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6820 ! 6/20/98 - dihedral angle constraints
6823 itori=idih_constr(i)
6826 if (difi.gt.drange(i)) then
6828 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6829 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6830 else if (difi.lt.-drange(i)) then
6832 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6833 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6835 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6836 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6838 ! write (iout,*) 'edihcnstr',edihcnstr
6841 c------------------------------------------------------------------------------
6842 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
6843 subroutine e_modeller(ehomology_constr)
6844 ehomology_constr=0.0d0
6845 write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
6848 C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
6850 c------------------------------------------------------------------------------
6851 subroutine etor_d(etors_d)
6855 c----------------------------------------------------------------------------
6857 subroutine etor(etors,edihcnstr)
6858 implicit real*8 (a-h,o-z)
6859 include 'DIMENSIONS'
6860 include 'COMMON.VAR'
6861 include 'COMMON.GEO'
6862 include 'COMMON.LOCAL'
6863 include 'COMMON.TORSION'
6864 include 'COMMON.INTERACT'
6865 include 'COMMON.DERIV'
6866 include 'COMMON.CHAIN'
6867 include 'COMMON.NAMES'
6868 include 'COMMON.IOUNITS'
6869 include 'COMMON.FFIELD'
6870 include 'COMMON.TORCNSTR'
6871 include 'COMMON.CONTROL'
6873 C Set lprn=.true. for debugging
6877 do i=iphi_start,iphi_end
6878 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6879 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6880 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6881 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6882 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6883 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6884 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6885 C For introducing the NH3+ and COO- group please check the etor_d for reference
6888 if (iabs(itype(i)).eq.20) then
6893 itori=itortyp(itype(i-2))
6894 itori1=itortyp(itype(i-1))
6897 C Regular cosine and sine terms
6898 do j=1,nterm(itori,itori1,iblock)
6899 v1ij=v1(j,itori,itori1,iblock)
6900 v2ij=v2(j,itori,itori1,iblock)
6903 etors=etors+v1ij*cosphi+v2ij*sinphi
6904 if (energy_dec) etors_ii=etors_ii+
6905 & v1ij*cosphi+v2ij*sinphi
6906 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6910 C E = SUM ----------------------------------- - v1
6911 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6913 cosphi=dcos(0.5d0*phii)
6914 sinphi=dsin(0.5d0*phii)
6915 do j=1,nlor(itori,itori1,iblock)
6916 vl1ij=vlor1(j,itori,itori1)
6917 vl2ij=vlor2(j,itori,itori1)
6918 vl3ij=vlor3(j,itori,itori1)
6919 pom=vl2ij*cosphi+vl3ij*sinphi
6920 pom1=1.0d0/(pom*pom+1.0d0)
6921 etors=etors+vl1ij*pom1
6922 if (energy_dec) etors_ii=etors_ii+
6925 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6927 C Subtract the constant term
6928 etors=etors-v0(itori,itori1,iblock)
6929 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6930 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6932 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6933 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6934 & (v1(j,itori,itori1,iblock),j=1,6),
6935 & (v2(j,itori,itori1,iblock),j=1,6)
6936 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6937 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6939 ! 6/20/98 - dihedral angle constraints
6941 c do i=1,ndih_constr
6942 do i=idihconstr_start,idihconstr_end
6943 itori=idih_constr(i)
6945 difi=pinorm(phii-phi0(i))
6946 if (difi.gt.drange(i)) then
6948 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6949 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6950 else if (difi.lt.-drange(i)) then
6952 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6953 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6957 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6958 cd & rad2deg*phi0(i), rad2deg*drange(i),
6959 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6961 cd write (iout,*) 'edihcnstr',edihcnstr
6964 c----------------------------------------------------------------------------
6965 c MODELLER restraint function
6966 subroutine e_modeller(ehomology_constr)
6967 implicit real*8 (a-h,o-z)
6968 include 'DIMENSIONS'
6970 integer nnn, i, j, k, ki, irec, l
6971 integer katy, odleglosci, test7
6972 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
6974 real*8 distance(max_template),distancek(max_template),
6975 & min_odl,godl(max_template),dih_diff(max_template)
6978 c FP - 30/10/2014 Temporary specifications for homology restraints
6980 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
6982 double precision, dimension (maxres) :: guscdiff,usc_diff
6983 double precision, dimension (max_template) ::
6984 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
6988 include 'COMMON.SBRIDGE'
6989 include 'COMMON.CHAIN'
6990 include 'COMMON.GEO'
6991 include 'COMMON.DERIV'
6992 include 'COMMON.LOCAL'
6993 include 'COMMON.INTERACT'
6994 include 'COMMON.VAR'
6995 include 'COMMON.IOUNITS'
6997 include 'COMMON.CONTROL'
6999 c From subroutine Econstr_back
7001 include 'COMMON.NAMES'
7002 include 'COMMON.TIME1'
7007 distancek(i)=9999999.9
7013 c Pseudo-energy and gradient from homology restraints (MODELLER-like
7015 C AL 5/2/14 - Introduce list of restraints
7016 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
7018 write(iout,*) "------- dist restrs start -------"
7020 do ii = link_start_homo,link_end_homo
7024 c write (iout,*) "dij(",i,j,") =",dij
7026 do k=1,constr_homology
7027 c write(iout,*) ii,k,i,j,l_homo(k,ii),dij,odl(k,ii)
7028 if(.not.l_homo(k,ii)) then
7032 distance(k)=odl(k,ii)-dij
7033 c write (iout,*) "distance(",k,") =",distance(k)
7035 c For Gaussian-type Urestr
7037 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
7038 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
7039 c write (iout,*) "distancek(",k,") =",distancek(k)
7040 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
7042 c For Lorentzian-type Urestr
7044 if (waga_dist.lt.0.0d0) then
7045 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
7046 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
7047 & (distance(k)**2+sigma_odlir(k,ii)**2))
7051 c min_odl=minval(distancek)
7052 do kk=1,constr_homology
7053 if(l_homo(kk,ii)) then
7054 min_odl=distancek(kk)
7058 do kk=1,constr_homology
7059 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
7060 & min_odl=distancek(kk)
7063 c write (iout,* )"min_odl",min_odl
7065 write (iout,*) "ij dij",i,j,dij
7066 write (iout,*) "distance",(distance(k),k=1,constr_homology)
7067 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
7068 write (iout,* )"min_odl",min_odl
7073 if (waga_dist.ge.0.0d0) then
7079 do k=1,constr_homology
7080 c Nie wiem po co to liczycie jeszcze raz!
7081 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
7082 c & (2*(sigma_odl(i,j,k))**2))
7083 if(.not.l_homo(k,ii)) cycle
7084 if (waga_dist.ge.0.0d0) then
7086 c For Gaussian-type Urestr
7088 godl(k)=dexp(-distancek(k)+min_odl)
7089 odleg2=odleg2+godl(k)
7091 c For Lorentzian-type Urestr
7094 odleg2=odleg2+distancek(k)
7097 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
7098 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
7099 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
7100 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
7103 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
7104 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
7106 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
7107 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
7109 if (waga_dist.ge.0.0d0) then
7111 c For Gaussian-type Urestr
7113 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
7115 c For Lorentzian-type Urestr
7118 odleg=odleg+odleg2/constr_homology
7121 c write (iout,*) "odleg",odleg ! sum of -ln-s
7124 c For Gaussian-type Urestr
7126 if (waga_dist.ge.0.0d0) sum_godl=odleg2
7128 do k=1,constr_homology
7129 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
7130 c & *waga_dist)+min_odl
7131 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
7133 if(.not.l_homo(k,ii)) cycle
7134 if (waga_dist.ge.0.0d0) then
7135 c For Gaussian-type Urestr
7137 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
7139 c For Lorentzian-type Urestr
7142 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
7143 & sigma_odlir(k,ii)**2)**2)
7145 sum_sgodl=sum_sgodl+sgodl
7147 c sgodl2=sgodl2+sgodl
7148 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
7149 c write(iout,*) "constr_homology=",constr_homology
7150 c write(iout,*) i, j, k, "TEST K"
7152 if (waga_dist.ge.0.0d0) then
7154 c For Gaussian-type Urestr
7156 grad_odl3=waga_homology(iset)*waga_dist
7157 & *sum_sgodl/(sum_godl*dij)
7159 c For Lorentzian-type Urestr
7162 c Original grad expr modified by analogy w Gaussian-type Urestr grad
7163 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
7164 grad_odl3=-waga_homology(iset)*waga_dist*
7165 & sum_sgodl/(constr_homology*dij)
7168 c grad_odl3=sum_sgodl/(sum_godl*dij)
7171 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
7172 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
7173 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
7175 ccc write(iout,*) godl, sgodl, grad_odl3
7177 c grad_odl=grad_odl+grad_odl3
7180 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
7181 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
7182 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
7183 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
7184 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
7185 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
7186 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
7187 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
7188 c if (i.eq.25.and.j.eq.27) then
7189 c write(iout,*) "jik",jik,"i",i,"j",j
7190 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
7191 c write(iout,*) "grad_odl3",grad_odl3
7192 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
7193 c write(iout,*) "ggodl",ggodl
7194 c write(iout,*) "ghpbc(",jik,i,")",
7195 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
7199 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
7200 ccc & dLOG(odleg2),"-odleg=", -odleg
7202 enddo ! ii-loop for dist
7204 write(iout,*) "------- dist restrs end -------"
7205 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
7206 c & waga_d.eq.1.0d0) call sum_gradient
7208 c Pseudo-energy and gradient from dihedral-angle restraints from
7209 c homology templates
7210 c write (iout,*) "End of distance loop"
7213 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
7215 write(iout,*) "------- dih restrs start -------"
7216 do i=idihconstr_start_homo,idihconstr_end_homo
7217 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
7220 do i=idihconstr_start_homo,idihconstr_end_homo
7222 c betai=beta(i,i+1,i+2,i+3)
7224 c write (iout,*) "betai =",betai
7225 do k=1,constr_homology
7226 dih_diff(k)=pinorm(dih(k,i)-betai)
7227 cd write (iout,'(a8,2i4,2f15.8)') "dih_diff",i,k,dih_diff(k)
7228 cd & ,sigma_dih(k,i)
7229 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
7230 c & -(6.28318-dih_diff(i,k))
7231 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
7232 c & 6.28318+dih_diff(i,k)
7234 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
7236 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
7238 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
7241 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
7244 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
7245 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
7247 write (iout,*) "i",i," betai",betai," kat2",kat2
7248 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
7250 if (kat2.le.1.0d-14) cycle
7251 kat=kat-dLOG(kat2/constr_homology)
7252 c write (iout,*) "kat",kat ! sum of -ln-s
7254 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
7255 ccc & dLOG(kat2), "-kat=", -kat
7257 c ----------------------------------------------------------------------
7259 c ----------------------------------------------------------------------
7263 do k=1,constr_homology
7265 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
7267 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i) ! waga_angle rmvd
7269 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
7270 sum_sgdih=sum_sgdih+sgdih
7272 c grad_dih3=sum_sgdih/sum_gdih
7273 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
7275 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
7276 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
7277 ccc & gloc(nphi+i-3,icg)
7278 gloc(i-3,icg)=gloc(i-3,icg)+grad_dih3
7280 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
7282 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
7283 ccc & gloc(nphi+i-3,icg)
7285 enddo ! i-loop for dih
7287 write(iout,*) "------- dih restrs end -------"
7290 c Pseudo-energy and gradient for theta angle restraints from
7291 c homology templates
7292 c FP 01/15 - inserted from econstr_local_test.F, loop structure
7296 c For constr_homology reference structures (FP)
7298 c Uconst_back_tot=0.0d0
7301 c Econstr_back legacy
7303 c do i=ithet_start,ithet_end
7306 c do i=loc_start,loc_end
7309 duscdiffx(j,i)=0.0d0
7314 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
7315 c write (iout,*) "waga_theta",waga_theta
7316 if (waga_theta.gt.0.0d0) then
7318 write (iout,*) "usampl",usampl
7319 write(iout,*) "------- theta restrs start -------"
7320 c do i=ithet_start,ithet_end
7321 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
7324 c write (iout,*) "maxres",maxres,"nres",nres
7326 do i=ithet_start,ithet_end
7329 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
7331 c Deviation of theta angles wrt constr_homology ref structures
7333 utheta_i=0.0d0 ! argument of Gaussian for single k
7334 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
7335 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
7336 c over residues in a fragment
7337 c write (iout,*) "theta(",i,")=",theta(i)
7338 do k=1,constr_homology
7340 c dtheta_i=theta(j)-thetaref(j,iref)
7341 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
7342 theta_diff(k)=thetatpl(k,i)-theta(i)
7343 cd write (iout,'(a8,2i4,2f15.8)') "theta_diff",i,k,theta_diff(k)
7344 cd & ,sigma_theta(k,i)
7347 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
7348 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
7349 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
7350 gutheta_i=gutheta_i+gtheta(k) ! Sum of Gaussians (pk)
7351 c Gradient for single Gaussian restraint in subr Econstr_back
7352 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
7355 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
7356 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
7359 c Gradient for multiple Gaussian restraint
7360 sum_gtheta=gutheta_i
7362 do k=1,constr_homology
7363 c New generalized expr for multiple Gaussian from Econstr_back
7364 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
7366 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
7367 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
7369 c Final value of gradient using same var as in Econstr_back
7370 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)
7371 & +sum_sgtheta/sum_gtheta*waga_theta
7372 & *waga_homology(iset)
7373 c dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
7374 c & *waga_homology(iset)
7375 c dutheta(i)=sum_sgtheta/sum_gtheta
7377 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
7378 Eval=Eval-dLOG(gutheta_i/constr_homology)
7379 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
7380 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
7381 c Uconst_back=Uconst_back+utheta(i)
7382 enddo ! (i-loop for theta)
7384 write(iout,*) "------- theta restrs end -------"
7388 c Deviation of local SC geometry
7390 c Separation of two i-loops (instructed by AL - 11/3/2014)
7392 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
7393 c write (iout,*) "waga_d",waga_d
7396 write(iout,*) "------- SC restrs start -------"
7397 write (iout,*) "Initial duscdiff,duscdiffx"
7398 do i=loc_start,loc_end
7399 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
7400 & (duscdiffx(jik,i),jik=1,3)
7403 do i=loc_start,loc_end
7404 usc_diff_i=0.0d0 ! argument of Gaussian for single k
7405 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
7406 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
7407 c write(iout,*) "xxtab, yytab, zztab"
7408 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
7409 do k=1,constr_homology
7411 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
7412 c Original sign inverted for calc of gradients (s. Econstr_back)
7413 dyy=-yytpl(k,i)+yytab(i) ! ibid y
7414 dzz=-zztpl(k,i)+zztab(i) ! ibid z
7415 c write(iout,*) "dxx, dyy, dzz"
7416 cd write(iout,'(2i5,4f8.2)') k,i,dxx,dyy,dzz,sigma_d(k,i)
7418 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
7419 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
7420 c uscdiffk(k)=usc_diff(i)
7421 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
7422 c write(iout,*) "i",i," k",k," sigma_d",sigma_d(k,i),
7423 c & " guscdiff2",guscdiff2(k)
7424 guscdiff(i)=guscdiff(i)+guscdiff2(k) !Sum of Gaussians (pk)
7425 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
7426 c & xxref(j),yyref(j),zzref(j)
7431 c Generalized expression for multiple Gaussian acc to that for a single
7432 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
7434 c Original implementation
7435 c sum_guscdiff=guscdiff(i)
7437 c sum_sguscdiff=0.0d0
7438 c do k=1,constr_homology
7439 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
7440 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
7441 c sum_sguscdiff=sum_sguscdiff+sguscdiff
7444 c Implementation of new expressions for gradient (Jan. 2015)
7446 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
7447 do k=1,constr_homology
7449 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
7450 c before. Now the drivatives should be correct
7452 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
7453 c Original sign inverted for calc of gradients (s. Econstr_back)
7454 dyy=-yytpl(k,i)+yytab(i) ! ibid y
7455 dzz=-zztpl(k,i)+zztab(i) ! ibid z
7457 c New implementation
7459 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
7460 & sigma_d(k,i) ! for the grad wrt r'
7461 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
7464 c New implementation
7465 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
7467 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
7468 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
7469 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
7470 duscdiff(jik,i)=duscdiff(jik,i)+
7471 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
7472 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
7473 duscdiffx(jik,i)=duscdiffx(jik,i)+
7474 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
7475 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
7478 write(iout,*) "jik",jik,"i",i
7479 write(iout,*) "dxx, dyy, dzz"
7480 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
7481 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
7482 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
7483 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
7484 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
7485 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
7486 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
7487 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
7488 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
7489 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
7490 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
7491 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
7492 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
7493 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
7494 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
7500 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
7501 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
7503 c write (iout,*) i," uscdiff",uscdiff(i)
7505 c Put together deviations from local geometry
7507 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
7508 c & wfrag_back(3,i,iset)*uscdiff(i)
7509 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
7510 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
7511 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
7512 c Uconst_back=Uconst_back+usc_diff(i)
7514 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
7516 c New implment: multiplied by sum_sguscdiff
7519 enddo ! (i-loop for dscdiff)
7524 write(iout,*) "------- SC restrs end -------"
7525 write (iout,*) "------ After SC loop in e_modeller ------"
7526 do i=loc_start,loc_end
7527 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
7528 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
7530 if (waga_theta.eq.1.0d0) then
7531 write (iout,*) "in e_modeller after SC restr end: dutheta"
7532 do i=ithet_start,ithet_end
7533 write (iout,*) i,dutheta(i)
7536 if (waga_d.eq.1.0d0) then
7537 write (iout,*) "e_modeller after SC loop: duscdiff/x"
7539 write (iout,*) i,(duscdiff(j,i),j=1,3)
7540 write (iout,*) i,(duscdiffx(j,i),j=1,3)
7545 c Total energy from homology restraints
7547 write (iout,*) "odleg",odleg," kat",kat
7550 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
7552 c ehomology_constr=odleg+kat
7554 c For Lorentzian-type Urestr
7557 if (waga_dist.ge.0.0d0) then
7559 c For Gaussian-type Urestr
7561 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
7562 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
7563 c write (iout,*) "ehomology_constr=",ehomology_constr
7566 c For Lorentzian-type Urestr
7568 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
7569 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
7570 c write (iout,*) "ehomology_constr=",ehomology_constr
7573 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
7574 & "Eval",waga_theta,eval,
7575 & "Erot",waga_d,Erot
7576 write (iout,*) "ehomology_constr",ehomology_constr
7582 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
7583 747 format(a12,i4,i4,i4,f8.3,f8.3)
7584 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
7585 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
7586 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
7587 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
7590 c------------------------------------------------------------------------------
7591 subroutine etor_d(etors_d)
7592 C 6/23/01 Compute double torsional energy
7593 implicit real*8 (a-h,o-z)
7594 include 'DIMENSIONS'
7595 include 'COMMON.VAR'
7596 include 'COMMON.GEO'
7597 include 'COMMON.LOCAL'
7598 include 'COMMON.TORSION'
7599 include 'COMMON.INTERACT'
7600 include 'COMMON.DERIV'
7601 include 'COMMON.CHAIN'
7602 include 'COMMON.NAMES'
7603 include 'COMMON.IOUNITS'
7604 include 'COMMON.FFIELD'
7605 include 'COMMON.TORCNSTR'
7606 include 'COMMON.CONTROL'
7608 C Set lprn=.true. for debugging
7612 c write(iout,*) "a tu??"
7613 do i=iphid_start,iphid_end
7614 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7615 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7616 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7617 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7618 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7619 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7620 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7621 & (itype(i+1).eq.ntyp1)) cycle
7622 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7624 itori=itortyp(itype(i-2))
7625 itori1=itortyp(itype(i-1))
7626 itori2=itortyp(itype(i))
7632 if (iabs(itype(i+1)).eq.20) iblock=2
7633 C Iblock=2 Proline type
7634 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7635 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7636 C if (itype(i+1).eq.ntyp1) iblock=3
7637 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7638 C IS or IS NOT need for this
7639 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7640 C is (itype(i-3).eq.ntyp1) ntblock=2
7641 C ntblock is N-terminal blocking group
7643 C Regular cosine and sine terms
7644 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7645 C Example of changes for NH3+ blocking group
7646 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7647 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7648 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7649 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7650 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7651 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7652 cosphi1=dcos(j*phii)
7653 sinphi1=dsin(j*phii)
7654 cosphi2=dcos(j*phii1)
7655 sinphi2=dsin(j*phii1)
7656 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7657 & v2cij*cosphi2+v2sij*sinphi2
7658 if (energy_dec) etors_d_ii=etors_d_ii+
7659 & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
7660 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7661 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7663 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7665 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7666 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7667 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7668 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7669 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7670 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7671 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7672 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7673 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7674 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7675 if (energy_dec) etors_d_ii=etors_d_ii+
7676 & v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7677 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7678 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7679 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7680 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7681 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7684 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7685 & 'etor_d',i,etors_d_ii
7686 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7687 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7692 c------------------------------------------------------------------------------
7693 subroutine eback_sc_corr(esccor)
7694 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7695 c conformational states; temporarily implemented as differences
7696 c between UNRES torsional potentials (dependent on three types of
7697 c residues) and the torsional potentials dependent on all 20 types
7698 c of residues computed from AM1 energy surfaces of terminally-blocked
7699 c amino-acid residues.
7700 implicit real*8 (a-h,o-z)
7701 include 'DIMENSIONS'
7702 include 'COMMON.VAR'
7703 include 'COMMON.GEO'
7704 include 'COMMON.LOCAL'
7705 include 'COMMON.TORSION'
7706 include 'COMMON.SCCOR'
7707 include 'COMMON.INTERACT'
7708 include 'COMMON.DERIV'
7709 include 'COMMON.CHAIN'
7710 include 'COMMON.NAMES'
7711 include 'COMMON.IOUNITS'
7712 include 'COMMON.FFIELD'
7713 include 'COMMON.CONTROL'
7715 C Set lprn=.true. for debugging
7718 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7720 do i=itau_start,itau_end
7721 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7722 isccori=isccortyp(itype(i-2))
7723 isccori1=isccortyp(itype(i-1))
7724 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7726 do intertyp=1,3 !intertyp
7728 cc Added 09 May 2012 (Adasko)
7729 cc Intertyp means interaction type of backbone mainchain correlation:
7730 c 1 = SC...Ca...Ca...Ca
7731 c 2 = Ca...Ca...Ca...SC
7732 c 3 = SC...Ca...Ca...SCi
7734 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7735 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7736 & (itype(i-1).eq.ntyp1)))
7737 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7738 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7739 & .or.(itype(i).eq.ntyp1)))
7740 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7741 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7742 & (itype(i-3).eq.ntyp1)))) cycle
7743 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7744 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7746 do j=1,nterm_sccor(isccori,isccori1)
7747 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7748 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7749 cosphi=dcos(j*tauangle(intertyp,i))
7750 sinphi=dsin(j*tauangle(intertyp,i))
7751 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
7752 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7753 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7755 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)')
7756 & 'esccor',i,intertyp,esccor_ii
7757 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7758 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7760 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7761 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
7762 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
7763 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7764 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7770 c----------------------------------------------------------------------------
7771 subroutine multibody(ecorr)
7772 C This subroutine calculates multi-body contributions to energy following
7773 C the idea of Skolnick et al. If side chains I and J make a contact and
7774 C at the same time side chains I+1 and J+1 make a contact, an extra
7775 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7776 implicit real*8 (a-h,o-z)
7777 include 'DIMENSIONS'
7778 include 'COMMON.IOUNITS'
7779 include 'COMMON.DERIV'
7780 include 'COMMON.INTERACT'
7781 include 'COMMON.CONTACTS'
7782 double precision gx(3),gx1(3)
7785 C Set lprn=.true. for debugging
7789 write (iout,'(a)') 'Contact function values:'
7791 write (iout,'(i2,20(1x,i2,f10.5))')
7792 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7807 num_conti=num_cont(i)
7808 num_conti1=num_cont(i1)
7813 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7814 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7815 cd & ' ishift=',ishift
7816 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7817 C The system gains extra energy.
7818 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7819 endif ! j1==j+-ishift
7828 c------------------------------------------------------------------------------
7829 double precision function esccorr(i,j,k,l,jj,kk)
7830 implicit real*8 (a-h,o-z)
7831 include 'DIMENSIONS'
7832 include 'COMMON.IOUNITS'
7833 include 'COMMON.DERIV'
7834 include 'COMMON.INTERACT'
7835 include 'COMMON.CONTACTS'
7836 double precision gx(3),gx1(3)
7841 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7842 C Calculate the multi-body contribution to energy.
7843 C Calculate multi-body contributions to the gradient.
7844 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7845 cd & k,l,(gacont(m,kk,k),m=1,3)
7847 gx(m) =ekl*gacont(m,jj,i)
7848 gx1(m)=eij*gacont(m,kk,k)
7849 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7850 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7851 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7852 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7856 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7861 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7867 c------------------------------------------------------------------------------
7868 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7869 C This subroutine calculates multi-body contributions to hydrogen-bonding
7870 implicit real*8 (a-h,o-z)
7871 include 'DIMENSIONS'
7872 include 'COMMON.IOUNITS'
7875 parameter (max_cont=maxconts)
7876 parameter (max_dim=26)
7877 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7878 double precision zapas(max_dim,maxconts,max_fg_procs),
7879 & zapas_recv(max_dim,maxconts,max_fg_procs)
7880 common /przechowalnia/ zapas
7881 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7882 & status_array(MPI_STATUS_SIZE,maxconts*2)
7884 include 'COMMON.SETUP'
7885 include 'COMMON.FFIELD'
7886 include 'COMMON.DERIV'
7887 include 'COMMON.INTERACT'
7888 include 'COMMON.CONTACTS'
7889 include 'COMMON.CONTROL'
7890 include 'COMMON.LOCAL'
7891 double precision gx(3),gx1(3),time00
7894 C Set lprn=.true. for debugging
7899 if (nfgtasks.le.1) goto 30
7901 write (iout,'(a)') 'Contact function values before RECEIVE:'
7903 write (iout,'(2i3,50(1x,i2,f5.2))')
7904 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7905 & j=1,num_cont_hb(i))
7909 do i=1,ntask_cont_from
7912 do i=1,ntask_cont_to
7915 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7917 C Make the list of contacts to send to send to other procesors
7918 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7920 do i=iturn3_start,iturn3_end
7921 c write (iout,*) "make contact list turn3",i," num_cont",
7923 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7925 do i=iturn4_start,iturn4_end
7926 c write (iout,*) "make contact list turn4",i," num_cont",
7928 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7932 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7934 do j=1,num_cont_hb(i)
7937 iproc=iint_sent_local(k,jjc,ii)
7938 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7939 if (iproc.gt.0) then
7940 ncont_sent(iproc)=ncont_sent(iproc)+1
7941 nn=ncont_sent(iproc)
7943 zapas(2,nn,iproc)=jjc
7944 zapas(3,nn,iproc)=facont_hb(j,i)
7945 zapas(4,nn,iproc)=ees0p(j,i)
7946 zapas(5,nn,iproc)=ees0m(j,i)
7947 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7948 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7949 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7950 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7951 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7952 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7953 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7954 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7955 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7956 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7957 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7958 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7959 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7960 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7961 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7962 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7963 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7964 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7965 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7966 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7967 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7974 & "Numbers of contacts to be sent to other processors",
7975 & (ncont_sent(i),i=1,ntask_cont_to)
7976 write (iout,*) "Contacts sent"
7977 do ii=1,ntask_cont_to
7979 iproc=itask_cont_to(ii)
7980 write (iout,*) nn," contacts to processor",iproc,
7981 & " of CONT_TO_COMM group"
7983 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7991 CorrelID1=nfgtasks+fg_rank+1
7993 C Receive the numbers of needed contacts from other processors
7994 do ii=1,ntask_cont_from
7995 iproc=itask_cont_from(ii)
7997 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7998 & FG_COMM,req(ireq),IERR)
8000 c write (iout,*) "IRECV ended"
8002 C Send the number of contacts needed by other processors
8003 do ii=1,ntask_cont_to
8004 iproc=itask_cont_to(ii)
8006 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8007 & FG_COMM,req(ireq),IERR)
8009 c write (iout,*) "ISEND ended"
8010 c write (iout,*) "number of requests (nn)",ireq
8013 & call MPI_Waitall(ireq,req,status_array,ierr)
8015 c & "Numbers of contacts to be received from other processors",
8016 c & (ncont_recv(i),i=1,ntask_cont_from)
8020 do ii=1,ntask_cont_from
8021 iproc=itask_cont_from(ii)
8023 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8024 c & " of CONT_TO_COMM group"
8028 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8029 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8030 c write (iout,*) "ireq,req",ireq,req(ireq)
8033 C Send the contacts to processors that need them
8034 do ii=1,ntask_cont_to
8035 iproc=itask_cont_to(ii)
8037 c write (iout,*) nn," contacts to processor",iproc,
8038 c & " of CONT_TO_COMM group"
8041 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8042 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8043 c write (iout,*) "ireq,req",ireq,req(ireq)
8045 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8049 c write (iout,*) "number of requests (contacts)",ireq
8050 c write (iout,*) "req",(req(i),i=1,4)
8053 & call MPI_Waitall(ireq,req,status_array,ierr)
8054 do iii=1,ntask_cont_from
8055 iproc=itask_cont_from(iii)
8058 write (iout,*) "Received",nn," contacts from processor",iproc,
8059 & " of CONT_FROM_COMM group"
8062 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8067 ii=zapas_recv(1,i,iii)
8068 c Flag the received contacts to prevent double-counting
8069 jj=-zapas_recv(2,i,iii)
8070 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8072 nnn=num_cont_hb(ii)+1
8075 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8076 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8077 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8078 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8079 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8080 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8081 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8082 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8083 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8084 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8085 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8086 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8087 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8088 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8089 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8090 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8091 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8092 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8093 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8094 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8095 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8096 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8097 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8098 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8103 write (iout,'(a)') 'Contact function values after receive:'
8105 write (iout,'(2i3,50(1x,i3,f5.2))')
8106 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8107 & j=1,num_cont_hb(i))
8114 write (iout,'(a)') 'Contact function values:'
8116 write (iout,'(2i3,50(1x,i3,f5.2))')
8117 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8118 & j=1,num_cont_hb(i))
8122 C Remove the loop below after debugging !!!
8129 C Calculate the local-electrostatic correlation terms
8130 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8132 num_conti=num_cont_hb(i)
8133 num_conti1=num_cont_hb(i+1)
8140 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8141 c & ' jj=',jj,' kk=',kk
8142 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8143 & .or. j.lt.0 .and. j1.gt.0) .and.
8144 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8145 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8146 C The system gains extra energy.
8147 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8148 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
8149 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
8151 else if (j1.eq.j) then
8152 C Contacts I-J and I-(J+1) occur simultaneously.
8153 C The system loses extra energy.
8154 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8159 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8160 c & ' jj=',jj,' kk=',kk
8162 C Contacts I-J and (I+1)-J occur simultaneously.
8163 C The system loses extra energy.
8164 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8171 c------------------------------------------------------------------------------
8172 subroutine add_hb_contact(ii,jj,itask)
8173 implicit real*8 (a-h,o-z)
8174 include "DIMENSIONS"
8175 include "COMMON.IOUNITS"
8178 parameter (max_cont=maxconts)
8179 parameter (max_dim=26)
8180 include "COMMON.CONTACTS"
8181 double precision zapas(max_dim,maxconts,max_fg_procs),
8182 & zapas_recv(max_dim,maxconts,max_fg_procs)
8183 common /przechowalnia/ zapas
8184 integer i,j,ii,jj,iproc,itask(4),nn
8185 c write (iout,*) "itask",itask
8188 if (iproc.gt.0) then
8189 do j=1,num_cont_hb(ii)
8191 c write (iout,*) "i",ii," j",jj," jjc",jjc
8193 ncont_sent(iproc)=ncont_sent(iproc)+1
8194 nn=ncont_sent(iproc)
8195 zapas(1,nn,iproc)=ii
8196 zapas(2,nn,iproc)=jjc
8197 zapas(3,nn,iproc)=facont_hb(j,ii)
8198 zapas(4,nn,iproc)=ees0p(j,ii)
8199 zapas(5,nn,iproc)=ees0m(j,ii)
8200 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8201 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8202 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8203 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8204 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8205 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8206 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8207 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8208 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8209 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8210 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8211 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8212 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8213 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8214 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8215 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8216 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8217 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8218 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8219 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8220 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8228 c------------------------------------------------------------------------------
8229 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8231 C This subroutine calculates multi-body contributions to hydrogen-bonding
8232 implicit real*8 (a-h,o-z)
8233 include 'DIMENSIONS'
8234 include 'COMMON.IOUNITS'
8237 parameter (max_cont=maxconts)
8238 parameter (max_dim=70)
8239 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8240 double precision zapas(max_dim,maxconts,max_fg_procs),
8241 & zapas_recv(max_dim,maxconts,max_fg_procs)
8242 common /przechowalnia/ zapas
8243 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8244 & status_array(MPI_STATUS_SIZE,maxconts*2)
8246 include 'COMMON.SETUP'
8247 include 'COMMON.FFIELD'
8248 include 'COMMON.DERIV'
8249 include 'COMMON.LOCAL'
8250 include 'COMMON.INTERACT'
8251 include 'COMMON.CONTACTS'
8252 include 'COMMON.CHAIN'
8253 include 'COMMON.CONTROL'
8254 double precision gx(3),gx1(3)
8255 integer num_cont_hb_old(maxres)
8257 double precision eello4,eello5,eelo6,eello_turn6
8258 external eello4,eello5,eello6,eello_turn6
8259 C Set lprn=.true. for debugging
8264 num_cont_hb_old(i)=num_cont_hb(i)
8268 if (nfgtasks.le.1) goto 30
8270 write (iout,'(a)') 'Contact function values before RECEIVE:'
8272 write (iout,'(2i3,50(1x,i2,f5.2))')
8273 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8274 & j=1,num_cont_hb(i))
8278 do i=1,ntask_cont_from
8281 do i=1,ntask_cont_to
8284 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8286 C Make the list of contacts to send to send to other procesors
8287 do i=iturn3_start,iturn3_end
8288 c write (iout,*) "make contact list turn3",i," num_cont",
8290 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8292 do i=iturn4_start,iturn4_end
8293 c write (iout,*) "make contact list turn4",i," num_cont",
8295 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8299 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8301 do j=1,num_cont_hb(i)
8304 iproc=iint_sent_local(k,jjc,ii)
8305 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8306 if (iproc.ne.0) then
8307 ncont_sent(iproc)=ncont_sent(iproc)+1
8308 nn=ncont_sent(iproc)
8310 zapas(2,nn,iproc)=jjc
8311 zapas(3,nn,iproc)=d_cont(j,i)
8315 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8320 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8328 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8339 & "Numbers of contacts to be sent to other processors",
8340 & (ncont_sent(i),i=1,ntask_cont_to)
8341 write (iout,*) "Contacts sent"
8342 do ii=1,ntask_cont_to
8344 iproc=itask_cont_to(ii)
8345 write (iout,*) nn," contacts to processor",iproc,
8346 & " of CONT_TO_COMM group"
8348 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8356 CorrelID1=nfgtasks+fg_rank+1
8358 C Receive the numbers of needed contacts from other processors
8359 do ii=1,ntask_cont_from
8360 iproc=itask_cont_from(ii)
8362 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8363 & FG_COMM,req(ireq),IERR)
8365 c write (iout,*) "IRECV ended"
8367 C Send the number of contacts needed by other processors
8368 do ii=1,ntask_cont_to
8369 iproc=itask_cont_to(ii)
8371 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8372 & FG_COMM,req(ireq),IERR)
8374 c write (iout,*) "ISEND ended"
8375 c write (iout,*) "number of requests (nn)",ireq
8378 & call MPI_Waitall(ireq,req,status_array,ierr)
8380 c & "Numbers of contacts to be received from other processors",
8381 c & (ncont_recv(i),i=1,ntask_cont_from)
8385 do ii=1,ntask_cont_from
8386 iproc=itask_cont_from(ii)
8388 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8389 c & " of CONT_TO_COMM group"
8393 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8394 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8395 c write (iout,*) "ireq,req",ireq,req(ireq)
8398 C Send the contacts to processors that need them
8399 do ii=1,ntask_cont_to
8400 iproc=itask_cont_to(ii)
8402 c write (iout,*) nn," contacts to processor",iproc,
8403 c & " of CONT_TO_COMM group"
8406 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8407 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8408 c write (iout,*) "ireq,req",ireq,req(ireq)
8410 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8414 c write (iout,*) "number of requests (contacts)",ireq
8415 c write (iout,*) "req",(req(i),i=1,4)
8418 & call MPI_Waitall(ireq,req,status_array,ierr)
8419 do iii=1,ntask_cont_from
8420 iproc=itask_cont_from(iii)
8423 write (iout,*) "Received",nn," contacts from processor",iproc,
8424 & " of CONT_FROM_COMM group"
8427 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8432 ii=zapas_recv(1,i,iii)
8433 c Flag the received contacts to prevent double-counting
8434 jj=-zapas_recv(2,i,iii)
8435 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8437 nnn=num_cont_hb(ii)+1
8440 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8444 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8449 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8457 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8466 write (iout,'(a)') 'Contact function values after receive:'
8468 write (iout,'(2i3,50(1x,i3,5f6.3))')
8469 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8470 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8477 write (iout,'(a)') 'Contact function values:'
8479 write (iout,'(2i3,50(1x,i2,5f6.3))')
8480 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8481 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8487 C Remove the loop below after debugging !!!
8494 C Calculate the dipole-dipole interaction energies
8495 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8496 do i=iatel_s,iatel_e+1
8497 num_conti=num_cont_hb(i)
8506 C Calculate the local-electrostatic correlation terms
8507 c write (iout,*) "gradcorr5 in eello5 before loop"
8509 c write (iout,'(i5,3f10.5)')
8510 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8512 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8513 c write (iout,*) "corr loop i",i
8515 num_conti=num_cont_hb(i)
8516 num_conti1=num_cont_hb(i+1)
8523 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8524 c & ' jj=',jj,' kk=',kk
8525 c if (j1.eq.j+1 .or. j1.eq.j-1) then
8526 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8527 & .or. j.lt.0 .and. j1.gt.0) .and.
8528 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8529 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8530 C The system gains extra energy.
8532 sqd1=dsqrt(d_cont(jj,i))
8533 sqd2=dsqrt(d_cont(kk,i1))
8534 sred_geom = sqd1*sqd2
8535 IF (sred_geom.lt.cutoff_corr) THEN
8536 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
8538 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8539 cd & ' jj=',jj,' kk=',kk
8540 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8541 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8543 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8544 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8547 cd write (iout,*) 'sred_geom=',sred_geom,
8548 cd & ' ekont=',ekont,' fprim=',fprimcont,
8549 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8550 cd write (iout,*) "g_contij",g_contij
8551 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8552 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8553 call calc_eello(i,jp,i+1,jp1,jj,kk)
8554 if (wcorr4.gt.0.0d0)
8555 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8556 if (energy_dec.and.wcorr4.gt.0.0d0)
8557 1 write (iout,'(a6,4i5,0pf7.3)')
8558 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8559 c write (iout,*) "gradcorr5 before eello5"
8561 c write (iout,'(i5,3f10.5)')
8562 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8564 if (wcorr5.gt.0.0d0)
8565 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8566 c write (iout,*) "gradcorr5 after eello5"
8568 c write (iout,'(i5,3f10.5)')
8569 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8571 if (energy_dec.and.wcorr5.gt.0.0d0)
8572 1 write (iout,'(a6,4i5,0pf7.3)')
8573 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8574 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8575 cd write(2,*)'ijkl',i,jp,i+1,jp1
8576 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
8577 & .or. wturn6.eq.0.0d0))then
8578 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8579 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8580 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8581 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8582 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8583 cd & 'ecorr6=',ecorr6
8584 cd write (iout,'(4e15.5)') sred_geom,
8585 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8586 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8587 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8588 else if (wturn6.gt.0.0d0
8589 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8590 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8591 eturn6=eturn6+eello_turn6(i,jj,kk)
8592 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8593 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8594 cd write (2,*) 'multibody_eello:eturn6',eturn6
8603 num_cont_hb(i)=num_cont_hb_old(i)
8605 c write (iout,*) "gradcorr5 in eello5"
8607 c write (iout,'(i5,3f10.5)')
8608 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8612 c------------------------------------------------------------------------------
8613 subroutine add_hb_contact_eello(ii,jj,itask)
8614 implicit real*8 (a-h,o-z)
8615 include "DIMENSIONS"
8616 include "COMMON.IOUNITS"
8619 parameter (max_cont=maxconts)
8620 parameter (max_dim=70)
8621 include "COMMON.CONTACTS"
8622 double precision zapas(max_dim,maxconts,max_fg_procs),
8623 & zapas_recv(max_dim,maxconts,max_fg_procs)
8624 common /przechowalnia/ zapas
8625 integer i,j,ii,jj,iproc,itask(4),nn
8626 c write (iout,*) "itask",itask
8629 if (iproc.gt.0) then
8630 do j=1,num_cont_hb(ii)
8632 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8634 ncont_sent(iproc)=ncont_sent(iproc)+1
8635 nn=ncont_sent(iproc)
8636 zapas(1,nn,iproc)=ii
8637 zapas(2,nn,iproc)=jjc
8638 zapas(3,nn,iproc)=d_cont(j,ii)
8642 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8647 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8655 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8667 c------------------------------------------------------------------------------
8668 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8669 implicit real*8 (a-h,o-z)
8670 include 'DIMENSIONS'
8671 include 'COMMON.IOUNITS'
8672 include 'COMMON.DERIV'
8673 include 'COMMON.INTERACT'
8674 include 'COMMON.CONTACTS'
8675 double precision gx(3),gx1(3)
8685 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8686 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8687 C Following 4 lines for diagnostics.
8692 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8693 c & 'Contacts ',i,j,
8694 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8695 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8697 C Calculate the multi-body contribution to energy.
8698 C ecorr=ecorr+ekont*ees
8699 C Calculate multi-body contributions to the gradient.
8700 coeffpees0pij=coeffp*ees0pij
8701 coeffmees0mij=coeffm*ees0mij
8702 coeffpees0pkl=coeffp*ees0pkl
8703 coeffmees0mkl=coeffm*ees0mkl
8705 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8706 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8707 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8708 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8709 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8710 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8711 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8712 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8713 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8714 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8715 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8716 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8717 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8718 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8719 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8720 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8721 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8722 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8723 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8724 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8725 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8726 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8727 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8728 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8729 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8734 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8735 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8736 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8737 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8742 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8743 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8744 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8745 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8748 c write (iout,*) "ehbcorr",ekont*ees
8753 C---------------------------------------------------------------------------
8754 subroutine dipole(i,j,jj)
8755 implicit real*8 (a-h,o-z)
8756 include 'DIMENSIONS'
8757 include 'COMMON.IOUNITS'
8758 include 'COMMON.CHAIN'
8759 include 'COMMON.FFIELD'
8760 include 'COMMON.DERIV'
8761 include 'COMMON.INTERACT'
8762 include 'COMMON.CONTACTS'
8763 include 'COMMON.TORSION'
8764 include 'COMMON.VAR'
8765 include 'COMMON.GEO'
8766 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8768 iti1 = itortyp(itype(i+1))
8769 if (j.lt.nres-1) then
8770 itj1 = itortyp(itype(j+1))
8775 dipi(iii,1)=Ub2(iii,i)
8776 dipderi(iii)=Ub2der(iii,i)
8777 dipi(iii,2)=b1(iii,i+1)
8778 dipj(iii,1)=Ub2(iii,j)
8779 dipderj(iii)=Ub2der(iii,j)
8780 dipj(iii,2)=b1(iii,j+1)
8784 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8787 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8794 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8798 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8803 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8804 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8806 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8808 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8810 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8815 C---------------------------------------------------------------------------
8816 subroutine calc_eello(i,j,k,l,jj,kk)
8818 C This subroutine computes matrices and vectors needed to calculate
8819 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8821 implicit real*8 (a-h,o-z)
8822 include 'DIMENSIONS'
8823 include 'COMMON.IOUNITS'
8824 include 'COMMON.CHAIN'
8825 include 'COMMON.DERIV'
8826 include 'COMMON.INTERACT'
8827 include 'COMMON.CONTACTS'
8828 include 'COMMON.TORSION'
8829 include 'COMMON.VAR'
8830 include 'COMMON.GEO'
8831 include 'COMMON.FFIELD'
8832 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8833 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8836 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8837 cd & ' jj=',jj,' kk=',kk
8838 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8839 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8840 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8843 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8844 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8847 call transpose2(aa1(1,1),aa1t(1,1))
8848 call transpose2(aa2(1,1),aa2t(1,1))
8851 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8852 & aa1tder(1,1,lll,kkk))
8853 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8854 & aa2tder(1,1,lll,kkk))
8858 C parallel orientation of the two CA-CA-CA frames.
8860 iti=itortyp(itype(i))
8864 itk1=itortyp(itype(k+1))
8865 itj=itortyp(itype(j))
8866 if (l.lt.nres-1) then
8867 itl1=itortyp(itype(l+1))
8871 C A1 kernel(j+1) A2T
8873 cd write (iout,'(3f10.5,5x,3f10.5)')
8874 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8876 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8877 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8878 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8879 C Following matrices are needed only for 6-th order cumulants
8880 IF (wcorr6.gt.0.0d0) THEN
8881 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8882 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8883 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8884 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8885 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8886 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8887 & ADtEAderx(1,1,1,1,1,1))
8889 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8890 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8891 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8892 & ADtEA1derx(1,1,1,1,1,1))
8894 C End 6-th order cumulants
8897 cd write (2,*) 'In calc_eello6'
8899 cd write (2,*) 'iii=',iii
8901 cd write (2,*) 'kkk=',kkk
8903 cd write (2,'(3(2f10.5),5x)')
8904 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8909 call transpose2(EUgder(1,1,k),auxmat(1,1))
8910 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8911 call transpose2(EUg(1,1,k),auxmat(1,1))
8912 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8913 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8917 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8918 & EAEAderx(1,1,lll,kkk,iii,1))
8922 C A1T kernel(i+1) A2
8923 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8924 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8925 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8926 C Following matrices are needed only for 6-th order cumulants
8927 IF (wcorr6.gt.0.0d0) THEN
8928 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8929 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8930 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8931 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8932 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8933 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8934 & ADtEAderx(1,1,1,1,1,2))
8935 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8936 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8937 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8938 & ADtEA1derx(1,1,1,1,1,2))
8940 C End 6-th order cumulants
8941 call transpose2(EUgder(1,1,l),auxmat(1,1))
8942 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8943 call transpose2(EUg(1,1,l),auxmat(1,1))
8944 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8945 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8949 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8950 & EAEAderx(1,1,lll,kkk,iii,2))
8955 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8956 C They are needed only when the fifth- or the sixth-order cumulants are
8958 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8959 call transpose2(AEA(1,1,1),auxmat(1,1))
8960 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8961 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8962 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8963 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8964 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8965 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8966 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8967 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8968 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8969 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8970 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8971 call transpose2(AEA(1,1,2),auxmat(1,1))
8972 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8973 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8974 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8975 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8976 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8977 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8978 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8979 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8980 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8981 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8982 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8983 C Calculate the Cartesian derivatives of the vectors.
8987 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8988 call matvec2(auxmat(1,1),b1(1,i),
8989 & AEAb1derx(1,lll,kkk,iii,1,1))
8990 call matvec2(auxmat(1,1),Ub2(1,i),
8991 & AEAb2derx(1,lll,kkk,iii,1,1))
8992 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8993 & AEAb1derx(1,lll,kkk,iii,2,1))
8994 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8995 & AEAb2derx(1,lll,kkk,iii,2,1))
8996 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8997 call matvec2(auxmat(1,1),b1(1,j),
8998 & AEAb1derx(1,lll,kkk,iii,1,2))
8999 call matvec2(auxmat(1,1),Ub2(1,j),
9000 & AEAb2derx(1,lll,kkk,iii,1,2))
9001 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9002 & AEAb1derx(1,lll,kkk,iii,2,2))
9003 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
9004 & AEAb2derx(1,lll,kkk,iii,2,2))
9011 C Antiparallel orientation of the two CA-CA-CA frames.
9013 iti=itortyp(itype(i))
9017 itk1=itortyp(itype(k+1))
9018 itl=itortyp(itype(l))
9019 itj=itortyp(itype(j))
9020 if (j.lt.nres-1) then
9021 itj1=itortyp(itype(j+1))
9025 C A2 kernel(j-1)T A1T
9026 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9027 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
9028 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9029 C Following matrices are needed only for 6-th order cumulants
9030 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9031 & j.eq.i+4 .and. l.eq.i+3)) THEN
9032 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9033 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
9034 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9035 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9036 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
9037 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9038 & ADtEAderx(1,1,1,1,1,1))
9039 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9040 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
9041 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9042 & ADtEA1derx(1,1,1,1,1,1))
9044 C End 6-th order cumulants
9045 call transpose2(EUgder(1,1,k),auxmat(1,1))
9046 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9047 call transpose2(EUg(1,1,k),auxmat(1,1))
9048 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9049 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9053 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9054 & EAEAderx(1,1,lll,kkk,iii,1))
9058 C A2T kernel(i+1)T A1
9059 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9060 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
9061 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9062 C Following matrices are needed only for 6-th order cumulants
9063 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9064 & j.eq.i+4 .and. l.eq.i+3)) THEN
9065 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9066 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
9067 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9068 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9069 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
9070 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9071 & ADtEAderx(1,1,1,1,1,2))
9072 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9073 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
9074 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9075 & ADtEA1derx(1,1,1,1,1,2))
9077 C End 6-th order cumulants
9078 call transpose2(EUgder(1,1,j),auxmat(1,1))
9079 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9080 call transpose2(EUg(1,1,j),auxmat(1,1))
9081 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9082 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9086 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9087 & EAEAderx(1,1,lll,kkk,iii,2))
9092 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9093 C They are needed only when the fifth- or the sixth-order cumulants are
9095 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
9096 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9097 call transpose2(AEA(1,1,1),auxmat(1,1))
9098 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9099 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9100 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9101 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9102 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9103 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9104 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9105 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9106 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9107 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9108 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9109 call transpose2(AEA(1,1,2),auxmat(1,1))
9110 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
9111 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9112 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9113 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9114 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
9115 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9116 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
9117 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
9118 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9119 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9120 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9121 C Calculate the Cartesian derivatives of the vectors.
9125 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9126 call matvec2(auxmat(1,1),b1(1,i),
9127 & AEAb1derx(1,lll,kkk,iii,1,1))
9128 call matvec2(auxmat(1,1),Ub2(1,i),
9129 & AEAb2derx(1,lll,kkk,iii,1,1))
9130 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9131 & AEAb1derx(1,lll,kkk,iii,2,1))
9132 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9133 & AEAb2derx(1,lll,kkk,iii,2,1))
9134 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9135 call matvec2(auxmat(1,1),b1(1,l),
9136 & AEAb1derx(1,lll,kkk,iii,1,2))
9137 call matvec2(auxmat(1,1),Ub2(1,l),
9138 & AEAb2derx(1,lll,kkk,iii,1,2))
9139 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
9140 & AEAb1derx(1,lll,kkk,iii,2,2))
9141 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
9142 & AEAb2derx(1,lll,kkk,iii,2,2))
9151 C---------------------------------------------------------------------------
9152 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
9153 & KK,KKderg,AKA,AKAderg,AKAderx)
9157 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
9158 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
9159 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
9164 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9166 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
9169 cd if (lprn) write (2,*) 'In kernel'
9171 cd if (lprn) write (2,*) 'kkk=',kkk
9173 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
9174 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9176 cd write (2,*) 'lll=',lll
9177 cd write (2,*) 'iii=1'
9179 cd write (2,'(3(2f10.5),5x)')
9180 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9183 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
9184 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9186 cd write (2,*) 'lll=',lll
9187 cd write (2,*) 'iii=2'
9189 cd write (2,'(3(2f10.5),5x)')
9190 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9197 C---------------------------------------------------------------------------
9198 double precision function eello4(i,j,k,l,jj,kk)
9199 implicit real*8 (a-h,o-z)
9200 include 'DIMENSIONS'
9201 include 'COMMON.IOUNITS'
9202 include 'COMMON.CHAIN'
9203 include 'COMMON.DERIV'
9204 include 'COMMON.INTERACT'
9205 include 'COMMON.CONTACTS'
9206 include 'COMMON.TORSION'
9207 include 'COMMON.VAR'
9208 include 'COMMON.GEO'
9209 double precision pizda(2,2),ggg1(3),ggg2(3)
9210 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9214 cd print *,'eello4:',i,j,k,l,jj,kk
9215 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9216 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9217 cold eij=facont_hb(jj,i)
9218 cold ekl=facont_hb(kk,k)
9220 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9221 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9222 gcorr_loc(k-1)=gcorr_loc(k-1)
9223 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9225 gcorr_loc(l-1)=gcorr_loc(l-1)
9226 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9228 gcorr_loc(j-1)=gcorr_loc(j-1)
9229 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9234 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9235 & -EAEAderx(2,2,lll,kkk,iii,1)
9236 cd derx(lll,kkk,iii)=0.0d0
9240 cd gcorr_loc(l-1)=0.0d0
9241 cd gcorr_loc(j-1)=0.0d0
9242 cd gcorr_loc(k-1)=0.0d0
9244 cd write (iout,*)'Contacts have occurred for peptide groups',
9245 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9246 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9247 if (j.lt.nres-1) then
9254 if (l.lt.nres-1) then
9262 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9263 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9264 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9265 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9266 cgrad ghalf=0.5d0*ggg1(ll)
9267 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9268 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9269 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9270 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9271 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9272 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9273 cgrad ghalf=0.5d0*ggg2(ll)
9274 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9275 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9276 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9277 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9278 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9279 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9283 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9288 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9293 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9298 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9302 cd write (2,*) iii,gcorr_loc(iii)
9305 cd write (2,*) 'ekont',ekont
9306 cd write (iout,*) 'eello4',ekont*eel4
9309 C---------------------------------------------------------------------------
9310 double precision function eello5(i,j,k,l,jj,kk)
9311 implicit real*8 (a-h,o-z)
9312 include 'DIMENSIONS'
9313 include 'COMMON.IOUNITS'
9314 include 'COMMON.CHAIN'
9315 include 'COMMON.DERIV'
9316 include 'COMMON.INTERACT'
9317 include 'COMMON.CONTACTS'
9318 include 'COMMON.TORSION'
9319 include 'COMMON.VAR'
9320 include 'COMMON.GEO'
9321 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9322 double precision ggg1(3),ggg2(3)
9323 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9328 C /l\ / \ \ / \ / \ / C
9329 C / \ / \ \ / \ / \ / C
9330 C j| o |l1 | o | o| o | | o |o C
9331 C \ |/k\| |/ \| / |/ \| |/ \| C
9332 C \i/ \ / \ / / \ / \ C
9334 C (I) (II) (III) (IV) C
9336 C eello5_1 eello5_2 eello5_3 eello5_4 C
9338 C Antiparallel chains C
9341 C /j\ / \ \ / \ / \ / C
9342 C / \ / \ \ / \ / \ / C
9343 C j1| o |l | o | o| o | | o |o C
9344 C \ |/k\| |/ \| / |/ \| |/ \| C
9345 C \i/ \ / \ / / \ / \ C
9347 C (I) (II) (III) (IV) C
9349 C eello5_1 eello5_2 eello5_3 eello5_4 C
9351 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9353 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9354 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9359 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9361 itk=itortyp(itype(k))
9362 itl=itortyp(itype(l))
9363 itj=itortyp(itype(j))
9368 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9369 cd & eel5_3_num,eel5_4_num)
9373 derx(lll,kkk,iii)=0.0d0
9377 cd eij=facont_hb(jj,i)
9378 cd ekl=facont_hb(kk,k)
9380 cd write (iout,*)'Contacts have occurred for peptide groups',
9381 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9383 C Contribution from the graph I.
9384 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9385 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9386 call transpose2(EUg(1,1,k),auxmat(1,1))
9387 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9388 vv(1)=pizda(1,1)-pizda(2,2)
9389 vv(2)=pizda(1,2)+pizda(2,1)
9390 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9391 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9392 C Explicit gradient in virtual-dihedral angles.
9393 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9394 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9395 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9396 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9397 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9398 vv(1)=pizda(1,1)-pizda(2,2)
9399 vv(2)=pizda(1,2)+pizda(2,1)
9400 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9401 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9402 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9403 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9404 vv(1)=pizda(1,1)-pizda(2,2)
9405 vv(2)=pizda(1,2)+pizda(2,1)
9407 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9408 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9409 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9411 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9412 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9413 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9415 C Cartesian gradient
9419 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
9421 vv(1)=pizda(1,1)-pizda(2,2)
9422 vv(2)=pizda(1,2)+pizda(2,1)
9423 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9424 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
9425 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9431 C Contribution from graph II
9432 call transpose2(EE(1,1,itk),auxmat(1,1))
9433 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9434 vv(1)=pizda(1,1)+pizda(2,2)
9435 vv(2)=pizda(2,1)-pizda(1,2)
9436 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
9437 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9438 C Explicit gradient in virtual-dihedral angles.
9439 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9440 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9441 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9442 vv(1)=pizda(1,1)+pizda(2,2)
9443 vv(2)=pizda(2,1)-pizda(1,2)
9445 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9446 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9447 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9449 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9450 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9451 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9453 C Cartesian gradient
9457 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9459 vv(1)=pizda(1,1)+pizda(2,2)
9460 vv(2)=pizda(2,1)-pizda(1,2)
9461 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9462 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
9463 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9471 C Parallel orientation
9472 C Contribution from graph III
9473 call transpose2(EUg(1,1,l),auxmat(1,1))
9474 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9475 vv(1)=pizda(1,1)-pizda(2,2)
9476 vv(2)=pizda(1,2)+pizda(2,1)
9477 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
9478 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9479 C Explicit gradient in virtual-dihedral angles.
9480 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9481 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
9482 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9483 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9484 vv(1)=pizda(1,1)-pizda(2,2)
9485 vv(2)=pizda(1,2)+pizda(2,1)
9486 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9487 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
9488 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9489 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9490 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9491 vv(1)=pizda(1,1)-pizda(2,2)
9492 vv(2)=pizda(1,2)+pizda(2,1)
9493 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9494 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
9495 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9496 C Cartesian gradient
9500 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9502 vv(1)=pizda(1,1)-pizda(2,2)
9503 vv(2)=pizda(1,2)+pizda(2,1)
9504 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9505 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
9506 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9511 C Contribution from graph IV
9513 call transpose2(EE(1,1,itl),auxmat(1,1))
9514 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9515 vv(1)=pizda(1,1)+pizda(2,2)
9516 vv(2)=pizda(2,1)-pizda(1,2)
9517 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
9518 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9519 C Explicit gradient in virtual-dihedral angles.
9520 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9521 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9522 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9523 vv(1)=pizda(1,1)+pizda(2,2)
9524 vv(2)=pizda(2,1)-pizda(1,2)
9525 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9526 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
9527 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9528 C Cartesian gradient
9532 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9534 vv(1)=pizda(1,1)+pizda(2,2)
9535 vv(2)=pizda(2,1)-pizda(1,2)
9536 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9537 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
9538 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9543 C Antiparallel orientation
9544 C Contribution from graph III
9546 call transpose2(EUg(1,1,j),auxmat(1,1))
9547 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9548 vv(1)=pizda(1,1)-pizda(2,2)
9549 vv(2)=pizda(1,2)+pizda(2,1)
9550 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9551 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9552 C Explicit gradient in virtual-dihedral angles.
9553 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9554 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9555 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9556 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9557 vv(1)=pizda(1,1)-pizda(2,2)
9558 vv(2)=pizda(1,2)+pizda(2,1)
9559 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9560 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9561 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9562 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9563 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9564 vv(1)=pizda(1,1)-pizda(2,2)
9565 vv(2)=pizda(1,2)+pizda(2,1)
9566 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9567 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9568 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9569 C Cartesian gradient
9573 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9575 vv(1)=pizda(1,1)-pizda(2,2)
9576 vv(2)=pizda(1,2)+pizda(2,1)
9577 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9578 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9579 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9584 C Contribution from graph IV
9586 call transpose2(EE(1,1,itj),auxmat(1,1))
9587 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9588 vv(1)=pizda(1,1)+pizda(2,2)
9589 vv(2)=pizda(2,1)-pizda(1,2)
9590 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9591 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9592 C Explicit gradient in virtual-dihedral angles.
9593 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9594 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9595 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9596 vv(1)=pizda(1,1)+pizda(2,2)
9597 vv(2)=pizda(2,1)-pizda(1,2)
9598 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9599 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9600 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9601 C Cartesian gradient
9605 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9607 vv(1)=pizda(1,1)+pizda(2,2)
9608 vv(2)=pizda(2,1)-pizda(1,2)
9609 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9610 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9611 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9617 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9618 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9619 cd write (2,*) 'ijkl',i,j,k,l
9620 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9621 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9623 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9624 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9625 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9626 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9627 if (j.lt.nres-1) then
9634 if (l.lt.nres-1) then
9644 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9645 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9646 C summed up outside the subrouine as for the other subroutines
9647 C handling long-range interactions. The old code is commented out
9648 C with "cgrad" to keep track of changes.
9650 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9651 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9652 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9653 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9654 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9655 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9656 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9657 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9658 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9659 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9661 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9662 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9663 cgrad ghalf=0.5d0*ggg1(ll)
9665 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9666 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9667 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9668 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9669 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9670 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9671 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9672 cgrad ghalf=0.5d0*ggg2(ll)
9674 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
9675 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9676 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
9677 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9678 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9679 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9684 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9685 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9690 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9691 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9697 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9702 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9706 cd write (2,*) iii,g_corr5_loc(iii)
9709 cd write (2,*) 'ekont',ekont
9710 cd write (iout,*) 'eello5',ekont*eel5
9713 c--------------------------------------------------------------------------
9714 double precision function eello6(i,j,k,l,jj,kk)
9715 implicit real*8 (a-h,o-z)
9716 include 'DIMENSIONS'
9717 include 'COMMON.IOUNITS'
9718 include 'COMMON.CHAIN'
9719 include 'COMMON.DERIV'
9720 include 'COMMON.INTERACT'
9721 include 'COMMON.CONTACTS'
9722 include 'COMMON.TORSION'
9723 include 'COMMON.VAR'
9724 include 'COMMON.GEO'
9725 include 'COMMON.FFIELD'
9726 double precision ggg1(3),ggg2(3)
9727 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9732 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9740 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9741 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9745 derx(lll,kkk,iii)=0.0d0
9749 cd eij=facont_hb(jj,i)
9750 cd ekl=facont_hb(kk,k)
9756 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9757 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9758 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9759 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9760 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9761 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9763 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9764 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9765 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9766 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9767 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9768 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9772 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9774 C If turn contributions are considered, they will be handled separately.
9775 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9776 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9777 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9778 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9779 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9780 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9781 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9783 if (j.lt.nres-1) then
9790 if (l.lt.nres-1) then
9798 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9799 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9800 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9801 cgrad ghalf=0.5d0*ggg1(ll)
9803 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9804 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9805 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9806 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9807 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9808 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9809 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9810 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9811 cgrad ghalf=0.5d0*ggg2(ll)
9812 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9814 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9815 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9816 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9817 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9818 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9819 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9824 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9825 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9830 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9831 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9837 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9842 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9846 cd write (2,*) iii,g_corr6_loc(iii)
9849 cd write (2,*) 'ekont',ekont
9850 cd write (iout,*) 'eello6',ekont*eel6
9853 c--------------------------------------------------------------------------
9854 double precision function eello6_graph1(i,j,k,l,imat,swap)
9855 implicit real*8 (a-h,o-z)
9856 include 'DIMENSIONS'
9857 include 'COMMON.IOUNITS'
9858 include 'COMMON.CHAIN'
9859 include 'COMMON.DERIV'
9860 include 'COMMON.INTERACT'
9861 include 'COMMON.CONTACTS'
9862 include 'COMMON.TORSION'
9863 include 'COMMON.VAR'
9864 include 'COMMON.GEO'
9865 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9869 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9871 C Parallel Antiparallel C
9877 C \ j|/k\| / \ |/k\|l / C
9882 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9883 itk=itortyp(itype(k))
9884 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9885 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9886 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9887 call transpose2(EUgC(1,1,k),auxmat(1,1))
9888 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9889 vv1(1)=pizda1(1,1)-pizda1(2,2)
9890 vv1(2)=pizda1(1,2)+pizda1(2,1)
9891 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9892 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9893 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9894 s5=scalar2(vv(1),Dtobr2(1,i))
9895 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9896 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9897 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9898 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9899 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9900 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9901 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9902 & +scalar2(vv(1),Dtobr2der(1,i)))
9903 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9904 vv1(1)=pizda1(1,1)-pizda1(2,2)
9905 vv1(2)=pizda1(1,2)+pizda1(2,1)
9906 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9907 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9909 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9910 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9911 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9912 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9913 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9915 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9916 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9917 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9918 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9919 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9921 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9922 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9923 vv1(1)=pizda1(1,1)-pizda1(2,2)
9924 vv1(2)=pizda1(1,2)+pizda1(2,1)
9925 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9926 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9927 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9928 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9937 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9938 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9939 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9940 call transpose2(EUgC(1,1,k),auxmat(1,1))
9941 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9943 vv1(1)=pizda1(1,1)-pizda1(2,2)
9944 vv1(2)=pizda1(1,2)+pizda1(2,1)
9945 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9946 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9947 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9948 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9949 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9950 s5=scalar2(vv(1),Dtobr2(1,i))
9951 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9957 c----------------------------------------------------------------------------
9958 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9959 implicit real*8 (a-h,o-z)
9960 include 'DIMENSIONS'
9961 include 'COMMON.IOUNITS'
9962 include 'COMMON.CHAIN'
9963 include 'COMMON.DERIV'
9964 include 'COMMON.INTERACT'
9965 include 'COMMON.CONTACTS'
9966 include 'COMMON.TORSION'
9967 include 'COMMON.VAR'
9968 include 'COMMON.GEO'
9970 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9971 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9974 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9976 C Parallel Antiparallel C
9982 C \ j|/k\| \ |/k\|l C
9987 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9988 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9989 C AL 7/4/01 s1 would occur in the sixth-order moment,
9990 C but not in a cluster cumulant
9992 s1=dip(1,jj,i)*dip(1,kk,k)
9994 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9995 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9996 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9997 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9998 call transpose2(EUg(1,1,k),auxmat(1,1))
9999 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
10000 vv(1)=pizda(1,1)-pizda(2,2)
10001 vv(2)=pizda(1,2)+pizda(2,1)
10002 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10003 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10005 eello6_graph2=-(s1+s2+s3+s4)
10007 eello6_graph2=-(s2+s3+s4)
10009 c eello6_graph2=-s3
10010 C Derivatives in gamma(i-1)
10013 s1=dipderg(1,jj,i)*dip(1,kk,k)
10015 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10016 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
10017 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10018 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10020 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10022 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10024 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
10026 C Derivatives in gamma(k-1)
10028 s1=dip(1,jj,i)*dipderg(1,kk,k)
10030 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
10031 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10032 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
10033 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10034 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10035 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
10036 vv(1)=pizda(1,1)-pizda(2,2)
10037 vv(2)=pizda(1,2)+pizda(2,1)
10038 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10040 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10042 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10044 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
10045 C Derivatives in gamma(j-1) or gamma(l-1)
10048 s1=dipderg(3,jj,i)*dip(1,kk,k)
10050 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
10051 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10052 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
10053 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
10054 vv(1)=pizda(1,1)-pizda(2,2)
10055 vv(2)=pizda(1,2)+pizda(2,1)
10056 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10059 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10061 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10064 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10065 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10067 C Derivatives in gamma(l-1) or gamma(j-1)
10070 s1=dip(1,jj,i)*dipderg(3,kk,k)
10072 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10073 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10074 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10075 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10076 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10077 vv(1)=pizda(1,1)-pizda(2,2)
10078 vv(2)=pizda(1,2)+pizda(2,1)
10079 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10082 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10084 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10087 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10088 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10090 C Cartesian derivatives.
10092 write (2,*) 'In eello6_graph2'
10094 write (2,*) 'iii=',iii
10096 write (2,*) 'kkk=',kkk
10098 write (2,'(3(2f10.5),5x)')
10099 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10109 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10111 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10114 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
10116 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10117 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
10119 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10120 call transpose2(EUg(1,1,k),auxmat(1,1))
10121 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
10123 vv(1)=pizda(1,1)-pizda(2,2)
10124 vv(2)=pizda(1,2)+pizda(2,1)
10125 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10126 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10128 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10130 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10133 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10135 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10142 c----------------------------------------------------------------------------
10143 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
10144 implicit real*8 (a-h,o-z)
10145 include 'DIMENSIONS'
10146 include 'COMMON.IOUNITS'
10147 include 'COMMON.CHAIN'
10148 include 'COMMON.DERIV'
10149 include 'COMMON.INTERACT'
10150 include 'COMMON.CONTACTS'
10151 include 'COMMON.TORSION'
10152 include 'COMMON.VAR'
10153 include 'COMMON.GEO'
10154 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
10156 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10158 C Parallel Antiparallel C
10163 C /| o |o o| o |\ C
10164 C j|/k\| / |/k\|l / C
10169 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10171 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10172 C energy moment and not to the cluster cumulant.
10173 iti=itortyp(itype(i))
10174 if (j.lt.nres-1) then
10175 itj1=itortyp(itype(j+1))
10179 itk=itortyp(itype(k))
10180 itk1=itortyp(itype(k+1))
10181 if (l.lt.nres-1) then
10182 itl1=itortyp(itype(l+1))
10187 s1=dip(4,jj,i)*dip(4,kk,k)
10189 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
10190 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10191 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
10192 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10193 call transpose2(EE(1,1,itk),auxmat(1,1))
10194 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10195 vv(1)=pizda(1,1)+pizda(2,2)
10196 vv(2)=pizda(2,1)-pizda(1,2)
10197 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10198 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10199 cd & "sum",-(s2+s3+s4)
10201 eello6_graph3=-(s1+s2+s3+s4)
10203 eello6_graph3=-(s2+s3+s4)
10205 c eello6_graph3=-s4
10206 C Derivatives in gamma(k-1)
10207 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
10208 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10209 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10210 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10211 C Derivatives in gamma(l-1)
10212 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
10213 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10214 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10215 vv(1)=pizda(1,1)+pizda(2,2)
10216 vv(2)=pizda(2,1)-pizda(1,2)
10217 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10218 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10219 C Cartesian derivatives.
10225 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10227 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10230 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
10232 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10233 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
10235 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10236 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
10238 vv(1)=pizda(1,1)+pizda(2,2)
10239 vv(2)=pizda(2,1)-pizda(1,2)
10240 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10242 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10244 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10247 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10249 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10251 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10257 c----------------------------------------------------------------------------
10258 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10259 implicit real*8 (a-h,o-z)
10260 include 'DIMENSIONS'
10261 include 'COMMON.IOUNITS'
10262 include 'COMMON.CHAIN'
10263 include 'COMMON.DERIV'
10264 include 'COMMON.INTERACT'
10265 include 'COMMON.CONTACTS'
10266 include 'COMMON.TORSION'
10267 include 'COMMON.VAR'
10268 include 'COMMON.GEO'
10269 include 'COMMON.FFIELD'
10270 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10271 & auxvec1(2),auxmat1(2,2)
10273 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10275 C Parallel Antiparallel C
10280 C /| o |o o| o |\ C
10281 C \ j|/k\| \ |/k\|l C
10286 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10288 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10289 C energy moment and not to the cluster cumulant.
10290 cd write (2,*) 'eello_graph4: wturn6',wturn6
10291 iti=itortyp(itype(i))
10292 itj=itortyp(itype(j))
10293 if (j.lt.nres-1) then
10294 itj1=itortyp(itype(j+1))
10298 itk=itortyp(itype(k))
10299 if (k.lt.nres-1) then
10300 itk1=itortyp(itype(k+1))
10304 itl=itortyp(itype(l))
10305 if (l.lt.nres-1) then
10306 itl1=itortyp(itype(l+1))
10310 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10311 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10312 cd & ' itl',itl,' itl1',itl1
10314 if (imat.eq.1) then
10315 s1=dip(3,jj,i)*dip(3,kk,k)
10317 s1=dip(2,jj,j)*dip(2,kk,l)
10320 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10321 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10323 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
10324 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10326 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
10327 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10329 call transpose2(EUg(1,1,k),auxmat(1,1))
10330 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10331 vv(1)=pizda(1,1)-pizda(2,2)
10332 vv(2)=pizda(2,1)+pizda(1,2)
10333 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10334 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10336 eello6_graph4=-(s1+s2+s3+s4)
10338 eello6_graph4=-(s2+s3+s4)
10340 C Derivatives in gamma(i-1)
10343 if (imat.eq.1) then
10344 s1=dipderg(2,jj,i)*dip(3,kk,k)
10346 s1=dipderg(4,jj,j)*dip(2,kk,l)
10349 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10351 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
10352 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10354 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
10355 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10357 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10358 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10359 cd write (2,*) 'turn6 derivatives'
10361 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10363 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10367 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10369 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10373 C Derivatives in gamma(k-1)
10375 if (imat.eq.1) then
10376 s1=dip(3,jj,i)*dipderg(2,kk,k)
10378 s1=dip(2,jj,j)*dipderg(4,kk,l)
10381 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10382 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10384 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
10385 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10387 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
10388 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10390 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10391 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10392 vv(1)=pizda(1,1)-pizda(2,2)
10393 vv(2)=pizda(2,1)+pizda(1,2)
10394 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10395 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10397 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10399 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10403 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10405 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10408 C Derivatives in gamma(j-1) or gamma(l-1)
10409 if (l.eq.j+1 .and. l.gt.1) then
10410 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10411 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10412 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10413 vv(1)=pizda(1,1)-pizda(2,2)
10414 vv(2)=pizda(2,1)+pizda(1,2)
10415 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10416 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10417 else if (j.gt.1) then
10418 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10419 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10420 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10421 vv(1)=pizda(1,1)-pizda(2,2)
10422 vv(2)=pizda(2,1)+pizda(1,2)
10423 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10424 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10425 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10427 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10430 C Cartesian derivatives.
10436 if (imat.eq.1) then
10437 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10439 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10442 if (imat.eq.1) then
10443 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10445 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10449 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
10451 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10453 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10454 & b1(1,j+1),auxvec(1))
10455 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
10457 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10458 & b1(1,l+1),auxvec(1))
10459 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
10461 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10463 vv(1)=pizda(1,1)-pizda(2,2)
10464 vv(2)=pizda(2,1)+pizda(1,2)
10465 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10467 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10469 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10472 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10475 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10478 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10480 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10482 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10486 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10488 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10491 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10493 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10501 c----------------------------------------------------------------------------
10502 double precision function eello_turn6(i,jj,kk)
10503 implicit real*8 (a-h,o-z)
10504 include 'DIMENSIONS'
10505 include 'COMMON.IOUNITS'
10506 include 'COMMON.CHAIN'
10507 include 'COMMON.DERIV'
10508 include 'COMMON.INTERACT'
10509 include 'COMMON.CONTACTS'
10510 include 'COMMON.TORSION'
10511 include 'COMMON.VAR'
10512 include 'COMMON.GEO'
10513 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
10514 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
10516 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
10517 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
10518 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10519 C the respective energy moment and not to the cluster cumulant.
10528 iti=itortyp(itype(i))
10529 itk=itortyp(itype(k))
10530 itk1=itortyp(itype(k+1))
10531 itl=itortyp(itype(l))
10532 itj=itortyp(itype(j))
10533 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10534 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
10535 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10540 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10542 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10546 derx_turn(lll,kkk,iii)=0.0d0
10553 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10555 cd write (2,*) 'eello6_5',eello6_5
10557 call transpose2(AEA(1,1,1),auxmat(1,1))
10558 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10559 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10560 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10562 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10563 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10564 s2 = scalar2(b1(1,k),vtemp1(1))
10566 call transpose2(AEA(1,1,2),atemp(1,1))
10567 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10568 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10569 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10571 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10572 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10573 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10575 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10576 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10577 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10578 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10579 ss13 = scalar2(b1(1,k),vtemp4(1))
10580 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10582 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10588 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10589 C Derivatives in gamma(i+2)
10593 call transpose2(AEA(1,1,1),auxmatd(1,1))
10594 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10595 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10596 call transpose2(AEAderg(1,1,2),atempd(1,1))
10597 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10598 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10600 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10601 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10602 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10608 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10609 C Derivatives in gamma(i+3)
10611 call transpose2(AEA(1,1,1),auxmatd(1,1))
10612 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10613 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10614 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10616 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10617 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10618 s2d = scalar2(b1(1,k),vtemp1d(1))
10620 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10621 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10623 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10625 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10626 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10627 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10635 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10636 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10638 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10639 & -0.5d0*ekont*(s2d+s12d)
10641 C Derivatives in gamma(i+4)
10642 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10643 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10644 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10646 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10647 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10648 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10656 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10658 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10660 C Derivatives in gamma(i+5)
10662 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10663 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10664 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10666 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10667 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10668 s2d = scalar2(b1(1,k),vtemp1d(1))
10670 call transpose2(AEA(1,1,2),atempd(1,1))
10671 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10672 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10674 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10675 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10677 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10678 ss13d = scalar2(b1(1,k),vtemp4d(1))
10679 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10687 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10688 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10690 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10691 & -0.5d0*ekont*(s2d+s12d)
10693 C Cartesian derivatives
10698 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10699 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10700 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10702 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10703 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10705 s2d = scalar2(b1(1,k),vtemp1d(1))
10707 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10708 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10709 s8d = -(atempd(1,1)+atempd(2,2))*
10710 & scalar2(cc(1,1,itl),vtemp2(1))
10712 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10714 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10715 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10722 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10723 & - 0.5d0*(s1d+s2d)
10725 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10729 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10730 & - 0.5d0*(s8d+s12d)
10732 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10741 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10742 & achuj_tempd(1,1))
10743 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10744 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10745 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10746 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10747 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10749 ss13d = scalar2(b1(1,k),vtemp4d(1))
10750 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10751 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10755 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10756 cd & 16*eel_turn6_num
10758 if (j.lt.nres-1) then
10765 if (l.lt.nres-1) then
10773 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10774 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10775 cgrad ghalf=0.5d0*ggg1(ll)
10777 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10778 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10779 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10780 & +ekont*derx_turn(ll,2,1)
10781 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10782 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10783 & +ekont*derx_turn(ll,4,1)
10784 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10785 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10786 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10787 cgrad ghalf=0.5d0*ggg2(ll)
10789 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10790 & +ekont*derx_turn(ll,2,2)
10791 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10792 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10793 & +ekont*derx_turn(ll,4,2)
10794 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10795 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10796 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10801 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10806 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10812 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10817 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10821 cd write (2,*) iii,g_corr6_loc(iii)
10823 eello_turn6=ekont*eel_turn6
10824 cd write (2,*) 'ekont',ekont
10825 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10829 C-----------------------------------------------------------------------------
10830 double precision function scalar(u,v)
10831 !DIR$ INLINEALWAYS scalar
10833 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10836 double precision u(3),v(3)
10837 cd double precision sc
10845 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10848 crc-------------------------------------------------
10849 SUBROUTINE MATVEC2(A1,V1,V2)
10850 !DIR$ INLINEALWAYS MATVEC2
10852 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10854 implicit real*8 (a-h,o-z)
10855 include 'DIMENSIONS'
10856 DIMENSION A1(2,2),V1(2),V2(2)
10860 c 3 VI=VI+A1(I,K)*V1(K)
10864 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10865 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10870 C---------------------------------------
10871 SUBROUTINE MATMAT2(A1,A2,A3)
10873 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10875 implicit real*8 (a-h,o-z)
10876 include 'DIMENSIONS'
10877 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10878 c DIMENSION AI3(2,2)
10882 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10888 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10889 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10890 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10891 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10899 c-------------------------------------------------------------------------
10900 double precision function scalar2(u,v)
10901 !DIR$ INLINEALWAYS scalar2
10903 double precision u(2),v(2)
10904 double precision sc
10906 scalar2=u(1)*v(1)+u(2)*v(2)
10910 C-----------------------------------------------------------------------------
10912 subroutine transpose2(a,at)
10913 !DIR$ INLINEALWAYS transpose2
10915 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10918 double precision a(2,2),at(2,2)
10925 c--------------------------------------------------------------------------
10926 subroutine transpose(n,a,at)
10929 double precision a(n,n),at(n,n)
10937 C---------------------------------------------------------------------------
10938 subroutine prodmat3(a1,a2,kk,transp,prod)
10939 !DIR$ INLINEALWAYS prodmat3
10941 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10945 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10947 crc double precision auxmat(2,2),prod_(2,2)
10950 crc call transpose2(kk(1,1),auxmat(1,1))
10951 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10952 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10954 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10955 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10956 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10957 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10958 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10959 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10960 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10961 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10964 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10965 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10967 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10968 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10969 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10970 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10971 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10972 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10973 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10974 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10977 c call transpose2(a2(1,1),a2t(1,1))
10980 crc print *,((prod_(i,j),i=1,2),j=1,2)
10981 crc print *,((prod(i,j),i=1,2),j=1,2)
10985 CCC----------------------------------------------
10986 subroutine Eliptransfer(eliptran)
10987 implicit real*8 (a-h,o-z)
10988 include 'DIMENSIONS'
10989 include 'COMMON.GEO'
10990 include 'COMMON.VAR'
10991 include 'COMMON.LOCAL'
10992 include 'COMMON.CHAIN'
10993 include 'COMMON.DERIV'
10994 include 'COMMON.NAMES'
10995 include 'COMMON.INTERACT'
10996 include 'COMMON.IOUNITS'
10997 include 'COMMON.CALC'
10998 include 'COMMON.CONTROL'
10999 include 'COMMON.SPLITELE'
11000 include 'COMMON.SBRIDGE'
11001 C this is done by Adasko
11002 C print *,"wchodze"
11003 C structure of box:
11005 C--bordliptop-- buffore starts
11006 C--bufliptop--- here true lipid starts
11008 C--buflipbot--- lipid ends buffore starts
11009 C--bordlipbot--buffore ends
11011 do i=ilip_start,ilip_end
11013 if (itype(i).eq.ntyp1) cycle
11015 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
11016 if (positi.le.0) positi=positi+boxzsize
11018 C first for peptide groups
11019 c for each residue check if it is in lipid or lipid water border area
11020 if ((positi.gt.bordlipbot)
11021 &.and.(positi.lt.bordliptop)) then
11022 C the energy transfer exist
11023 if (positi.lt.buflipbot) then
11024 C what fraction I am in
11026 & ((positi-bordlipbot)/lipbufthick)
11027 C lipbufthick is thickenes of lipid buffore
11028 sslip=sscalelip(fracinbuf)
11029 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11030 eliptran=eliptran+sslip*pepliptran
11031 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11032 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11033 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11035 C print *,"doing sccale for lower part"
11036 C print *,i,sslip,fracinbuf,ssgradlip
11037 elseif (positi.gt.bufliptop) then
11038 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
11039 sslip=sscalelip(fracinbuf)
11040 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11041 eliptran=eliptran+sslip*pepliptran
11042 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11043 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11044 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11045 C print *, "doing sscalefor top part"
11046 C print *,i,sslip,fracinbuf,ssgradlip
11048 eliptran=eliptran+pepliptran
11049 C print *,"I am in true lipid"
11052 C eliptran=elpitran+0.0 ! I am in water
11055 C print *, "nic nie bylo w lipidzie?"
11056 C now multiply all by the peptide group transfer factor
11057 C eliptran=eliptran*pepliptran
11058 C now the same for side chains
11060 do i=ilip_start,ilip_end
11061 if (itype(i).eq.ntyp1) cycle
11062 positi=(mod(c(3,i+nres),boxzsize))
11063 if (positi.le.0) positi=positi+boxzsize
11064 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
11065 c for each residue check if it is in lipid or lipid water border area
11066 C respos=mod(c(3,i+nres),boxzsize)
11067 C print *,positi,bordlipbot,buflipbot
11068 if ((positi.gt.bordlipbot)
11069 & .and.(positi.lt.bordliptop)) then
11070 C the energy transfer exist
11071 if (positi.lt.buflipbot) then
11073 & ((positi-bordlipbot)/lipbufthick)
11074 C lipbufthick is thickenes of lipid buffore
11075 sslip=sscalelip(fracinbuf)
11076 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11077 eliptran=eliptran+sslip*liptranene(itype(i))
11078 gliptranx(3,i)=gliptranx(3,i)
11079 &+ssgradlip*liptranene(itype(i))
11080 gliptranc(3,i-1)= gliptranc(3,i-1)
11081 &+ssgradlip*liptranene(itype(i))
11082 C print *,"doing sccale for lower part"
11083 elseif (positi.gt.bufliptop) then
11085 &((bordliptop-positi)/lipbufthick)
11086 sslip=sscalelip(fracinbuf)
11087 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11088 eliptran=eliptran+sslip*liptranene(itype(i))
11089 gliptranx(3,i)=gliptranx(3,i)
11090 &+ssgradlip*liptranene(itype(i))
11091 gliptranc(3,i-1)= gliptranc(3,i-1)
11092 &+ssgradlip*liptranene(itype(i))
11093 C print *, "doing sscalefor top part",sslip,fracinbuf
11095 eliptran=eliptran+liptranene(itype(i))
11096 C print *,"I am in true lipid"
11098 endif ! if in lipid or buffor
11100 C eliptran=elpitran+0.0 ! I am in water
11104 C---------------------------------------------------------
11105 C AFM soubroutine for constant force
11106 subroutine AFMforce(Eafmforce)
11107 implicit real*8 (a-h,o-z)
11108 include 'DIMENSIONS'
11109 include 'COMMON.GEO'
11110 include 'COMMON.VAR'
11111 include 'COMMON.LOCAL'
11112 include 'COMMON.CHAIN'
11113 include 'COMMON.DERIV'
11114 include 'COMMON.NAMES'
11115 include 'COMMON.INTERACT'
11116 include 'COMMON.IOUNITS'
11117 include 'COMMON.CALC'
11118 include 'COMMON.CONTROL'
11119 include 'COMMON.SPLITELE'
11120 include 'COMMON.SBRIDGE'
11125 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11126 dist=dist+diffafm(i)**2
11129 Eafmforce=-forceAFMconst*(dist-distafminit)
11131 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
11132 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
11134 C print *,'AFM',Eafmforce
11137 C---------------------------------------------------------
11138 C AFM subroutine with pseudoconstant velocity
11139 subroutine AFMvel(Eafmforce)
11140 implicit real*8 (a-h,o-z)
11141 include 'DIMENSIONS'
11142 include 'COMMON.GEO'
11143 include 'COMMON.VAR'
11144 include 'COMMON.LOCAL'
11145 include 'COMMON.CHAIN'
11146 include 'COMMON.DERIV'
11147 include 'COMMON.NAMES'
11148 include 'COMMON.INTERACT'
11149 include 'COMMON.IOUNITS'
11150 include 'COMMON.CALC'
11151 include 'COMMON.CONTROL'
11152 include 'COMMON.SPLITELE'
11153 include 'COMMON.SBRIDGE'
11155 C Only for check grad COMMENT if not used for checkgrad
11157 C--------------------------------------------------------
11158 C print *,"wchodze"
11162 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11163 dist=dist+diffafm(i)**2
11166 Eafmforce=0.5d0*forceAFMconst
11167 & *(distafminit+totTafm*velAFMconst-dist)**2
11168 C Eafmforce=-forceAFMconst*(dist-distafminit)
11170 gradafm(i,afmend-1)=-forceAFMconst*
11171 &(distafminit+totTafm*velAFMconst-dist)
11173 gradafm(i,afmbeg-1)=forceAFMconst*
11174 &(distafminit+totTafm*velAFMconst-dist)
11177 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
11181 c----------------------------------------------------------------------------
11182 double precision function sscale2(r,r_cut,r0,rlamb)
11184 double precision r,gamm,r_cut,r0,rlamb,rr
11186 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
11187 c write (2,*) "rr",rr
11188 if(rr.lt.r_cut-rlamb) then
11190 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
11191 gamm=(rr-(r_cut-rlamb))/rlamb
11192 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
11198 C-----------------------------------------------------------------------
11199 double precision function sscalgrad2(r,r_cut,r0,rlamb)
11201 double precision r,gamm,r_cut,r0,rlamb,rr
11203 if(rr.lt.r_cut-rlamb) then
11205 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
11206 gamm=(rr-(r_cut-rlamb))/rlamb
11208 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
11210 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
11217 c----------------------------------------------------------------------------
11218 subroutine e_saxs(Esaxs_constr)
11220 include 'DIMENSIONS'
11223 include "COMMON.SETUP"
11226 include 'COMMON.SBRIDGE'
11227 include 'COMMON.CHAIN'
11228 include 'COMMON.GEO'
11229 include 'COMMON.DERIV'
11230 include 'COMMON.LOCAL'
11231 include 'COMMON.INTERACT'
11232 include 'COMMON.VAR'
11233 include 'COMMON.IOUNITS'
11234 include 'COMMON.MD'
11235 include 'COMMON.CONTROL'
11236 include 'COMMON.NAMES'
11237 include 'COMMON.TIME1'
11238 include 'COMMON.FFIELD'
11240 double precision Esaxs_constr
11241 integer i,iint,j,k,l
11242 double precision PgradC(maxSAXS,3,maxres),
11243 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
11245 double precision PgradC_(maxSAXS,3,maxres),
11246 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
11248 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
11249 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
11250 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
11251 & auxX,auxX1,CACAgrad,Cnorm
11252 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
11253 double precision dist
11255 c SAXS restraint penalty function
11257 write(iout,*) "------- SAXS penalty function start -------"
11258 write (iout,*) "nsaxs",nsaxs
11259 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
11260 write (iout,*) "Psaxs"
11262 write (iout,'(i5,e15.5)') i, Psaxs(i)
11265 Esaxs_constr = 0.0d0
11270 PgradC(k,l,j)=0.0d0
11271 PgradX(k,l,j)=0.0d0
11275 do i=iatsc_s,iatsc_e
11276 if (itype(i).eq.ntyp1) cycle
11277 do iint=1,nint_gr(i)
11278 do j=istart(i,iint),iend(i,iint)
11279 if (itype(j).eq.ntyp1) cycle
11282 dijCASC=dist(i,j+nres)
11283 dijSCCA=dist(i+nres,j)
11284 dijSCSC=dist(i+nres,j+nres)
11285 sigma2CACA=2.0d0/(pstok**2)
11286 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
11287 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
11288 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
11291 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
11292 if (itype(j).ne.10) then
11293 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
11297 if (itype(i).ne.10) then
11298 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
11302 if (itype(i).ne.10 .and. itype(j).ne.10) then
11303 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
11307 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
11309 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
11311 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
11312 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
11313 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
11314 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
11317 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
11318 PgradC(k,l,i) = PgradC(k,l,i)-aux
11319 PgradC(k,l,j) = PgradC(k,l,j)+aux
11321 if (itype(j).ne.10) then
11322 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
11323 PgradC(k,l,i) = PgradC(k,l,i)-aux
11324 PgradC(k,l,j) = PgradC(k,l,j)+aux
11325 PgradX(k,l,j) = PgradX(k,l,j)+aux
11328 if (itype(i).ne.10) then
11329 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
11330 PgradX(k,l,i) = PgradX(k,l,i)-aux
11331 PgradC(k,l,i) = PgradC(k,l,i)-aux
11332 PgradC(k,l,j) = PgradC(k,l,j)+aux
11335 if (itype(i).ne.10 .and. itype(j).ne.10) then
11336 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
11337 PgradC(k,l,i) = PgradC(k,l,i)-aux
11338 PgradC(k,l,j) = PgradC(k,l,j)+aux
11339 PgradX(k,l,i) = PgradX(k,l,i)-aux
11340 PgradX(k,l,j) = PgradX(k,l,j)+aux
11346 sigma2CACA=scal_rad**2*0.25d0/
11347 & (restok(itype(j))**2+restok(itype(i))**2)
11349 IF (saxs_cutoff.eq.0) THEN
11352 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
11353 Pcalc(k) = Pcalc(k)+expCACA
11354 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
11356 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
11357 PgradC(k,l,i) = PgradC(k,l,i)-aux
11358 PgradC(k,l,j) = PgradC(k,l,j)+aux
11362 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
11365 c write (2,*) "ijk",i,j,k
11366 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
11367 if (sss2.eq.0.0d0) cycle
11368 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
11369 if (energy_dec) write(iout,'(a4,3i5,5f10.4)')
11370 & 'saxs',i,j,k,dijCACA,rrr,dk,sss2,ssgrad2
11371 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
11372 Pcalc(k) = Pcalc(k)+expCACA
11374 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
11376 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
11377 & ssgrad2*expCACA/sss2
11380 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
11381 PgradC(k,l,i) = PgradC(k,l,i)+aux
11382 PgradC(k,l,j) = PgradC(k,l,j)-aux
11391 if (nfgtasks.gt.1) then
11392 call MPI_AllReduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
11393 & MPI_SUM,FG_COMM,IERR)
11394 c if (fg_rank.eq.king) then
11396 Pcalc(k) = Pcalc_(k)
11399 c call MPI_AllReduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
11400 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
11401 c if (fg_rank.eq.king) then
11405 c PgradC(k,l,i) = PgradC_(k,l,i)
11411 c call MPI_AllReduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
11412 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
11413 c if (fg_rank.eq.king) then
11417 c PgradX(k,l,i) = PgradX_(k,l,i)
11427 Cnorm = Cnorm + Pcalc(k)
11430 if (fg_rank.eq.king) then
11432 Esaxs_constr = dlog(Cnorm)-wsaxs0
11434 if (Pcalc(k).gt.0.0d0)
11435 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
11437 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
11441 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
11456 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
11457 auxC1 = auxC1+PgradC(k,l,i)
11459 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
11460 auxX1 = auxX1+PgradX(k,l,i)
11463 gsaxsC(l,i) = auxC - auxC1/Cnorm
11465 gsaxsX(l,i) = auxX - auxX1/Cnorm
11467 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
11468 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
11476 c----------------------------------------------------------------------------
11477 subroutine e_saxsC(Esaxs_constr)
11479 include 'DIMENSIONS'
11482 include "COMMON.SETUP"
11485 include 'COMMON.SBRIDGE'
11486 include 'COMMON.CHAIN'
11487 include 'COMMON.GEO'
11488 include 'COMMON.DERIV'
11489 include 'COMMON.LOCAL'
11490 include 'COMMON.INTERACT'
11491 include 'COMMON.VAR'
11492 include 'COMMON.IOUNITS'
11493 include 'COMMON.MD'
11494 include 'COMMON.CONTROL'
11495 include 'COMMON.NAMES'
11496 include 'COMMON.TIME1'
11497 include 'COMMON.FFIELD'
11499 double precision Esaxs_constr
11500 integer i,iint,j,k,l
11501 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
11503 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
11505 double precision dk,dijCASPH,dijSCSPH,
11506 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
11507 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
11509 c SAXS restraint penalty function
11511 write(iout,*) "------- SAXS penalty function start -------"
11512 write (iout,*) "nsaxs",nsaxs
11515 print *,MyRank,"C",i,(C(j,i),j=1,3)
11518 print *,MyRank,"CSaxs",i,(Csaxs(j,i),j=1,3)
11521 Esaxs_constr = 0.0d0
11523 do j=isaxs_start,isaxs_end
11532 if (itype(i).eq.ntyp1) cycle
11536 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
11538 if (itype(i).ne.10) then
11540 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
11543 sigma2CA=2.0d0/pstok**2
11544 sigma2SC=4.0d0/restok(itype(i))**2
11545 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
11546 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
11547 Pcalc = Pcalc+expCASPH+expSCSPH
11549 write(*,*) "processor i j Pcalc",
11550 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
11552 CASPHgrad = sigma2CA*expCASPH
11553 SCSPHgrad = sigma2SC*expSCSPH
11555 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
11556 PgradX(l,i) = PgradX(l,i) + aux
11557 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
11562 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
11563 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
11566 logPtot = logPtot - dlog(Pcalc)
11567 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
11568 c & " logPtot",logPtot
11571 if (nfgtasks.gt.1) then
11572 c write (iout,*) "logPtot before reduction",logPtot
11573 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
11574 & MPI_SUM,king,FG_COMM,IERR)
11576 c write (iout,*) "logPtot after reduction",logPtot
11577 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
11578 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11579 if (fg_rank.eq.king) then
11582 gsaxsC(l,i) = gsaxsC_(l,i)
11586 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
11587 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11588 if (fg_rank.eq.king) then
11591 gsaxsX(l,i) = gsaxsX_(l,i)
11597 Esaxs_constr = logPtot