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'
5200 C write (iout,*) ,"link_end",link_end,constr_dist
5201 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5202 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
5203 c & " constr_dist",constr_dist
5204 if (link_end.eq.0) return
5205 do i=link_start,link_end
5206 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5207 C CA-CA distance used in regularization of structure.
5210 C iii and jjj point to the residues for which the distance is assigned.
5211 if (ii.gt.nres) then
5218 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5219 c & dhpb(i),dhpb1(i),forcon(i)
5220 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5221 C distance and angle dependent SS bond potential.
5222 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5223 C & iabs(itype(jjj)).eq.1) then
5224 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5225 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5226 if (.not.dyn_ss .and. i.le.nss) then
5227 C 15/02/13 CC dynamic SSbond - additional check
5228 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5229 & iabs(itype(jjj)).eq.1) then
5230 call ssbond_ene(iii,jjj,eij)
5233 cd write (iout,*) "eij",eij
5234 cd & ' waga=',waga,' fac=',fac
5235 ! else if (ii.gt.nres .and. jj.gt.nres) then
5237 C Calculate the distance between the two points and its difference from the
5240 if (irestr_type(i).eq.11) then
5241 ehpb=ehpb+fordepth(i)!**4.0d0
5242 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5243 fac=fordepth(i)!**4.0d0
5244 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5245 if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
5246 & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
5247 & ehpb,irestr_type(i)
5248 else if (irestr_type(i).eq.10) then
5249 c AL 6//19/2018 cross-link restraints
5250 xdis = 0.5d0*(dd/forcon(i))**2
5251 expdis = dexp(-xdis)
5252 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
5253 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
5254 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
5255 c & " wboltzd",wboltzd
5256 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
5257 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
5258 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
5259 & *expdis/(aux*forcon(i)**2)
5260 if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
5261 & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
5262 & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
5263 else if (irestr_type(i).eq.2) then
5264 c Quartic restraints
5265 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5266 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
5267 & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
5268 & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
5269 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5271 c Quadratic restraints
5273 C Get the force constant corresponding to this distance.
5275 C Calculate the contribution to energy.
5276 ehpb=ehpb+0.5d0*waga*rdis*rdis
5277 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
5278 & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
5279 & 0.5d0*waga*rdis*rdis,irestr_type(i)
5281 C Evaluate gradient.
5285 c Calculate Cartesian gradient
5287 ggg(j)=fac*(c(j,jj)-c(j,ii))
5289 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5290 C If this is a SC-SC distance, we need to calculate the contributions to the
5291 C Cartesian gradient in the SC vectors (ghpbx).
5294 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5295 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5298 cgrad do j=iii,jjj-1
5300 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5304 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5305 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5311 C--------------------------------------------------------------------------
5312 subroutine ssbond_ene(i,j,eij)
5314 C Calculate the distance and angle dependent SS-bond potential energy
5315 C using a free-energy function derived based on RHF/6-31G** ab initio
5316 C calculations of diethyl disulfide.
5318 C A. Liwo and U. Kozlowska, 11/24/03
5320 implicit real*8 (a-h,o-z)
5321 include 'DIMENSIONS'
5322 include 'COMMON.SBRIDGE'
5323 include 'COMMON.CHAIN'
5324 include 'COMMON.DERIV'
5325 include 'COMMON.LOCAL'
5326 include 'COMMON.INTERACT'
5327 include 'COMMON.VAR'
5328 include 'COMMON.IOUNITS'
5329 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5330 itypi=iabs(itype(i))
5334 dxi=dc_norm(1,nres+i)
5335 dyi=dc_norm(2,nres+i)
5336 dzi=dc_norm(3,nres+i)
5337 c dsci_inv=dsc_inv(itypi)
5338 dsci_inv=vbld_inv(nres+i)
5339 itypj=iabs(itype(j))
5340 c dscj_inv=dsc_inv(itypj)
5341 dscj_inv=vbld_inv(nres+j)
5345 dxj=dc_norm(1,nres+j)
5346 dyj=dc_norm(2,nres+j)
5347 dzj=dc_norm(3,nres+j)
5348 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5353 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5354 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5355 om12=dxi*dxj+dyi*dyj+dzi*dzj
5357 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5358 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5364 deltat12=om2-om1+2.0d0
5366 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5367 & +akct*deltad*deltat12
5368 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5369 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5370 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5371 c & " deltat12",deltat12," eij",eij
5372 ed=2*akcm*deltad+akct*deltat12
5374 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5375 eom1=-2*akth*deltat1-pom1-om2*pom2
5376 eom2= 2*akth*deltat2+pom1-om1*pom2
5379 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5380 ghpbx(k,i)=ghpbx(k,i)-ggk
5381 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5382 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5383 ghpbx(k,j)=ghpbx(k,j)+ggk
5384 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5385 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5386 ghpbc(k,i)=ghpbc(k,i)-ggk
5387 ghpbc(k,j)=ghpbc(k,j)+ggk
5390 C Calculate the components of the gradient in DC and X
5394 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5399 C--------------------------------------------------------------------------
5400 subroutine ebond(estr)
5402 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5404 implicit real*8 (a-h,o-z)
5405 include 'DIMENSIONS'
5406 include 'COMMON.LOCAL'
5407 include 'COMMON.GEO'
5408 include 'COMMON.INTERACT'
5409 include 'COMMON.DERIV'
5410 include 'COMMON.VAR'
5411 include 'COMMON.CHAIN'
5412 include 'COMMON.IOUNITS'
5413 include 'COMMON.NAMES'
5414 include 'COMMON.FFIELD'
5415 include 'COMMON.CONTROL'
5416 include 'COMMON.SETUP'
5417 double precision u(3),ud(3)
5420 do i=ibondp_start,ibondp_end
5421 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5422 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5424 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5425 c & *dc(j,i-1)/vbld(i)
5427 c if (energy_dec) write(iout,*)
5428 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5430 C Checking if it involves dummy (NH3+ or COO-) group
5431 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5432 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5433 diff = vbld(i)-vbldpDUM
5435 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5436 diff = vbld(i)-vbldp0
5438 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5439 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5442 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5444 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5448 estr=0.5d0*AKP*estr+estr1
5450 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5452 do i=ibond_start,ibond_end
5454 if (iti.ne.10 .and. iti.ne.ntyp1) then
5457 diff=vbld(i+nres)-vbldsc0(1,iti)
5458 if (energy_dec) write (iout,*)
5459 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5460 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5461 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5463 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5467 diff=vbld(i+nres)-vbldsc0(j,iti)
5468 ud(j)=aksc(j,iti)*diff
5469 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5483 uprod2=uprod2*u(k)*u(k)
5487 usumsqder=usumsqder+ud(j)*uprod2
5489 estr=estr+uprod/usum
5491 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5499 C--------------------------------------------------------------------------
5500 subroutine ebend(etheta)
5502 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5503 C angles gamma and its derivatives in consecutive thetas and gammas.
5505 implicit real*8 (a-h,o-z)
5506 include 'DIMENSIONS'
5507 include 'COMMON.LOCAL'
5508 include 'COMMON.GEO'
5509 include 'COMMON.INTERACT'
5510 include 'COMMON.DERIV'
5511 include 'COMMON.VAR'
5512 include 'COMMON.CHAIN'
5513 include 'COMMON.IOUNITS'
5514 include 'COMMON.NAMES'
5515 include 'COMMON.FFIELD'
5516 include 'COMMON.CONTROL'
5517 common /calcthet/ term1,term2,termm,diffak,ratak,
5518 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5519 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5520 double precision y(2),z(2)
5522 c time11=dexp(-2*time)
5525 c write (*,'(a,i2)') 'EBEND ICG=',icg
5526 do i=ithet_start,ithet_end
5527 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5528 & .or.itype(i).eq.ntyp1) cycle
5529 C Zero the energy function and its derivative at 0 or pi.
5530 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5532 ichir1=isign(1,itype(i-2))
5533 ichir2=isign(1,itype(i))
5534 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5535 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5536 if (itype(i-1).eq.10) then
5537 itype1=isign(10,itype(i-2))
5538 ichir11=isign(1,itype(i-2))
5539 ichir12=isign(1,itype(i-2))
5540 itype2=isign(10,itype(i))
5541 ichir21=isign(1,itype(i))
5542 ichir22=isign(1,itype(i))
5545 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5548 if (phii.ne.phii) phii=150.0
5558 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5561 if (phii1.ne.phii1) phii1=150.0
5573 C Calculate the "mean" value of theta from the part of the distribution
5574 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5575 C In following comments this theta will be referred to as t_c.
5576 thet_pred_mean=0.0d0
5578 athetk=athet(k,it,ichir1,ichir2)
5579 bthetk=bthet(k,it,ichir1,ichir2)
5581 athetk=athet(k,itype1,ichir11,ichir12)
5582 bthetk=bthet(k,itype2,ichir21,ichir22)
5584 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5585 c write(iout,*) 'chuj tu', y(k),z(k)
5587 dthett=thet_pred_mean*ssd
5588 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5589 C Derivatives of the "mean" values in gamma1 and gamma2.
5590 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5591 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5592 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5593 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5595 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5596 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5597 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5598 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5600 if (theta(i).gt.pi-delta) then
5601 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5603 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5604 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5605 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5607 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5609 else if (theta(i).lt.delta) then
5610 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5611 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5612 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5614 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5615 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5618 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5621 etheta=etheta+ethetai
5622 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5623 & 'ebend',i,ethetai,theta(i),itype(i)
5624 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5625 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5626 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5629 C Ufff.... We've done all this!!!
5632 C---------------------------------------------------------------------------
5633 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5635 implicit real*8 (a-h,o-z)
5636 include 'DIMENSIONS'
5637 include 'COMMON.LOCAL'
5638 include 'COMMON.IOUNITS'
5639 common /calcthet/ term1,term2,termm,diffak,ratak,
5640 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5641 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5642 C Calculate the contributions to both Gaussian lobes.
5643 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5644 C The "polynomial part" of the "standard deviation" of this part of
5645 C the distributioni.
5646 ccc write (iout,*) thetai,thet_pred_mean
5649 sig=sig*thet_pred_mean+polthet(j,it)
5651 C Derivative of the "interior part" of the "standard deviation of the"
5652 C gamma-dependent Gaussian lobe in t_c.
5653 sigtc=3*polthet(3,it)
5655 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5658 C Set the parameters of both Gaussian lobes of the distribution.
5659 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5660 fac=sig*sig+sigc0(it)
5663 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5664 sigsqtc=-4.0D0*sigcsq*sigtc
5665 c print *,i,sig,sigtc,sigsqtc
5666 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5667 sigtc=-sigtc/(fac*fac)
5668 C Following variable is sigma(t_c)**(-2)
5669 sigcsq=sigcsq*sigcsq
5671 sig0inv=1.0D0/sig0i**2
5672 delthec=thetai-thet_pred_mean
5673 delthe0=thetai-theta0i
5674 term1=-0.5D0*sigcsq*delthec*delthec
5675 term2=-0.5D0*sig0inv*delthe0*delthe0
5676 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5677 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5678 C NaNs in taking the logarithm. We extract the largest exponent which is added
5679 C to the energy (this being the log of the distribution) at the end of energy
5680 C term evaluation for this virtual-bond angle.
5681 if (term1.gt.term2) then
5683 term2=dexp(term2-termm)
5687 term1=dexp(term1-termm)
5690 C The ratio between the gamma-independent and gamma-dependent lobes of
5691 C the distribution is a Gaussian function of thet_pred_mean too.
5692 diffak=gthet(2,it)-thet_pred_mean
5693 ratak=diffak/gthet(3,it)**2
5694 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5695 C Let's differentiate it in thet_pred_mean NOW.
5697 C Now put together the distribution terms to make complete distribution.
5698 termexp=term1+ak*term2
5699 termpre=sigc+ak*sig0i
5700 C Contribution of the bending energy from this theta is just the -log of
5701 C the sum of the contributions from the two lobes and the pre-exponential
5702 C factor. Simple enough, isn't it?
5703 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5704 C write (iout,*) 'termexp',termexp,termm,termpre,i
5705 C NOW the derivatives!!!
5706 C 6/6/97 Take into account the deformation.
5707 E_theta=(delthec*sigcsq*term1
5708 & +ak*delthe0*sig0inv*term2)/termexp
5709 E_tc=((sigtc+aktc*sig0i)/termpre
5710 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5711 & aktc*term2)/termexp)
5714 c-----------------------------------------------------------------------------
5715 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5716 implicit real*8 (a-h,o-z)
5717 include 'DIMENSIONS'
5718 include 'COMMON.LOCAL'
5719 include 'COMMON.IOUNITS'
5720 common /calcthet/ term1,term2,termm,diffak,ratak,
5721 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5722 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5723 delthec=thetai-thet_pred_mean
5724 delthe0=thetai-theta0i
5725 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5726 t3 = thetai-thet_pred_mean
5730 t14 = t12+t6*sigsqtc
5732 t21 = thetai-theta0i
5738 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5739 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5740 & *(-t12*t9-ak*sig0inv*t27)
5744 C--------------------------------------------------------------------------
5745 subroutine ebend(etheta)
5747 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5748 C angles gamma and its derivatives in consecutive thetas and gammas.
5749 C ab initio-derived potentials from
5750 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5752 implicit real*8 (a-h,o-z)
5753 include 'DIMENSIONS'
5754 include 'COMMON.LOCAL'
5755 include 'COMMON.GEO'
5756 include 'COMMON.INTERACT'
5757 include 'COMMON.DERIV'
5758 include 'COMMON.VAR'
5759 include 'COMMON.CHAIN'
5760 include 'COMMON.IOUNITS'
5761 include 'COMMON.NAMES'
5762 include 'COMMON.FFIELD'
5763 include 'COMMON.CONTROL'
5764 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5765 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5766 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5767 & sinph1ph2(maxdouble,maxdouble)
5768 logical lprn /.false./, lprn1 /.false./
5770 do i=ithet_start,ithet_end
5772 c print *,i,itype(i-1),itype(i),itype(i-2)
5773 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1)
5774 & .or.(itype(i).eq.ntyp1)) cycle
5775 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5777 if (iabs(itype(i+1)).eq.20) iblock=2
5778 if (iabs(itype(i+1)).ne.20) iblock=1
5782 theti2=0.5d0*theta(i)
5783 ityp2=ithetyp((itype(i-1)))
5785 coskt(k)=dcos(k*theti2)
5786 sinkt(k)=dsin(k*theti2)
5788 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
5791 if (phii.ne.phii) phii=150.0
5795 ityp1=ithetyp((itype(i-2)))
5796 C propagation of chirality for glycine type
5798 cosph1(k)=dcos(k*phii)
5799 sinph1(k)=dsin(k*phii)
5803 ityp1=ithetyp(itype(i-2))
5809 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5812 if (phii1.ne.phii1) phii1=150.0
5817 ityp3=ithetyp((itype(i)))
5819 cosph2(k)=dcos(k*phii1)
5820 sinph2(k)=dsin(k*phii1)
5824 ityp3=ithetyp(itype(i))
5830 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5833 ccl=cosph1(l)*cosph2(k-l)
5834 ssl=sinph1(l)*sinph2(k-l)
5835 scl=sinph1(l)*cosph2(k-l)
5836 csl=cosph1(l)*sinph2(k-l)
5837 cosph1ph2(l,k)=ccl-ssl
5838 cosph1ph2(k,l)=ccl+ssl
5839 sinph1ph2(l,k)=scl+csl
5840 sinph1ph2(k,l)=scl-csl
5844 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5845 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5846 write (iout,*) "coskt and sinkt"
5848 write (iout,*) k,coskt(k),sinkt(k)
5852 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5853 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5856 & write (iout,*) "k",k,"
5857 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5858 & " ethetai",ethetai
5861 write (iout,*) "cosph and sinph"
5863 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5865 write (iout,*) "cosph1ph2 and sinph2ph2"
5868 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5869 & sinph1ph2(l,k),sinph1ph2(k,l)
5872 write(iout,*) "ethetai",ethetai
5876 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5877 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5878 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5879 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5880 ethetai=ethetai+sinkt(m)*aux
5881 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5882 dephii=dephii+k*sinkt(m)*(
5883 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5884 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5885 dephii1=dephii1+k*sinkt(m)*(
5886 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5887 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5889 & write (iout,*) "m",m," k",k," bbthet",
5890 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5891 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5892 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5893 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5897 & write(iout,*) "ethetai",ethetai
5901 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5902 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5903 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5904 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5905 ethetai=ethetai+sinkt(m)*aux
5906 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5907 dephii=dephii+l*sinkt(m)*(
5908 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5909 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5910 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5911 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5912 dephii1=dephii1+(k-l)*sinkt(m)*(
5913 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5914 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5915 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5916 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5918 write (iout,*) "m",m," k",k," l",l," ffthet",
5919 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5920 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5921 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5922 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5923 & " ethetai",ethetai
5924 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5925 & cosph1ph2(k,l)*sinkt(m),
5926 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5934 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5935 & i,theta(i)*rad2deg,phii*rad2deg,
5936 & phii1*rad2deg,ethetai
5938 etheta=etheta+ethetai
5939 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5941 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5942 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5943 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
5950 c-----------------------------------------------------------------------------
5951 subroutine esc(escloc)
5952 C Calculate the local energy of a side chain and its derivatives in the
5953 C corresponding virtual-bond valence angles THETA and the spherical angles
5955 implicit real*8 (a-h,o-z)
5956 include 'DIMENSIONS'
5957 include 'COMMON.GEO'
5958 include 'COMMON.LOCAL'
5959 include 'COMMON.VAR'
5960 include 'COMMON.INTERACT'
5961 include 'COMMON.DERIV'
5962 include 'COMMON.CHAIN'
5963 include 'COMMON.IOUNITS'
5964 include 'COMMON.NAMES'
5965 include 'COMMON.FFIELD'
5966 include 'COMMON.CONTROL'
5967 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5968 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5969 common /sccalc/ time11,time12,time112,theti,it,nlobit
5972 c write (iout,'(a)') 'ESC'
5973 do i=loc_start,loc_end
5975 if (it.eq.ntyp1) cycle
5976 if (it.eq.10) goto 1
5977 nlobit=nlob(iabs(it))
5978 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5979 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5980 theti=theta(i+1)-pipol
5985 if (x(2).gt.pi-delta) then
5989 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5991 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5992 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5994 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5995 & ddersc0(1),dersc(1))
5996 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5997 & ddersc0(3),dersc(3))
5999 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6001 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6002 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6003 & dersc0(2),esclocbi,dersc02)
6004 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6006 call splinthet(x(2),0.5d0*delta,ss,ssd)
6011 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6013 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6014 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6016 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6018 c write (iout,*) escloci
6019 else if (x(2).lt.delta) then
6023 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6025 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6026 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6028 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6029 & ddersc0(1),dersc(1))
6030 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6031 & ddersc0(3),dersc(3))
6033 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6035 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6036 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6037 & dersc0(2),esclocbi,dersc02)
6038 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6043 call splinthet(x(2),0.5d0*delta,ss,ssd)
6045 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6047 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6048 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6050 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6051 c write (iout,*) escloci
6053 call enesc(x,escloci,dersc,ddummy,.false.)
6056 escloc=escloc+escloci
6057 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6058 & 'escloc',i,escloci
6059 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6061 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6063 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6064 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6069 C---------------------------------------------------------------------------
6070 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6071 implicit real*8 (a-h,o-z)
6072 include 'DIMENSIONS'
6073 include 'COMMON.GEO'
6074 include 'COMMON.LOCAL'
6075 include 'COMMON.IOUNITS'
6076 common /sccalc/ time11,time12,time112,theti,it,nlobit
6077 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6078 double precision contr(maxlob,-1:1)
6080 c write (iout,*) 'it=',it,' nlobit=',nlobit
6084 if (mixed) ddersc(j)=0.0d0
6088 C Because of periodicity of the dependence of the SC energy in omega we have
6089 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6090 C To avoid underflows, first compute & store the exponents.
6098 z(k)=x(k)-censc(k,j,it)
6103 Axk=Axk+gaussc(l,k,j,it)*z(l)
6109 expfac=expfac+Ax(k,j,iii)*z(k)
6117 C As in the case of ebend, we want to avoid underflows in exponentiation and
6118 C subsequent NaNs and INFs in energy calculation.
6119 C Find the largest exponent
6123 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6127 cd print *,'it=',it,' emin=',emin
6129 C Compute the contribution to SC energy and derivatives
6134 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6135 if(adexp.ne.adexp) adexp=1.0
6138 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6140 cd print *,'j=',j,' expfac=',expfac
6141 escloc_i=escloc_i+expfac
6143 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6147 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6148 & +gaussc(k,2,j,it))*expfac
6155 dersc(1)=dersc(1)/cos(theti)**2
6156 ddersc(1)=ddersc(1)/cos(theti)**2
6159 escloci=-(dlog(escloc_i)-emin)
6161 dersc(j)=dersc(j)/escloc_i
6165 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6170 C------------------------------------------------------------------------------
6171 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6172 implicit real*8 (a-h,o-z)
6173 include 'DIMENSIONS'
6174 include 'COMMON.GEO'
6175 include 'COMMON.LOCAL'
6176 include 'COMMON.IOUNITS'
6177 common /sccalc/ time11,time12,time112,theti,it,nlobit
6178 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6179 double precision contr(maxlob)
6190 z(k)=x(k)-censc(k,j,it)
6196 Axk=Axk+gaussc(l,k,j,it)*z(l)
6202 expfac=expfac+Ax(k,j)*z(k)
6207 C As in the case of ebend, we want to avoid underflows in exponentiation and
6208 C subsequent NaNs and INFs in energy calculation.
6209 C Find the largest exponent
6212 if (emin.gt.contr(j)) emin=contr(j)
6216 C Compute the contribution to SC energy and derivatives
6220 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6221 escloc_i=escloc_i+expfac
6223 dersc(k)=dersc(k)+Ax(k,j)*expfac
6225 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6226 & +gaussc(1,2,j,it))*expfac
6230 dersc(1)=dersc(1)/cos(theti)**2
6231 dersc12=dersc12/cos(theti)**2
6232 escloci=-(dlog(escloc_i)-emin)
6234 dersc(j)=dersc(j)/escloc_i
6236 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6240 c----------------------------------------------------------------------------------
6241 subroutine esc(escloc)
6242 C Calculate the local energy of a side chain and its derivatives in the
6243 C corresponding virtual-bond valence angles THETA and the spherical angles
6244 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6245 C added by Urszula Kozlowska. 07/11/2007
6247 implicit real*8 (a-h,o-z)
6248 include 'DIMENSIONS'
6249 include 'COMMON.GEO'
6250 include 'COMMON.LOCAL'
6251 include 'COMMON.VAR'
6252 include 'COMMON.SCROT'
6253 include 'COMMON.INTERACT'
6254 include 'COMMON.DERIV'
6255 include 'COMMON.CHAIN'
6256 include 'COMMON.IOUNITS'
6257 include 'COMMON.NAMES'
6258 include 'COMMON.FFIELD'
6259 include 'COMMON.CONTROL'
6260 include 'COMMON.VECTORS'
6261 double precision x_prime(3),y_prime(3),z_prime(3)
6262 & , sumene,dsc_i,dp2_i,x(65),
6263 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6264 & de_dxx,de_dyy,de_dzz,de_dt
6265 double precision s1_t,s1_6_t,s2_t,s2_6_t
6267 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6268 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6269 & dt_dCi(3),dt_dCi1(3)
6270 common /sccalc/ time11,time12,time112,theti,it,nlobit
6273 do i=loc_start,loc_end
6274 if (itype(i).eq.ntyp1) cycle
6275 costtab(i+1) =dcos(theta(i+1))
6276 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6277 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6278 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6279 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6280 cosfac=dsqrt(cosfac2)
6281 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6282 sinfac=dsqrt(sinfac2)
6284 if (it.eq.10) goto 1
6286 C Compute the axes of tghe local cartesian coordinates system; store in
6287 c x_prime, y_prime and z_prime
6294 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6295 C & dc_norm(3,i+nres)
6297 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6298 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6301 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6304 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6305 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6306 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6307 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6308 c & " xy",scalar(x_prime(1),y_prime(1)),
6309 c & " xz",scalar(x_prime(1),z_prime(1)),
6310 c & " yy",scalar(y_prime(1),y_prime(1)),
6311 c & " yz",scalar(y_prime(1),z_prime(1)),
6312 c & " zz",scalar(z_prime(1),z_prime(1))
6314 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6315 C to local coordinate system. Store in xx, yy, zz.
6321 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6322 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6323 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6330 C Compute the energy of the ith side cbain
6332 c write (2,*) "xx",xx," yy",yy," zz",zz
6335 x(j) = sc_parmin(j,it)
6338 Cc diagnostics - remove later
6340 yy1 = dsin(alph(2))*dcos(omeg(2))
6341 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6342 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6343 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6345 C," --- ", xx_w,yy_w,zz_w
6348 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6349 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6351 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6352 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6354 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6355 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6356 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6357 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6358 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6360 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6361 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6362 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6363 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6364 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6366 dsc_i = 0.743d0+x(61)
6368 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6369 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6370 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6371 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6372 s1=(1+x(63))/(0.1d0 + dscp1)
6373 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6374 s2=(1+x(65))/(0.1d0 + dscp2)
6375 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6376 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6377 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6378 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6380 c & dscp1,dscp2,sumene
6381 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6382 escloc = escloc + sumene
6383 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6385 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6390 C This section to check the numerical derivatives of the energy of ith side
6391 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6392 C #define DEBUG in the code to turn it on.
6394 write (2,*) "sumene =",sumene
6398 write (2,*) xx,yy,zz
6399 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6400 de_dxx_num=(sumenep-sumene)/aincr
6402 write (2,*) "xx+ sumene from enesc=",sumenep
6405 write (2,*) xx,yy,zz
6406 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6407 de_dyy_num=(sumenep-sumene)/aincr
6409 write (2,*) "yy+ sumene from enesc=",sumenep
6412 write (2,*) xx,yy,zz
6413 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6414 de_dzz_num=(sumenep-sumene)/aincr
6416 write (2,*) "zz+ sumene from enesc=",sumenep
6417 costsave=cost2tab(i+1)
6418 sintsave=sint2tab(i+1)
6419 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6420 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6421 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6422 de_dt_num=(sumenep-sumene)/aincr
6423 write (2,*) " t+ sumene from enesc=",sumenep
6424 cost2tab(i+1)=costsave
6425 sint2tab(i+1)=sintsave
6426 C End of diagnostics section.
6429 C Compute the gradient of esc
6431 c zz=zz*dsign(1.0,dfloat(itype(i)))
6432 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6433 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6434 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6435 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6436 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6437 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6438 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6439 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6440 pom1=(sumene3*sint2tab(i+1)+sumene1)
6441 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6442 pom2=(sumene4*cost2tab(i+1)+sumene2)
6443 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6444 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6445 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6446 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6448 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6449 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6450 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6452 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6453 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6454 & +(pom1+pom2)*pom_dx
6456 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6459 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6460 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6461 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6463 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6464 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6465 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6466 & +x(59)*zz**2 +x(60)*xx*zz
6467 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6468 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6469 & +(pom1-pom2)*pom_dy
6471 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6474 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6475 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6476 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6477 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6478 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6479 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6480 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6481 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6483 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6486 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6487 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6488 & +pom1*pom_dt1+pom2*pom_dt2
6490 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6495 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6496 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6497 cosfac2xx=cosfac2*xx
6498 sinfac2yy=sinfac2*yy
6500 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6502 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6504 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6505 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6506 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6507 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6508 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6509 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6510 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6511 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6512 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6513 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6517 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6518 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6519 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6520 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6523 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6524 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6525 dZZ_XYZ(k)=vbld_inv(i+nres)*
6526 & (z_prime(k)-zz*dC_norm(k,i+nres))
6528 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6529 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6533 dXX_Ctab(k,i)=dXX_Ci(k)
6534 dXX_C1tab(k,i)=dXX_Ci1(k)
6535 dYY_Ctab(k,i)=dYY_Ci(k)
6536 dYY_C1tab(k,i)=dYY_Ci1(k)
6537 dZZ_Ctab(k,i)=dZZ_Ci(k)
6538 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6539 dXX_XYZtab(k,i)=dXX_XYZ(k)
6540 dYY_XYZtab(k,i)=dYY_XYZ(k)
6541 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6545 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6546 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6547 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6548 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6549 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6551 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6552 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6553 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6554 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6555 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6556 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6557 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6558 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6560 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6561 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6563 C to check gradient call subroutine check_grad
6569 c------------------------------------------------------------------------------
6570 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6572 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6573 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6574 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6575 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6577 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6578 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6580 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6581 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6582 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6583 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6584 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6586 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6587 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6588 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6589 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6590 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6592 dsc_i = 0.743d0+x(61)
6594 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6595 & *(xx*cost2+yy*sint2))
6596 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6597 & *(xx*cost2-yy*sint2))
6598 s1=(1+x(63))/(0.1d0 + dscp1)
6599 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6600 s2=(1+x(65))/(0.1d0 + dscp2)
6601 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6602 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6603 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6608 c------------------------------------------------------------------------------
6609 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6611 C This procedure calculates two-body contact function g(rij) and its derivative:
6614 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6617 C where x=(rij-r0ij)/delta
6619 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6622 double precision rij,r0ij,eps0ij,fcont,fprimcont
6623 double precision x,x2,x4,delta
6627 if (x.lt.-1.0D0) then
6630 else if (x.le.1.0D0) then
6633 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6634 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6641 c------------------------------------------------------------------------------
6642 subroutine splinthet(theti,delta,ss,ssder)
6643 implicit real*8 (a-h,o-z)
6644 include 'DIMENSIONS'
6645 include 'COMMON.VAR'
6646 include 'COMMON.GEO'
6649 if (theti.gt.pipol) then
6650 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6652 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6657 c------------------------------------------------------------------------------
6658 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6660 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6661 double precision ksi,ksi2,ksi3,a1,a2,a3
6662 a1=fprim0*delta/(f1-f0)
6668 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6669 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6672 c------------------------------------------------------------------------------
6673 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6675 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6676 double precision ksi,ksi2,ksi3,a1,a2,a3
6681 a2=3*(f1x-f0x)-2*fprim0x*delta
6682 a3=fprim0x*delta-2*(f1x-f0x)
6683 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6686 C-----------------------------------------------------------------------------
6688 C-----------------------------------------------------------------------------
6689 subroutine etor(etors,edihcnstr)
6690 implicit real*8 (a-h,o-z)
6691 include 'DIMENSIONS'
6692 include 'COMMON.VAR'
6693 include 'COMMON.GEO'
6694 include 'COMMON.LOCAL'
6695 include 'COMMON.TORSION'
6696 include 'COMMON.INTERACT'
6697 include 'COMMON.DERIV'
6698 include 'COMMON.CHAIN'
6699 include 'COMMON.NAMES'
6700 include 'COMMON.IOUNITS'
6701 include 'COMMON.FFIELD'
6702 include 'COMMON.TORCNSTR'
6703 include 'COMMON.CONTROL'
6705 C Set lprn=.true. for debugging
6709 do i=iphi_start,iphi_end
6711 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6712 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6713 itori=itortyp(itype(i-2))
6714 itori1=itortyp(itype(i-1))
6717 C Proline-Proline pair is a special case...
6718 if (itori.eq.3 .and. itori1.eq.3) then
6719 if (phii.gt.-dwapi3) then
6721 fac=1.0D0/(1.0D0-cosphi)
6722 etorsi=v1(1,3,3)*fac
6723 etorsi=etorsi+etorsi
6724 etors=etors+etorsi-v1(1,3,3)
6725 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6726 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6729 v1ij=v1(j+1,itori,itori1)
6730 v2ij=v2(j+1,itori,itori1)
6733 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6734 if (energy_dec) etors_ii=etors_ii+
6735 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6736 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6740 v1ij=v1(j,itori,itori1)
6741 v2ij=v2(j,itori,itori1)
6744 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6745 if (energy_dec) etors_ii=etors_ii+
6746 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6747 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6750 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6753 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6754 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6755 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6756 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6757 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6759 ! 6/20/98 - dihedral angle constraints
6762 itori=idih_constr(i)
6765 if (difi.gt.drange(i)) then
6767 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6768 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6769 else if (difi.lt.-drange(i)) then
6771 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6772 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6774 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6775 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6777 ! write (iout,*) 'edihcnstr',edihcnstr
6780 c------------------------------------------------------------------------------
6781 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
6782 subroutine e_modeller(ehomology_constr)
6783 ehomology_constr=0.0d0
6784 write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
6787 C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
6789 c------------------------------------------------------------------------------
6790 subroutine etor_d(etors_d)
6794 c----------------------------------------------------------------------------
6796 subroutine etor(etors,edihcnstr)
6797 implicit real*8 (a-h,o-z)
6798 include 'DIMENSIONS'
6799 include 'COMMON.VAR'
6800 include 'COMMON.GEO'
6801 include 'COMMON.LOCAL'
6802 include 'COMMON.TORSION'
6803 include 'COMMON.INTERACT'
6804 include 'COMMON.DERIV'
6805 include 'COMMON.CHAIN'
6806 include 'COMMON.NAMES'
6807 include 'COMMON.IOUNITS'
6808 include 'COMMON.FFIELD'
6809 include 'COMMON.TORCNSTR'
6810 include 'COMMON.CONTROL'
6812 C Set lprn=.true. for debugging
6816 do i=iphi_start,iphi_end
6817 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6818 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6819 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6820 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6821 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6822 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6823 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6824 C For introducing the NH3+ and COO- group please check the etor_d for reference
6827 if (iabs(itype(i)).eq.20) then
6832 itori=itortyp(itype(i-2))
6833 itori1=itortyp(itype(i-1))
6836 C Regular cosine and sine terms
6837 do j=1,nterm(itori,itori1,iblock)
6838 v1ij=v1(j,itori,itori1,iblock)
6839 v2ij=v2(j,itori,itori1,iblock)
6842 etors=etors+v1ij*cosphi+v2ij*sinphi
6843 if (energy_dec) etors_ii=etors_ii+
6844 & v1ij*cosphi+v2ij*sinphi
6845 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6849 C E = SUM ----------------------------------- - v1
6850 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6852 cosphi=dcos(0.5d0*phii)
6853 sinphi=dsin(0.5d0*phii)
6854 do j=1,nlor(itori,itori1,iblock)
6855 vl1ij=vlor1(j,itori,itori1)
6856 vl2ij=vlor2(j,itori,itori1)
6857 vl3ij=vlor3(j,itori,itori1)
6858 pom=vl2ij*cosphi+vl3ij*sinphi
6859 pom1=1.0d0/(pom*pom+1.0d0)
6860 etors=etors+vl1ij*pom1
6861 if (energy_dec) etors_ii=etors_ii+
6864 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6866 C Subtract the constant term
6867 etors=etors-v0(itori,itori1,iblock)
6868 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6869 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6871 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6872 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6873 & (v1(j,itori,itori1,iblock),j=1,6),
6874 & (v2(j,itori,itori1,iblock),j=1,6)
6875 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6876 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6878 ! 6/20/98 - dihedral angle constraints
6880 c do i=1,ndih_constr
6881 do i=idihconstr_start,idihconstr_end
6882 itori=idih_constr(i)
6884 difi=pinorm(phii-phi0(i))
6885 if (difi.gt.drange(i)) then
6887 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6888 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6889 else if (difi.lt.-drange(i)) then
6891 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6892 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6896 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6897 cd & rad2deg*phi0(i), rad2deg*drange(i),
6898 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6900 cd write (iout,*) 'edihcnstr',edihcnstr
6903 c----------------------------------------------------------------------------
6904 c MODELLER restraint function
6905 subroutine e_modeller(ehomology_constr)
6906 implicit real*8 (a-h,o-z)
6907 include 'DIMENSIONS'
6909 integer nnn, i, j, k, ki, irec, l
6910 integer katy, odleglosci, test7
6911 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
6913 real*8 distance(max_template),distancek(max_template),
6914 & min_odl,godl(max_template),dih_diff(max_template)
6917 c FP - 30/10/2014 Temporary specifications for homology restraints
6919 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
6921 double precision, dimension (maxres) :: guscdiff,usc_diff
6922 double precision, dimension (max_template) ::
6923 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
6927 include 'COMMON.SBRIDGE'
6928 include 'COMMON.CHAIN'
6929 include 'COMMON.GEO'
6930 include 'COMMON.DERIV'
6931 include 'COMMON.LOCAL'
6932 include 'COMMON.INTERACT'
6933 include 'COMMON.VAR'
6934 include 'COMMON.IOUNITS'
6936 include 'COMMON.CONTROL'
6938 c From subroutine Econstr_back
6940 include 'COMMON.NAMES'
6941 include 'COMMON.TIME1'
6946 distancek(i)=9999999.9
6952 c Pseudo-energy and gradient from homology restraints (MODELLER-like
6954 C AL 5/2/14 - Introduce list of restraints
6955 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
6957 write(iout,*) "------- dist restrs start -------"
6959 do ii = link_start_homo,link_end_homo
6963 c write (iout,*) "dij(",i,j,") =",dij
6965 do k=1,constr_homology
6966 c write(iout,*) ii,k,i,j,l_homo(k,ii),dij,odl(k,ii)
6967 if(.not.l_homo(k,ii)) then
6971 distance(k)=odl(k,ii)-dij
6972 c write (iout,*) "distance(",k,") =",distance(k)
6974 c For Gaussian-type Urestr
6976 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
6977 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
6978 c write (iout,*) "distancek(",k,") =",distancek(k)
6979 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
6981 c For Lorentzian-type Urestr
6983 if (waga_dist.lt.0.0d0) then
6984 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
6985 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
6986 & (distance(k)**2+sigma_odlir(k,ii)**2))
6990 c min_odl=minval(distancek)
6991 do kk=1,constr_homology
6992 if(l_homo(kk,ii)) then
6993 min_odl=distancek(kk)
6997 do kk=1,constr_homology
6998 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
6999 & min_odl=distancek(kk)
7002 c write (iout,* )"min_odl",min_odl
7004 write (iout,*) "ij dij",i,j,dij
7005 write (iout,*) "distance",(distance(k),k=1,constr_homology)
7006 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
7007 write (iout,* )"min_odl",min_odl
7012 if (waga_dist.ge.0.0d0) then
7018 do k=1,constr_homology
7019 c Nie wiem po co to liczycie jeszcze raz!
7020 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
7021 c & (2*(sigma_odl(i,j,k))**2))
7022 if(.not.l_homo(k,ii)) cycle
7023 if (waga_dist.ge.0.0d0) then
7025 c For Gaussian-type Urestr
7027 godl(k)=dexp(-distancek(k)+min_odl)
7028 odleg2=odleg2+godl(k)
7030 c For Lorentzian-type Urestr
7033 odleg2=odleg2+distancek(k)
7036 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
7037 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
7038 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
7039 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
7042 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
7043 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
7045 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
7046 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
7048 if (waga_dist.ge.0.0d0) then
7050 c For Gaussian-type Urestr
7052 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
7054 c For Lorentzian-type Urestr
7057 odleg=odleg+odleg2/constr_homology
7060 c write (iout,*) "odleg",odleg ! sum of -ln-s
7063 c For Gaussian-type Urestr
7065 if (waga_dist.ge.0.0d0) sum_godl=odleg2
7067 do k=1,constr_homology
7068 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
7069 c & *waga_dist)+min_odl
7070 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
7072 if(.not.l_homo(k,ii)) cycle
7073 if (waga_dist.ge.0.0d0) then
7074 c For Gaussian-type Urestr
7076 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
7078 c For Lorentzian-type Urestr
7081 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
7082 & sigma_odlir(k,ii)**2)**2)
7084 sum_sgodl=sum_sgodl+sgodl
7086 c sgodl2=sgodl2+sgodl
7087 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
7088 c write(iout,*) "constr_homology=",constr_homology
7089 c write(iout,*) i, j, k, "TEST K"
7091 if (waga_dist.ge.0.0d0) then
7093 c For Gaussian-type Urestr
7095 grad_odl3=waga_homology(iset)*waga_dist
7096 & *sum_sgodl/(sum_godl*dij)
7098 c For Lorentzian-type Urestr
7101 c Original grad expr modified by analogy w Gaussian-type Urestr grad
7102 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
7103 grad_odl3=-waga_homology(iset)*waga_dist*
7104 & sum_sgodl/(constr_homology*dij)
7107 c grad_odl3=sum_sgodl/(sum_godl*dij)
7110 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
7111 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
7112 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
7114 ccc write(iout,*) godl, sgodl, grad_odl3
7116 c grad_odl=grad_odl+grad_odl3
7119 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
7120 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
7121 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
7122 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
7123 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
7124 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
7125 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
7126 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
7127 c if (i.eq.25.and.j.eq.27) then
7128 c write(iout,*) "jik",jik,"i",i,"j",j
7129 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
7130 c write(iout,*) "grad_odl3",grad_odl3
7131 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
7132 c write(iout,*) "ggodl",ggodl
7133 c write(iout,*) "ghpbc(",jik,i,")",
7134 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
7138 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
7139 ccc & dLOG(odleg2),"-odleg=", -odleg
7141 enddo ! ii-loop for dist
7143 write(iout,*) "------- dist restrs end -------"
7144 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
7145 c & waga_d.eq.1.0d0) call sum_gradient
7147 c Pseudo-energy and gradient from dihedral-angle restraints from
7148 c homology templates
7149 c write (iout,*) "End of distance loop"
7152 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
7154 write(iout,*) "------- dih restrs start -------"
7155 do i=idihconstr_start_homo,idihconstr_end_homo
7156 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
7159 do i=idihconstr_start_homo,idihconstr_end_homo
7161 c betai=beta(i,i+1,i+2,i+3)
7163 c write (iout,*) "betai =",betai
7164 do k=1,constr_homology
7165 dih_diff(k)=pinorm(dih(k,i)-betai)
7166 cd write (iout,'(a8,2i4,2f15.8)') "dih_diff",i,k,dih_diff(k)
7167 cd & ,sigma_dih(k,i)
7168 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
7169 c & -(6.28318-dih_diff(i,k))
7170 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
7171 c & 6.28318+dih_diff(i,k)
7173 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
7175 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
7177 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
7180 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
7183 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
7184 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
7186 write (iout,*) "i",i," betai",betai," kat2",kat2
7187 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
7189 if (kat2.le.1.0d-14) cycle
7190 kat=kat-dLOG(kat2/constr_homology)
7191 c write (iout,*) "kat",kat ! sum of -ln-s
7193 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
7194 ccc & dLOG(kat2), "-kat=", -kat
7196 c ----------------------------------------------------------------------
7198 c ----------------------------------------------------------------------
7202 do k=1,constr_homology
7204 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
7206 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i) ! waga_angle rmvd
7208 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
7209 sum_sgdih=sum_sgdih+sgdih
7211 c grad_dih3=sum_sgdih/sum_gdih
7212 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
7214 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
7215 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
7216 ccc & gloc(nphi+i-3,icg)
7217 gloc(i-3,icg)=gloc(i-3,icg)+grad_dih3
7219 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
7221 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
7222 ccc & gloc(nphi+i-3,icg)
7224 enddo ! i-loop for dih
7226 write(iout,*) "------- dih restrs end -------"
7229 c Pseudo-energy and gradient for theta angle restraints from
7230 c homology templates
7231 c FP 01/15 - inserted from econstr_local_test.F, loop structure
7235 c For constr_homology reference structures (FP)
7237 c Uconst_back_tot=0.0d0
7240 c Econstr_back legacy
7242 c do i=ithet_start,ithet_end
7245 c do i=loc_start,loc_end
7248 duscdiffx(j,i)=0.0d0
7253 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
7254 c write (iout,*) "waga_theta",waga_theta
7255 if (waga_theta.gt.0.0d0) then
7257 write (iout,*) "usampl",usampl
7258 write(iout,*) "------- theta restrs start -------"
7259 c do i=ithet_start,ithet_end
7260 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
7263 c write (iout,*) "maxres",maxres,"nres",nres
7265 do i=ithet_start,ithet_end
7268 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
7270 c Deviation of theta angles wrt constr_homology ref structures
7272 utheta_i=0.0d0 ! argument of Gaussian for single k
7273 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
7274 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
7275 c over residues in a fragment
7276 c write (iout,*) "theta(",i,")=",theta(i)
7277 do k=1,constr_homology
7279 c dtheta_i=theta(j)-thetaref(j,iref)
7280 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
7281 theta_diff(k)=thetatpl(k,i)-theta(i)
7282 cd write (iout,'(a8,2i4,2f15.8)') "theta_diff",i,k,theta_diff(k)
7283 cd & ,sigma_theta(k,i)
7286 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
7287 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
7288 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
7289 gutheta_i=gutheta_i+gtheta(k) ! Sum of Gaussians (pk)
7290 c Gradient for single Gaussian restraint in subr Econstr_back
7291 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
7294 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
7295 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
7298 c Gradient for multiple Gaussian restraint
7299 sum_gtheta=gutheta_i
7301 do k=1,constr_homology
7302 c New generalized expr for multiple Gaussian from Econstr_back
7303 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
7305 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
7306 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
7308 c Final value of gradient using same var as in Econstr_back
7309 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)
7310 & +sum_sgtheta/sum_gtheta*waga_theta
7311 & *waga_homology(iset)
7312 c dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
7313 c & *waga_homology(iset)
7314 c dutheta(i)=sum_sgtheta/sum_gtheta
7316 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
7317 Eval=Eval-dLOG(gutheta_i/constr_homology)
7318 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
7319 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
7320 c Uconst_back=Uconst_back+utheta(i)
7321 enddo ! (i-loop for theta)
7323 write(iout,*) "------- theta restrs end -------"
7327 c Deviation of local SC geometry
7329 c Separation of two i-loops (instructed by AL - 11/3/2014)
7331 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
7332 c write (iout,*) "waga_d",waga_d
7335 write(iout,*) "------- SC restrs start -------"
7336 write (iout,*) "Initial duscdiff,duscdiffx"
7337 do i=loc_start,loc_end
7338 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
7339 & (duscdiffx(jik,i),jik=1,3)
7342 do i=loc_start,loc_end
7343 usc_diff_i=0.0d0 ! argument of Gaussian for single k
7344 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
7345 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
7346 c write(iout,*) "xxtab, yytab, zztab"
7347 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
7348 do k=1,constr_homology
7350 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
7351 c Original sign inverted for calc of gradients (s. Econstr_back)
7352 dyy=-yytpl(k,i)+yytab(i) ! ibid y
7353 dzz=-zztpl(k,i)+zztab(i) ! ibid z
7354 c write(iout,*) "dxx, dyy, dzz"
7355 cd write(iout,'(2i5,4f8.2)') k,i,dxx,dyy,dzz,sigma_d(k,i)
7357 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
7358 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
7359 c uscdiffk(k)=usc_diff(i)
7360 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
7361 c write(iout,*) "i",i," k",k," sigma_d",sigma_d(k,i),
7362 c & " guscdiff2",guscdiff2(k)
7363 guscdiff(i)=guscdiff(i)+guscdiff2(k) !Sum of Gaussians (pk)
7364 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
7365 c & xxref(j),yyref(j),zzref(j)
7370 c Generalized expression for multiple Gaussian acc to that for a single
7371 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
7373 c Original implementation
7374 c sum_guscdiff=guscdiff(i)
7376 c sum_sguscdiff=0.0d0
7377 c do k=1,constr_homology
7378 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
7379 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
7380 c sum_sguscdiff=sum_sguscdiff+sguscdiff
7383 c Implementation of new expressions for gradient (Jan. 2015)
7385 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
7386 do k=1,constr_homology
7388 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
7389 c before. Now the drivatives should be correct
7391 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
7392 c Original sign inverted for calc of gradients (s. Econstr_back)
7393 dyy=-yytpl(k,i)+yytab(i) ! ibid y
7394 dzz=-zztpl(k,i)+zztab(i) ! ibid z
7396 c New implementation
7398 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
7399 & sigma_d(k,i) ! for the grad wrt r'
7400 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
7403 c New implementation
7404 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
7406 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
7407 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
7408 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
7409 duscdiff(jik,i)=duscdiff(jik,i)+
7410 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
7411 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
7412 duscdiffx(jik,i)=duscdiffx(jik,i)+
7413 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
7414 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
7417 write(iout,*) "jik",jik,"i",i
7418 write(iout,*) "dxx, dyy, dzz"
7419 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
7420 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
7421 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
7422 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
7423 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
7424 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
7425 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
7426 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
7427 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
7428 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
7429 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
7430 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
7431 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
7432 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
7433 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
7439 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
7440 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
7442 c write (iout,*) i," uscdiff",uscdiff(i)
7444 c Put together deviations from local geometry
7446 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
7447 c & wfrag_back(3,i,iset)*uscdiff(i)
7448 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
7449 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
7450 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
7451 c Uconst_back=Uconst_back+usc_diff(i)
7453 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
7455 c New implment: multiplied by sum_sguscdiff
7458 enddo ! (i-loop for dscdiff)
7463 write(iout,*) "------- SC restrs end -------"
7464 write (iout,*) "------ After SC loop in e_modeller ------"
7465 do i=loc_start,loc_end
7466 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
7467 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
7469 if (waga_theta.eq.1.0d0) then
7470 write (iout,*) "in e_modeller after SC restr end: dutheta"
7471 do i=ithet_start,ithet_end
7472 write (iout,*) i,dutheta(i)
7475 if (waga_d.eq.1.0d0) then
7476 write (iout,*) "e_modeller after SC loop: duscdiff/x"
7478 write (iout,*) i,(duscdiff(j,i),j=1,3)
7479 write (iout,*) i,(duscdiffx(j,i),j=1,3)
7484 c Total energy from homology restraints
7486 write (iout,*) "odleg",odleg," kat",kat
7489 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
7491 c ehomology_constr=odleg+kat
7493 c For Lorentzian-type Urestr
7496 if (waga_dist.ge.0.0d0) then
7498 c For Gaussian-type Urestr
7500 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
7501 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
7502 c write (iout,*) "ehomology_constr=",ehomology_constr
7505 c For Lorentzian-type Urestr
7507 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
7508 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
7509 c write (iout,*) "ehomology_constr=",ehomology_constr
7512 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
7513 & "Eval",waga_theta,eval,
7514 & "Erot",waga_d,Erot
7515 write (iout,*) "ehomology_constr",ehomology_constr
7521 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
7522 747 format(a12,i4,i4,i4,f8.3,f8.3)
7523 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
7524 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
7525 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
7526 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
7529 c------------------------------------------------------------------------------
7530 subroutine etor_d(etors_d)
7531 C 6/23/01 Compute double torsional energy
7532 implicit real*8 (a-h,o-z)
7533 include 'DIMENSIONS'
7534 include 'COMMON.VAR'
7535 include 'COMMON.GEO'
7536 include 'COMMON.LOCAL'
7537 include 'COMMON.TORSION'
7538 include 'COMMON.INTERACT'
7539 include 'COMMON.DERIV'
7540 include 'COMMON.CHAIN'
7541 include 'COMMON.NAMES'
7542 include 'COMMON.IOUNITS'
7543 include 'COMMON.FFIELD'
7544 include 'COMMON.TORCNSTR'
7545 include 'COMMON.CONTROL'
7547 C Set lprn=.true. for debugging
7551 c write(iout,*) "a tu??"
7552 do i=iphid_start,iphid_end
7553 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7554 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7555 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7556 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7557 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7558 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7559 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7560 & (itype(i+1).eq.ntyp1)) cycle
7561 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7563 itori=itortyp(itype(i-2))
7564 itori1=itortyp(itype(i-1))
7565 itori2=itortyp(itype(i))
7571 if (iabs(itype(i+1)).eq.20) iblock=2
7572 C Iblock=2 Proline type
7573 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7574 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7575 C if (itype(i+1).eq.ntyp1) iblock=3
7576 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7577 C IS or IS NOT need for this
7578 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7579 C is (itype(i-3).eq.ntyp1) ntblock=2
7580 C ntblock is N-terminal blocking group
7582 C Regular cosine and sine terms
7583 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7584 C Example of changes for NH3+ blocking group
7585 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7586 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7587 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7588 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7589 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7590 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7591 cosphi1=dcos(j*phii)
7592 sinphi1=dsin(j*phii)
7593 cosphi2=dcos(j*phii1)
7594 sinphi2=dsin(j*phii1)
7595 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7596 & v2cij*cosphi2+v2sij*sinphi2
7597 if (energy_dec) etors_d_ii=etors_d_ii+
7598 & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
7599 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7600 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7602 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7604 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7605 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7606 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7607 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7608 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7609 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7610 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7611 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7612 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7613 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7614 if (energy_dec) etors_d_ii=etors_d_ii+
7615 & v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7616 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7617 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7618 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7619 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7620 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7623 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7624 & 'etor_d',i,etors_d_ii
7625 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7626 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7631 c------------------------------------------------------------------------------
7632 subroutine eback_sc_corr(esccor)
7633 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7634 c conformational states; temporarily implemented as differences
7635 c between UNRES torsional potentials (dependent on three types of
7636 c residues) and the torsional potentials dependent on all 20 types
7637 c of residues computed from AM1 energy surfaces of terminally-blocked
7638 c amino-acid residues.
7639 implicit real*8 (a-h,o-z)
7640 include 'DIMENSIONS'
7641 include 'COMMON.VAR'
7642 include 'COMMON.GEO'
7643 include 'COMMON.LOCAL'
7644 include 'COMMON.TORSION'
7645 include 'COMMON.SCCOR'
7646 include 'COMMON.INTERACT'
7647 include 'COMMON.DERIV'
7648 include 'COMMON.CHAIN'
7649 include 'COMMON.NAMES'
7650 include 'COMMON.IOUNITS'
7651 include 'COMMON.FFIELD'
7652 include 'COMMON.CONTROL'
7654 C Set lprn=.true. for debugging
7657 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7659 do i=itau_start,itau_end
7660 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7661 isccori=isccortyp(itype(i-2))
7662 isccori1=isccortyp(itype(i-1))
7663 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7665 do intertyp=1,3 !intertyp
7667 cc Added 09 May 2012 (Adasko)
7668 cc Intertyp means interaction type of backbone mainchain correlation:
7669 c 1 = SC...Ca...Ca...Ca
7670 c 2 = Ca...Ca...Ca...SC
7671 c 3 = SC...Ca...Ca...SCi
7673 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7674 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7675 & (itype(i-1).eq.ntyp1)))
7676 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7677 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7678 & .or.(itype(i).eq.ntyp1)))
7679 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7680 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7681 & (itype(i-3).eq.ntyp1)))) cycle
7682 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7683 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7685 do j=1,nterm_sccor(isccori,isccori1)
7686 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7687 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7688 cosphi=dcos(j*tauangle(intertyp,i))
7689 sinphi=dsin(j*tauangle(intertyp,i))
7690 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
7691 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7692 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7694 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)')
7695 & 'esccor',i,intertyp,esccor_ii
7696 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7697 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7699 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7700 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
7701 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
7702 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7703 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7709 c----------------------------------------------------------------------------
7710 subroutine multibody(ecorr)
7711 C This subroutine calculates multi-body contributions to energy following
7712 C the idea of Skolnick et al. If side chains I and J make a contact and
7713 C at the same time side chains I+1 and J+1 make a contact, an extra
7714 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7715 implicit real*8 (a-h,o-z)
7716 include 'DIMENSIONS'
7717 include 'COMMON.IOUNITS'
7718 include 'COMMON.DERIV'
7719 include 'COMMON.INTERACT'
7720 include 'COMMON.CONTACTS'
7721 double precision gx(3),gx1(3)
7724 C Set lprn=.true. for debugging
7728 write (iout,'(a)') 'Contact function values:'
7730 write (iout,'(i2,20(1x,i2,f10.5))')
7731 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7746 num_conti=num_cont(i)
7747 num_conti1=num_cont(i1)
7752 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7753 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7754 cd & ' ishift=',ishift
7755 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7756 C The system gains extra energy.
7757 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7758 endif ! j1==j+-ishift
7767 c------------------------------------------------------------------------------
7768 double precision function esccorr(i,j,k,l,jj,kk)
7769 implicit real*8 (a-h,o-z)
7770 include 'DIMENSIONS'
7771 include 'COMMON.IOUNITS'
7772 include 'COMMON.DERIV'
7773 include 'COMMON.INTERACT'
7774 include 'COMMON.CONTACTS'
7775 double precision gx(3),gx1(3)
7780 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7781 C Calculate the multi-body contribution to energy.
7782 C Calculate multi-body contributions to the gradient.
7783 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7784 cd & k,l,(gacont(m,kk,k),m=1,3)
7786 gx(m) =ekl*gacont(m,jj,i)
7787 gx1(m)=eij*gacont(m,kk,k)
7788 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7789 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7790 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7791 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7795 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7800 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7806 c------------------------------------------------------------------------------
7807 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7808 C This subroutine calculates multi-body contributions to hydrogen-bonding
7809 implicit real*8 (a-h,o-z)
7810 include 'DIMENSIONS'
7811 include 'COMMON.IOUNITS'
7814 parameter (max_cont=maxconts)
7815 parameter (max_dim=26)
7816 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7817 double precision zapas(max_dim,maxconts,max_fg_procs),
7818 & zapas_recv(max_dim,maxconts,max_fg_procs)
7819 common /przechowalnia/ zapas
7820 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7821 & status_array(MPI_STATUS_SIZE,maxconts*2)
7823 include 'COMMON.SETUP'
7824 include 'COMMON.FFIELD'
7825 include 'COMMON.DERIV'
7826 include 'COMMON.INTERACT'
7827 include 'COMMON.CONTACTS'
7828 include 'COMMON.CONTROL'
7829 include 'COMMON.LOCAL'
7830 double precision gx(3),gx1(3),time00
7833 C Set lprn=.true. for debugging
7838 if (nfgtasks.le.1) goto 30
7840 write (iout,'(a)') 'Contact function values before RECEIVE:'
7842 write (iout,'(2i3,50(1x,i2,f5.2))')
7843 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7844 & j=1,num_cont_hb(i))
7848 do i=1,ntask_cont_from
7851 do i=1,ntask_cont_to
7854 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7856 C Make the list of contacts to send to send to other procesors
7857 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7859 do i=iturn3_start,iturn3_end
7860 c write (iout,*) "make contact list turn3",i," num_cont",
7862 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7864 do i=iturn4_start,iturn4_end
7865 c write (iout,*) "make contact list turn4",i," num_cont",
7867 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7871 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7873 do j=1,num_cont_hb(i)
7876 iproc=iint_sent_local(k,jjc,ii)
7877 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7878 if (iproc.gt.0) then
7879 ncont_sent(iproc)=ncont_sent(iproc)+1
7880 nn=ncont_sent(iproc)
7882 zapas(2,nn,iproc)=jjc
7883 zapas(3,nn,iproc)=facont_hb(j,i)
7884 zapas(4,nn,iproc)=ees0p(j,i)
7885 zapas(5,nn,iproc)=ees0m(j,i)
7886 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7887 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7888 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7889 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7890 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7891 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7892 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7893 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7894 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7895 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7896 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7897 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7898 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7899 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7900 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7901 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7902 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7903 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7904 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7905 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7906 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7913 & "Numbers of contacts to be sent to other processors",
7914 & (ncont_sent(i),i=1,ntask_cont_to)
7915 write (iout,*) "Contacts sent"
7916 do ii=1,ntask_cont_to
7918 iproc=itask_cont_to(ii)
7919 write (iout,*) nn," contacts to processor",iproc,
7920 & " of CONT_TO_COMM group"
7922 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7930 CorrelID1=nfgtasks+fg_rank+1
7932 C Receive the numbers of needed contacts from other processors
7933 do ii=1,ntask_cont_from
7934 iproc=itask_cont_from(ii)
7936 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7937 & FG_COMM,req(ireq),IERR)
7939 c write (iout,*) "IRECV ended"
7941 C Send the number of contacts needed by other processors
7942 do ii=1,ntask_cont_to
7943 iproc=itask_cont_to(ii)
7945 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7946 & FG_COMM,req(ireq),IERR)
7948 c write (iout,*) "ISEND ended"
7949 c write (iout,*) "number of requests (nn)",ireq
7952 & call MPI_Waitall(ireq,req,status_array,ierr)
7954 c & "Numbers of contacts to be received from other processors",
7955 c & (ncont_recv(i),i=1,ntask_cont_from)
7959 do ii=1,ntask_cont_from
7960 iproc=itask_cont_from(ii)
7962 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7963 c & " of CONT_TO_COMM group"
7967 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7968 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7969 c write (iout,*) "ireq,req",ireq,req(ireq)
7972 C Send the contacts to processors that need them
7973 do ii=1,ntask_cont_to
7974 iproc=itask_cont_to(ii)
7976 c write (iout,*) nn," contacts to processor",iproc,
7977 c & " of CONT_TO_COMM group"
7980 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7981 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7982 c write (iout,*) "ireq,req",ireq,req(ireq)
7984 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7988 c write (iout,*) "number of requests (contacts)",ireq
7989 c write (iout,*) "req",(req(i),i=1,4)
7992 & call MPI_Waitall(ireq,req,status_array,ierr)
7993 do iii=1,ntask_cont_from
7994 iproc=itask_cont_from(iii)
7997 write (iout,*) "Received",nn," contacts from processor",iproc,
7998 & " of CONT_FROM_COMM group"
8001 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8006 ii=zapas_recv(1,i,iii)
8007 c Flag the received contacts to prevent double-counting
8008 jj=-zapas_recv(2,i,iii)
8009 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8011 nnn=num_cont_hb(ii)+1
8014 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8015 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8016 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8017 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8018 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8019 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8020 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8021 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8022 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8023 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8024 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8025 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8026 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8027 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8028 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8029 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8030 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8031 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8032 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8033 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8034 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8035 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8036 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8037 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8042 write (iout,'(a)') 'Contact function values after receive:'
8044 write (iout,'(2i3,50(1x,i3,f5.2))')
8045 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8046 & j=1,num_cont_hb(i))
8053 write (iout,'(a)') 'Contact function values:'
8055 write (iout,'(2i3,50(1x,i3,f5.2))')
8056 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8057 & j=1,num_cont_hb(i))
8061 C Remove the loop below after debugging !!!
8068 C Calculate the local-electrostatic correlation terms
8069 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8071 num_conti=num_cont_hb(i)
8072 num_conti1=num_cont_hb(i+1)
8079 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8080 c & ' jj=',jj,' kk=',kk
8081 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8082 & .or. j.lt.0 .and. j1.gt.0) .and.
8083 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8084 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8085 C The system gains extra energy.
8086 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8087 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
8088 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
8090 else if (j1.eq.j) then
8091 C Contacts I-J and I-(J+1) occur simultaneously.
8092 C The system loses extra energy.
8093 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8098 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8099 c & ' jj=',jj,' kk=',kk
8101 C Contacts I-J and (I+1)-J occur simultaneously.
8102 C The system loses extra energy.
8103 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8110 c------------------------------------------------------------------------------
8111 subroutine add_hb_contact(ii,jj,itask)
8112 implicit real*8 (a-h,o-z)
8113 include "DIMENSIONS"
8114 include "COMMON.IOUNITS"
8117 parameter (max_cont=maxconts)
8118 parameter (max_dim=26)
8119 include "COMMON.CONTACTS"
8120 double precision zapas(max_dim,maxconts,max_fg_procs),
8121 & zapas_recv(max_dim,maxconts,max_fg_procs)
8122 common /przechowalnia/ zapas
8123 integer i,j,ii,jj,iproc,itask(4),nn
8124 c write (iout,*) "itask",itask
8127 if (iproc.gt.0) then
8128 do j=1,num_cont_hb(ii)
8130 c write (iout,*) "i",ii," j",jj," jjc",jjc
8132 ncont_sent(iproc)=ncont_sent(iproc)+1
8133 nn=ncont_sent(iproc)
8134 zapas(1,nn,iproc)=ii
8135 zapas(2,nn,iproc)=jjc
8136 zapas(3,nn,iproc)=facont_hb(j,ii)
8137 zapas(4,nn,iproc)=ees0p(j,ii)
8138 zapas(5,nn,iproc)=ees0m(j,ii)
8139 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8140 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8141 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8142 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8143 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8144 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8145 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8146 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8147 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8148 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8149 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8150 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8151 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8152 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8153 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8154 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8155 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8156 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8157 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8158 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8159 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8167 c------------------------------------------------------------------------------
8168 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8170 C This subroutine calculates multi-body contributions to hydrogen-bonding
8171 implicit real*8 (a-h,o-z)
8172 include 'DIMENSIONS'
8173 include 'COMMON.IOUNITS'
8176 parameter (max_cont=maxconts)
8177 parameter (max_dim=70)
8178 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8179 double precision zapas(max_dim,maxconts,max_fg_procs),
8180 & zapas_recv(max_dim,maxconts,max_fg_procs)
8181 common /przechowalnia/ zapas
8182 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8183 & status_array(MPI_STATUS_SIZE,maxconts*2)
8185 include 'COMMON.SETUP'
8186 include 'COMMON.FFIELD'
8187 include 'COMMON.DERIV'
8188 include 'COMMON.LOCAL'
8189 include 'COMMON.INTERACT'
8190 include 'COMMON.CONTACTS'
8191 include 'COMMON.CHAIN'
8192 include 'COMMON.CONTROL'
8193 double precision gx(3),gx1(3)
8194 integer num_cont_hb_old(maxres)
8196 double precision eello4,eello5,eelo6,eello_turn6
8197 external eello4,eello5,eello6,eello_turn6
8198 C Set lprn=.true. for debugging
8203 num_cont_hb_old(i)=num_cont_hb(i)
8207 if (nfgtasks.le.1) goto 30
8209 write (iout,'(a)') 'Contact function values before RECEIVE:'
8211 write (iout,'(2i3,50(1x,i2,f5.2))')
8212 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8213 & j=1,num_cont_hb(i))
8217 do i=1,ntask_cont_from
8220 do i=1,ntask_cont_to
8223 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8225 C Make the list of contacts to send to send to other procesors
8226 do i=iturn3_start,iturn3_end
8227 c write (iout,*) "make contact list turn3",i," num_cont",
8229 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8231 do i=iturn4_start,iturn4_end
8232 c write (iout,*) "make contact list turn4",i," num_cont",
8234 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8238 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8240 do j=1,num_cont_hb(i)
8243 iproc=iint_sent_local(k,jjc,ii)
8244 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8245 if (iproc.ne.0) then
8246 ncont_sent(iproc)=ncont_sent(iproc)+1
8247 nn=ncont_sent(iproc)
8249 zapas(2,nn,iproc)=jjc
8250 zapas(3,nn,iproc)=d_cont(j,i)
8254 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8259 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8267 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8278 & "Numbers of contacts to be sent to other processors",
8279 & (ncont_sent(i),i=1,ntask_cont_to)
8280 write (iout,*) "Contacts sent"
8281 do ii=1,ntask_cont_to
8283 iproc=itask_cont_to(ii)
8284 write (iout,*) nn," contacts to processor",iproc,
8285 & " of CONT_TO_COMM group"
8287 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8295 CorrelID1=nfgtasks+fg_rank+1
8297 C Receive the numbers of needed contacts from other processors
8298 do ii=1,ntask_cont_from
8299 iproc=itask_cont_from(ii)
8301 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8302 & FG_COMM,req(ireq),IERR)
8304 c write (iout,*) "IRECV ended"
8306 C Send the number of contacts needed by other processors
8307 do ii=1,ntask_cont_to
8308 iproc=itask_cont_to(ii)
8310 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8311 & FG_COMM,req(ireq),IERR)
8313 c write (iout,*) "ISEND ended"
8314 c write (iout,*) "number of requests (nn)",ireq
8317 & call MPI_Waitall(ireq,req,status_array,ierr)
8319 c & "Numbers of contacts to be received from other processors",
8320 c & (ncont_recv(i),i=1,ntask_cont_from)
8324 do ii=1,ntask_cont_from
8325 iproc=itask_cont_from(ii)
8327 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8328 c & " of CONT_TO_COMM group"
8332 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8333 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8334 c write (iout,*) "ireq,req",ireq,req(ireq)
8337 C Send the contacts to processors that need them
8338 do ii=1,ntask_cont_to
8339 iproc=itask_cont_to(ii)
8341 c write (iout,*) nn," contacts to processor",iproc,
8342 c & " of CONT_TO_COMM group"
8345 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8346 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8347 c write (iout,*) "ireq,req",ireq,req(ireq)
8349 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8353 c write (iout,*) "number of requests (contacts)",ireq
8354 c write (iout,*) "req",(req(i),i=1,4)
8357 & call MPI_Waitall(ireq,req,status_array,ierr)
8358 do iii=1,ntask_cont_from
8359 iproc=itask_cont_from(iii)
8362 write (iout,*) "Received",nn," contacts from processor",iproc,
8363 & " of CONT_FROM_COMM group"
8366 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8371 ii=zapas_recv(1,i,iii)
8372 c Flag the received contacts to prevent double-counting
8373 jj=-zapas_recv(2,i,iii)
8374 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8376 nnn=num_cont_hb(ii)+1
8379 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8383 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8388 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8396 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8405 write (iout,'(a)') 'Contact function values after receive:'
8407 write (iout,'(2i3,50(1x,i3,5f6.3))')
8408 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8409 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8416 write (iout,'(a)') 'Contact function values:'
8418 write (iout,'(2i3,50(1x,i2,5f6.3))')
8419 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8420 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8426 C Remove the loop below after debugging !!!
8433 C Calculate the dipole-dipole interaction energies
8434 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8435 do i=iatel_s,iatel_e+1
8436 num_conti=num_cont_hb(i)
8445 C Calculate the local-electrostatic correlation terms
8446 c write (iout,*) "gradcorr5 in eello5 before loop"
8448 c write (iout,'(i5,3f10.5)')
8449 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8451 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8452 c write (iout,*) "corr loop i",i
8454 num_conti=num_cont_hb(i)
8455 num_conti1=num_cont_hb(i+1)
8462 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8463 c & ' jj=',jj,' kk=',kk
8464 c if (j1.eq.j+1 .or. j1.eq.j-1) then
8465 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8466 & .or. j.lt.0 .and. j1.gt.0) .and.
8467 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8468 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8469 C The system gains extra energy.
8471 sqd1=dsqrt(d_cont(jj,i))
8472 sqd2=dsqrt(d_cont(kk,i1))
8473 sred_geom = sqd1*sqd2
8474 IF (sred_geom.lt.cutoff_corr) THEN
8475 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
8477 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8478 cd & ' jj=',jj,' kk=',kk
8479 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8480 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8482 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8483 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8486 cd write (iout,*) 'sred_geom=',sred_geom,
8487 cd & ' ekont=',ekont,' fprim=',fprimcont,
8488 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8489 cd write (iout,*) "g_contij",g_contij
8490 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8491 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8492 call calc_eello(i,jp,i+1,jp1,jj,kk)
8493 if (wcorr4.gt.0.0d0)
8494 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8495 if (energy_dec.and.wcorr4.gt.0.0d0)
8496 1 write (iout,'(a6,4i5,0pf7.3)')
8497 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8498 c write (iout,*) "gradcorr5 before eello5"
8500 c write (iout,'(i5,3f10.5)')
8501 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8503 if (wcorr5.gt.0.0d0)
8504 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8505 c write (iout,*) "gradcorr5 after eello5"
8507 c write (iout,'(i5,3f10.5)')
8508 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8510 if (energy_dec.and.wcorr5.gt.0.0d0)
8511 1 write (iout,'(a6,4i5,0pf7.3)')
8512 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8513 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8514 cd write(2,*)'ijkl',i,jp,i+1,jp1
8515 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
8516 & .or. wturn6.eq.0.0d0))then
8517 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8518 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8519 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8520 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8521 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8522 cd & 'ecorr6=',ecorr6
8523 cd write (iout,'(4e15.5)') sred_geom,
8524 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8525 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8526 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8527 else if (wturn6.gt.0.0d0
8528 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8529 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8530 eturn6=eturn6+eello_turn6(i,jj,kk)
8531 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8532 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8533 cd write (2,*) 'multibody_eello:eturn6',eturn6
8542 num_cont_hb(i)=num_cont_hb_old(i)
8544 c write (iout,*) "gradcorr5 in eello5"
8546 c write (iout,'(i5,3f10.5)')
8547 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8551 c------------------------------------------------------------------------------
8552 subroutine add_hb_contact_eello(ii,jj,itask)
8553 implicit real*8 (a-h,o-z)
8554 include "DIMENSIONS"
8555 include "COMMON.IOUNITS"
8558 parameter (max_cont=maxconts)
8559 parameter (max_dim=70)
8560 include "COMMON.CONTACTS"
8561 double precision zapas(max_dim,maxconts,max_fg_procs),
8562 & zapas_recv(max_dim,maxconts,max_fg_procs)
8563 common /przechowalnia/ zapas
8564 integer i,j,ii,jj,iproc,itask(4),nn
8565 c write (iout,*) "itask",itask
8568 if (iproc.gt.0) then
8569 do j=1,num_cont_hb(ii)
8571 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8573 ncont_sent(iproc)=ncont_sent(iproc)+1
8574 nn=ncont_sent(iproc)
8575 zapas(1,nn,iproc)=ii
8576 zapas(2,nn,iproc)=jjc
8577 zapas(3,nn,iproc)=d_cont(j,ii)
8581 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8586 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8594 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8606 c------------------------------------------------------------------------------
8607 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8608 implicit real*8 (a-h,o-z)
8609 include 'DIMENSIONS'
8610 include 'COMMON.IOUNITS'
8611 include 'COMMON.DERIV'
8612 include 'COMMON.INTERACT'
8613 include 'COMMON.CONTACTS'
8614 double precision gx(3),gx1(3)
8624 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8625 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8626 C Following 4 lines for diagnostics.
8631 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8632 c & 'Contacts ',i,j,
8633 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8634 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8636 C Calculate the multi-body contribution to energy.
8637 C ecorr=ecorr+ekont*ees
8638 C Calculate multi-body contributions to the gradient.
8639 coeffpees0pij=coeffp*ees0pij
8640 coeffmees0mij=coeffm*ees0mij
8641 coeffpees0pkl=coeffp*ees0pkl
8642 coeffmees0mkl=coeffm*ees0mkl
8644 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8645 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8646 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8647 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8648 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8649 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8650 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8651 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8652 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8653 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8654 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8655 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8656 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8657 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8658 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8659 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8660 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8661 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8662 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8663 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8664 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8665 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8666 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8667 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8668 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8673 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8674 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8675 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8676 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8681 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8682 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8683 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8684 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8687 c write (iout,*) "ehbcorr",ekont*ees
8692 C---------------------------------------------------------------------------
8693 subroutine dipole(i,j,jj)
8694 implicit real*8 (a-h,o-z)
8695 include 'DIMENSIONS'
8696 include 'COMMON.IOUNITS'
8697 include 'COMMON.CHAIN'
8698 include 'COMMON.FFIELD'
8699 include 'COMMON.DERIV'
8700 include 'COMMON.INTERACT'
8701 include 'COMMON.CONTACTS'
8702 include 'COMMON.TORSION'
8703 include 'COMMON.VAR'
8704 include 'COMMON.GEO'
8705 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8707 iti1 = itortyp(itype(i+1))
8708 if (j.lt.nres-1) then
8709 itj1 = itortyp(itype(j+1))
8714 dipi(iii,1)=Ub2(iii,i)
8715 dipderi(iii)=Ub2der(iii,i)
8716 dipi(iii,2)=b1(iii,i+1)
8717 dipj(iii,1)=Ub2(iii,j)
8718 dipderj(iii)=Ub2der(iii,j)
8719 dipj(iii,2)=b1(iii,j+1)
8723 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8726 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8733 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8737 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8742 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8743 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8745 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8747 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8749 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8754 C---------------------------------------------------------------------------
8755 subroutine calc_eello(i,j,k,l,jj,kk)
8757 C This subroutine computes matrices and vectors needed to calculate
8758 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8760 implicit real*8 (a-h,o-z)
8761 include 'DIMENSIONS'
8762 include 'COMMON.IOUNITS'
8763 include 'COMMON.CHAIN'
8764 include 'COMMON.DERIV'
8765 include 'COMMON.INTERACT'
8766 include 'COMMON.CONTACTS'
8767 include 'COMMON.TORSION'
8768 include 'COMMON.VAR'
8769 include 'COMMON.GEO'
8770 include 'COMMON.FFIELD'
8771 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8772 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8775 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8776 cd & ' jj=',jj,' kk=',kk
8777 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8778 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8779 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8782 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8783 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8786 call transpose2(aa1(1,1),aa1t(1,1))
8787 call transpose2(aa2(1,1),aa2t(1,1))
8790 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8791 & aa1tder(1,1,lll,kkk))
8792 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8793 & aa2tder(1,1,lll,kkk))
8797 C parallel orientation of the two CA-CA-CA frames.
8799 iti=itortyp(itype(i))
8803 itk1=itortyp(itype(k+1))
8804 itj=itortyp(itype(j))
8805 if (l.lt.nres-1) then
8806 itl1=itortyp(itype(l+1))
8810 C A1 kernel(j+1) A2T
8812 cd write (iout,'(3f10.5,5x,3f10.5)')
8813 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8815 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8816 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8817 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8818 C Following matrices are needed only for 6-th order cumulants
8819 IF (wcorr6.gt.0.0d0) THEN
8820 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8821 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8822 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8823 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8824 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8825 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8826 & ADtEAderx(1,1,1,1,1,1))
8828 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8829 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8830 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8831 & ADtEA1derx(1,1,1,1,1,1))
8833 C End 6-th order cumulants
8836 cd write (2,*) 'In calc_eello6'
8838 cd write (2,*) 'iii=',iii
8840 cd write (2,*) 'kkk=',kkk
8842 cd write (2,'(3(2f10.5),5x)')
8843 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8848 call transpose2(EUgder(1,1,k),auxmat(1,1))
8849 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8850 call transpose2(EUg(1,1,k),auxmat(1,1))
8851 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8852 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8856 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8857 & EAEAderx(1,1,lll,kkk,iii,1))
8861 C A1T kernel(i+1) A2
8862 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8863 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8864 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8865 C Following matrices are needed only for 6-th order cumulants
8866 IF (wcorr6.gt.0.0d0) THEN
8867 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8868 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8869 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8870 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8871 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8872 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8873 & ADtEAderx(1,1,1,1,1,2))
8874 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8875 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8876 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8877 & ADtEA1derx(1,1,1,1,1,2))
8879 C End 6-th order cumulants
8880 call transpose2(EUgder(1,1,l),auxmat(1,1))
8881 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8882 call transpose2(EUg(1,1,l),auxmat(1,1))
8883 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8884 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8888 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8889 & EAEAderx(1,1,lll,kkk,iii,2))
8894 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8895 C They are needed only when the fifth- or the sixth-order cumulants are
8897 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8898 call transpose2(AEA(1,1,1),auxmat(1,1))
8899 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8900 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8901 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8902 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8903 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8904 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8905 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8906 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8907 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8908 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8909 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8910 call transpose2(AEA(1,1,2),auxmat(1,1))
8911 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8912 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8913 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8914 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8915 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8916 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8917 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8918 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8919 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8920 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8921 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8922 C Calculate the Cartesian derivatives of the vectors.
8926 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8927 call matvec2(auxmat(1,1),b1(1,i),
8928 & AEAb1derx(1,lll,kkk,iii,1,1))
8929 call matvec2(auxmat(1,1),Ub2(1,i),
8930 & AEAb2derx(1,lll,kkk,iii,1,1))
8931 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8932 & AEAb1derx(1,lll,kkk,iii,2,1))
8933 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8934 & AEAb2derx(1,lll,kkk,iii,2,1))
8935 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8936 call matvec2(auxmat(1,1),b1(1,j),
8937 & AEAb1derx(1,lll,kkk,iii,1,2))
8938 call matvec2(auxmat(1,1),Ub2(1,j),
8939 & AEAb2derx(1,lll,kkk,iii,1,2))
8940 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8941 & AEAb1derx(1,lll,kkk,iii,2,2))
8942 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8943 & AEAb2derx(1,lll,kkk,iii,2,2))
8950 C Antiparallel orientation of the two CA-CA-CA frames.
8952 iti=itortyp(itype(i))
8956 itk1=itortyp(itype(k+1))
8957 itl=itortyp(itype(l))
8958 itj=itortyp(itype(j))
8959 if (j.lt.nres-1) then
8960 itj1=itortyp(itype(j+1))
8964 C A2 kernel(j-1)T A1T
8965 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8966 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8967 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8968 C Following matrices are needed only for 6-th order cumulants
8969 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8970 & j.eq.i+4 .and. l.eq.i+3)) THEN
8971 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8972 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8973 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8974 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8975 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8976 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8977 & ADtEAderx(1,1,1,1,1,1))
8978 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8979 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8980 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8981 & ADtEA1derx(1,1,1,1,1,1))
8983 C End 6-th order cumulants
8984 call transpose2(EUgder(1,1,k),auxmat(1,1))
8985 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8986 call transpose2(EUg(1,1,k),auxmat(1,1))
8987 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8988 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8992 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8993 & EAEAderx(1,1,lll,kkk,iii,1))
8997 C A2T kernel(i+1)T A1
8998 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8999 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
9000 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9001 C Following matrices are needed only for 6-th order cumulants
9002 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9003 & j.eq.i+4 .and. l.eq.i+3)) THEN
9004 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9005 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
9006 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9007 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9008 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
9009 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9010 & ADtEAderx(1,1,1,1,1,2))
9011 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9012 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
9013 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9014 & ADtEA1derx(1,1,1,1,1,2))
9016 C End 6-th order cumulants
9017 call transpose2(EUgder(1,1,j),auxmat(1,1))
9018 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9019 call transpose2(EUg(1,1,j),auxmat(1,1))
9020 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9021 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9025 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9026 & EAEAderx(1,1,lll,kkk,iii,2))
9031 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9032 C They are needed only when the fifth- or the sixth-order cumulants are
9034 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
9035 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9036 call transpose2(AEA(1,1,1),auxmat(1,1))
9037 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9038 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9039 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9040 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9041 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9042 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9043 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9044 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9045 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9046 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9047 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9048 call transpose2(AEA(1,1,2),auxmat(1,1))
9049 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
9050 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9051 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9052 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9053 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
9054 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9055 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
9056 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
9057 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9058 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9059 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9060 C Calculate the Cartesian derivatives of the vectors.
9064 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9065 call matvec2(auxmat(1,1),b1(1,i),
9066 & AEAb1derx(1,lll,kkk,iii,1,1))
9067 call matvec2(auxmat(1,1),Ub2(1,i),
9068 & AEAb2derx(1,lll,kkk,iii,1,1))
9069 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9070 & AEAb1derx(1,lll,kkk,iii,2,1))
9071 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9072 & AEAb2derx(1,lll,kkk,iii,2,1))
9073 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9074 call matvec2(auxmat(1,1),b1(1,l),
9075 & AEAb1derx(1,lll,kkk,iii,1,2))
9076 call matvec2(auxmat(1,1),Ub2(1,l),
9077 & AEAb2derx(1,lll,kkk,iii,1,2))
9078 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
9079 & AEAb1derx(1,lll,kkk,iii,2,2))
9080 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
9081 & AEAb2derx(1,lll,kkk,iii,2,2))
9090 C---------------------------------------------------------------------------
9091 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
9092 & KK,KKderg,AKA,AKAderg,AKAderx)
9096 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
9097 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
9098 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
9103 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9105 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
9108 cd if (lprn) write (2,*) 'In kernel'
9110 cd if (lprn) write (2,*) 'kkk=',kkk
9112 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
9113 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9115 cd write (2,*) 'lll=',lll
9116 cd write (2,*) 'iii=1'
9118 cd write (2,'(3(2f10.5),5x)')
9119 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9122 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
9123 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9125 cd write (2,*) 'lll=',lll
9126 cd write (2,*) 'iii=2'
9128 cd write (2,'(3(2f10.5),5x)')
9129 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9136 C---------------------------------------------------------------------------
9137 double precision function eello4(i,j,k,l,jj,kk)
9138 implicit real*8 (a-h,o-z)
9139 include 'DIMENSIONS'
9140 include 'COMMON.IOUNITS'
9141 include 'COMMON.CHAIN'
9142 include 'COMMON.DERIV'
9143 include 'COMMON.INTERACT'
9144 include 'COMMON.CONTACTS'
9145 include 'COMMON.TORSION'
9146 include 'COMMON.VAR'
9147 include 'COMMON.GEO'
9148 double precision pizda(2,2),ggg1(3),ggg2(3)
9149 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9153 cd print *,'eello4:',i,j,k,l,jj,kk
9154 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9155 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9156 cold eij=facont_hb(jj,i)
9157 cold ekl=facont_hb(kk,k)
9159 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9160 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9161 gcorr_loc(k-1)=gcorr_loc(k-1)
9162 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9164 gcorr_loc(l-1)=gcorr_loc(l-1)
9165 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9167 gcorr_loc(j-1)=gcorr_loc(j-1)
9168 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9173 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9174 & -EAEAderx(2,2,lll,kkk,iii,1)
9175 cd derx(lll,kkk,iii)=0.0d0
9179 cd gcorr_loc(l-1)=0.0d0
9180 cd gcorr_loc(j-1)=0.0d0
9181 cd gcorr_loc(k-1)=0.0d0
9183 cd write (iout,*)'Contacts have occurred for peptide groups',
9184 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9185 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9186 if (j.lt.nres-1) then
9193 if (l.lt.nres-1) then
9201 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9202 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9203 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9204 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9205 cgrad ghalf=0.5d0*ggg1(ll)
9206 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9207 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9208 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9209 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9210 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9211 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9212 cgrad ghalf=0.5d0*ggg2(ll)
9213 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9214 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9215 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9216 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9217 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9218 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9222 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9227 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9232 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9237 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9241 cd write (2,*) iii,gcorr_loc(iii)
9244 cd write (2,*) 'ekont',ekont
9245 cd write (iout,*) 'eello4',ekont*eel4
9248 C---------------------------------------------------------------------------
9249 double precision function eello5(i,j,k,l,jj,kk)
9250 implicit real*8 (a-h,o-z)
9251 include 'DIMENSIONS'
9252 include 'COMMON.IOUNITS'
9253 include 'COMMON.CHAIN'
9254 include 'COMMON.DERIV'
9255 include 'COMMON.INTERACT'
9256 include 'COMMON.CONTACTS'
9257 include 'COMMON.TORSION'
9258 include 'COMMON.VAR'
9259 include 'COMMON.GEO'
9260 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9261 double precision ggg1(3),ggg2(3)
9262 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9267 C /l\ / \ \ / \ / \ / C
9268 C / \ / \ \ / \ / \ / C
9269 C j| o |l1 | o | o| o | | o |o C
9270 C \ |/k\| |/ \| / |/ \| |/ \| C
9271 C \i/ \ / \ / / \ / \ C
9273 C (I) (II) (III) (IV) C
9275 C eello5_1 eello5_2 eello5_3 eello5_4 C
9277 C Antiparallel chains C
9280 C /j\ / \ \ / \ / \ / C
9281 C / \ / \ \ / \ / \ / C
9282 C j1| o |l | o | o| o | | o |o C
9283 C \ |/k\| |/ \| / |/ \| |/ \| C
9284 C \i/ \ / \ / / \ / \ C
9286 C (I) (II) (III) (IV) C
9288 C eello5_1 eello5_2 eello5_3 eello5_4 C
9290 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9292 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9293 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9298 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9300 itk=itortyp(itype(k))
9301 itl=itortyp(itype(l))
9302 itj=itortyp(itype(j))
9307 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9308 cd & eel5_3_num,eel5_4_num)
9312 derx(lll,kkk,iii)=0.0d0
9316 cd eij=facont_hb(jj,i)
9317 cd ekl=facont_hb(kk,k)
9319 cd write (iout,*)'Contacts have occurred for peptide groups',
9320 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9322 C Contribution from the graph I.
9323 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9324 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9325 call transpose2(EUg(1,1,k),auxmat(1,1))
9326 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9327 vv(1)=pizda(1,1)-pizda(2,2)
9328 vv(2)=pizda(1,2)+pizda(2,1)
9329 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9330 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9331 C Explicit gradient in virtual-dihedral angles.
9332 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9333 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9334 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9335 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9336 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9337 vv(1)=pizda(1,1)-pizda(2,2)
9338 vv(2)=pizda(1,2)+pizda(2,1)
9339 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9340 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9341 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9342 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9343 vv(1)=pizda(1,1)-pizda(2,2)
9344 vv(2)=pizda(1,2)+pizda(2,1)
9346 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9347 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9348 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9350 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9351 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9352 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9354 C Cartesian gradient
9358 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
9360 vv(1)=pizda(1,1)-pizda(2,2)
9361 vv(2)=pizda(1,2)+pizda(2,1)
9362 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9363 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
9364 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9370 C Contribution from graph II
9371 call transpose2(EE(1,1,itk),auxmat(1,1))
9372 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9373 vv(1)=pizda(1,1)+pizda(2,2)
9374 vv(2)=pizda(2,1)-pizda(1,2)
9375 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
9376 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9377 C Explicit gradient in virtual-dihedral angles.
9378 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9379 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9380 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9381 vv(1)=pizda(1,1)+pizda(2,2)
9382 vv(2)=pizda(2,1)-pizda(1,2)
9384 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9385 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9386 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9388 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9389 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9390 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9392 C Cartesian gradient
9396 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9398 vv(1)=pizda(1,1)+pizda(2,2)
9399 vv(2)=pizda(2,1)-pizda(1,2)
9400 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9401 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
9402 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9410 C Parallel orientation
9411 C Contribution from graph III
9412 call transpose2(EUg(1,1,l),auxmat(1,1))
9413 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9414 vv(1)=pizda(1,1)-pizda(2,2)
9415 vv(2)=pizda(1,2)+pizda(2,1)
9416 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
9417 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9418 C Explicit gradient in virtual-dihedral angles.
9419 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9420 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
9421 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9422 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9423 vv(1)=pizda(1,1)-pizda(2,2)
9424 vv(2)=pizda(1,2)+pizda(2,1)
9425 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9426 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
9427 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9428 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9429 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9430 vv(1)=pizda(1,1)-pizda(2,2)
9431 vv(2)=pizda(1,2)+pizda(2,1)
9432 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9433 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
9434 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9435 C Cartesian gradient
9439 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9441 vv(1)=pizda(1,1)-pizda(2,2)
9442 vv(2)=pizda(1,2)+pizda(2,1)
9443 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9444 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
9445 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9450 C Contribution from graph IV
9452 call transpose2(EE(1,1,itl),auxmat(1,1))
9453 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9454 vv(1)=pizda(1,1)+pizda(2,2)
9455 vv(2)=pizda(2,1)-pizda(1,2)
9456 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
9457 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9458 C Explicit gradient in virtual-dihedral angles.
9459 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9460 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9461 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9462 vv(1)=pizda(1,1)+pizda(2,2)
9463 vv(2)=pizda(2,1)-pizda(1,2)
9464 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9465 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
9466 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9467 C Cartesian gradient
9471 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9473 vv(1)=pizda(1,1)+pizda(2,2)
9474 vv(2)=pizda(2,1)-pizda(1,2)
9475 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9476 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
9477 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9482 C Antiparallel orientation
9483 C Contribution from graph III
9485 call transpose2(EUg(1,1,j),auxmat(1,1))
9486 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9487 vv(1)=pizda(1,1)-pizda(2,2)
9488 vv(2)=pizda(1,2)+pizda(2,1)
9489 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9490 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9491 C Explicit gradient in virtual-dihedral angles.
9492 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9493 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9494 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9495 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9496 vv(1)=pizda(1,1)-pizda(2,2)
9497 vv(2)=pizda(1,2)+pizda(2,1)
9498 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9499 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9500 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9501 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9502 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9503 vv(1)=pizda(1,1)-pizda(2,2)
9504 vv(2)=pizda(1,2)+pizda(2,1)
9505 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9506 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9507 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9508 C Cartesian gradient
9512 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9514 vv(1)=pizda(1,1)-pizda(2,2)
9515 vv(2)=pizda(1,2)+pizda(2,1)
9516 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9517 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9518 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9523 C Contribution from graph IV
9525 call transpose2(EE(1,1,itj),auxmat(1,1))
9526 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9527 vv(1)=pizda(1,1)+pizda(2,2)
9528 vv(2)=pizda(2,1)-pizda(1,2)
9529 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9530 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9531 C Explicit gradient in virtual-dihedral angles.
9532 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9533 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9534 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9535 vv(1)=pizda(1,1)+pizda(2,2)
9536 vv(2)=pizda(2,1)-pizda(1,2)
9537 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9538 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9539 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9540 C Cartesian gradient
9544 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9546 vv(1)=pizda(1,1)+pizda(2,2)
9547 vv(2)=pizda(2,1)-pizda(1,2)
9548 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9549 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9550 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9556 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9557 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9558 cd write (2,*) 'ijkl',i,j,k,l
9559 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9560 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9562 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9563 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9564 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9565 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9566 if (j.lt.nres-1) then
9573 if (l.lt.nres-1) then
9583 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9584 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9585 C summed up outside the subrouine as for the other subroutines
9586 C handling long-range interactions. The old code is commented out
9587 C with "cgrad" to keep track of changes.
9589 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9590 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9591 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9592 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9593 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9594 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9595 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9596 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9597 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9598 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9600 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9601 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9602 cgrad ghalf=0.5d0*ggg1(ll)
9604 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9605 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9606 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9607 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9608 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9609 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9610 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9611 cgrad ghalf=0.5d0*ggg2(ll)
9613 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
9614 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9615 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
9616 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9617 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9618 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9623 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9624 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9629 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9630 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9636 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9641 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9645 cd write (2,*) iii,g_corr5_loc(iii)
9648 cd write (2,*) 'ekont',ekont
9649 cd write (iout,*) 'eello5',ekont*eel5
9652 c--------------------------------------------------------------------------
9653 double precision function eello6(i,j,k,l,jj,kk)
9654 implicit real*8 (a-h,o-z)
9655 include 'DIMENSIONS'
9656 include 'COMMON.IOUNITS'
9657 include 'COMMON.CHAIN'
9658 include 'COMMON.DERIV'
9659 include 'COMMON.INTERACT'
9660 include 'COMMON.CONTACTS'
9661 include 'COMMON.TORSION'
9662 include 'COMMON.VAR'
9663 include 'COMMON.GEO'
9664 include 'COMMON.FFIELD'
9665 double precision ggg1(3),ggg2(3)
9666 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9671 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9679 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9680 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9684 derx(lll,kkk,iii)=0.0d0
9688 cd eij=facont_hb(jj,i)
9689 cd ekl=facont_hb(kk,k)
9695 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9696 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9697 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9698 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9699 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9700 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9702 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9703 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9704 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9705 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9706 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9707 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9711 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9713 C If turn contributions are considered, they will be handled separately.
9714 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9715 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9716 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9717 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9718 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9719 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9720 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9722 if (j.lt.nres-1) then
9729 if (l.lt.nres-1) then
9737 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9738 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9739 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9740 cgrad ghalf=0.5d0*ggg1(ll)
9742 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9743 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9744 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9745 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9746 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9747 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9748 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9749 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9750 cgrad ghalf=0.5d0*ggg2(ll)
9751 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9753 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9754 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9755 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9756 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9757 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9758 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9763 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9764 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9769 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9770 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9776 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9781 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9785 cd write (2,*) iii,g_corr6_loc(iii)
9788 cd write (2,*) 'ekont',ekont
9789 cd write (iout,*) 'eello6',ekont*eel6
9792 c--------------------------------------------------------------------------
9793 double precision function eello6_graph1(i,j,k,l,imat,swap)
9794 implicit real*8 (a-h,o-z)
9795 include 'DIMENSIONS'
9796 include 'COMMON.IOUNITS'
9797 include 'COMMON.CHAIN'
9798 include 'COMMON.DERIV'
9799 include 'COMMON.INTERACT'
9800 include 'COMMON.CONTACTS'
9801 include 'COMMON.TORSION'
9802 include 'COMMON.VAR'
9803 include 'COMMON.GEO'
9804 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9808 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9810 C Parallel Antiparallel C
9816 C \ j|/k\| / \ |/k\|l / C
9821 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9822 itk=itortyp(itype(k))
9823 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9824 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9825 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9826 call transpose2(EUgC(1,1,k),auxmat(1,1))
9827 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9828 vv1(1)=pizda1(1,1)-pizda1(2,2)
9829 vv1(2)=pizda1(1,2)+pizda1(2,1)
9830 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9831 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9832 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9833 s5=scalar2(vv(1),Dtobr2(1,i))
9834 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9835 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9836 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9837 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9838 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9839 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9840 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9841 & +scalar2(vv(1),Dtobr2der(1,i)))
9842 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9843 vv1(1)=pizda1(1,1)-pizda1(2,2)
9844 vv1(2)=pizda1(1,2)+pizda1(2,1)
9845 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9846 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9848 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9849 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9850 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9851 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9852 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9854 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9855 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9856 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9857 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9858 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9860 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9861 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9862 vv1(1)=pizda1(1,1)-pizda1(2,2)
9863 vv1(2)=pizda1(1,2)+pizda1(2,1)
9864 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9865 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9866 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9867 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9876 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9877 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9878 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9879 call transpose2(EUgC(1,1,k),auxmat(1,1))
9880 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9882 vv1(1)=pizda1(1,1)-pizda1(2,2)
9883 vv1(2)=pizda1(1,2)+pizda1(2,1)
9884 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9885 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9886 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9887 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9888 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9889 s5=scalar2(vv(1),Dtobr2(1,i))
9890 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9896 c----------------------------------------------------------------------------
9897 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9898 implicit real*8 (a-h,o-z)
9899 include 'DIMENSIONS'
9900 include 'COMMON.IOUNITS'
9901 include 'COMMON.CHAIN'
9902 include 'COMMON.DERIV'
9903 include 'COMMON.INTERACT'
9904 include 'COMMON.CONTACTS'
9905 include 'COMMON.TORSION'
9906 include 'COMMON.VAR'
9907 include 'COMMON.GEO'
9909 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9910 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9913 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9915 C Parallel Antiparallel C
9921 C \ j|/k\| \ |/k\|l C
9926 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9927 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9928 C AL 7/4/01 s1 would occur in the sixth-order moment,
9929 C but not in a cluster cumulant
9931 s1=dip(1,jj,i)*dip(1,kk,k)
9933 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9934 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9935 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9936 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9937 call transpose2(EUg(1,1,k),auxmat(1,1))
9938 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9939 vv(1)=pizda(1,1)-pizda(2,2)
9940 vv(2)=pizda(1,2)+pizda(2,1)
9941 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9942 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9944 eello6_graph2=-(s1+s2+s3+s4)
9946 eello6_graph2=-(s2+s3+s4)
9949 C Derivatives in gamma(i-1)
9952 s1=dipderg(1,jj,i)*dip(1,kk,k)
9954 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9955 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9956 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9957 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9959 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9961 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9963 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9965 C Derivatives in gamma(k-1)
9967 s1=dip(1,jj,i)*dipderg(1,kk,k)
9969 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9970 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9971 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9972 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9973 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9974 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9975 vv(1)=pizda(1,1)-pizda(2,2)
9976 vv(2)=pizda(1,2)+pizda(2,1)
9977 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9979 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9981 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9983 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9984 C Derivatives in gamma(j-1) or gamma(l-1)
9987 s1=dipderg(3,jj,i)*dip(1,kk,k)
9989 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9990 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9991 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9992 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9993 vv(1)=pizda(1,1)-pizda(2,2)
9994 vv(2)=pizda(1,2)+pizda(2,1)
9995 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9998 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10000 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10003 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10004 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10006 C Derivatives in gamma(l-1) or gamma(j-1)
10009 s1=dip(1,jj,i)*dipderg(3,kk,k)
10011 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10012 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10013 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10014 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10015 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10016 vv(1)=pizda(1,1)-pizda(2,2)
10017 vv(2)=pizda(1,2)+pizda(2,1)
10018 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10021 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10023 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10026 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10027 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10029 C Cartesian derivatives.
10031 write (2,*) 'In eello6_graph2'
10033 write (2,*) 'iii=',iii
10035 write (2,*) 'kkk=',kkk
10037 write (2,'(3(2f10.5),5x)')
10038 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10048 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10050 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10053 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
10055 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10056 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
10058 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10059 call transpose2(EUg(1,1,k),auxmat(1,1))
10060 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
10062 vv(1)=pizda(1,1)-pizda(2,2)
10063 vv(2)=pizda(1,2)+pizda(2,1)
10064 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10065 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10067 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10069 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10072 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10074 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10081 c----------------------------------------------------------------------------
10082 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
10083 implicit real*8 (a-h,o-z)
10084 include 'DIMENSIONS'
10085 include 'COMMON.IOUNITS'
10086 include 'COMMON.CHAIN'
10087 include 'COMMON.DERIV'
10088 include 'COMMON.INTERACT'
10089 include 'COMMON.CONTACTS'
10090 include 'COMMON.TORSION'
10091 include 'COMMON.VAR'
10092 include 'COMMON.GEO'
10093 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
10095 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10097 C Parallel Antiparallel C
10102 C /| o |o o| o |\ C
10103 C j|/k\| / |/k\|l / C
10108 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10110 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10111 C energy moment and not to the cluster cumulant.
10112 iti=itortyp(itype(i))
10113 if (j.lt.nres-1) then
10114 itj1=itortyp(itype(j+1))
10118 itk=itortyp(itype(k))
10119 itk1=itortyp(itype(k+1))
10120 if (l.lt.nres-1) then
10121 itl1=itortyp(itype(l+1))
10126 s1=dip(4,jj,i)*dip(4,kk,k)
10128 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
10129 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10130 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
10131 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10132 call transpose2(EE(1,1,itk),auxmat(1,1))
10133 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10134 vv(1)=pizda(1,1)+pizda(2,2)
10135 vv(2)=pizda(2,1)-pizda(1,2)
10136 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10137 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10138 cd & "sum",-(s2+s3+s4)
10140 eello6_graph3=-(s1+s2+s3+s4)
10142 eello6_graph3=-(s2+s3+s4)
10144 c eello6_graph3=-s4
10145 C Derivatives in gamma(k-1)
10146 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
10147 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10148 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10149 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10150 C Derivatives in gamma(l-1)
10151 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
10152 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10153 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10154 vv(1)=pizda(1,1)+pizda(2,2)
10155 vv(2)=pizda(2,1)-pizda(1,2)
10156 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10157 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10158 C Cartesian derivatives.
10164 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10166 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10169 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
10171 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10172 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
10174 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10175 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
10177 vv(1)=pizda(1,1)+pizda(2,2)
10178 vv(2)=pizda(2,1)-pizda(1,2)
10179 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10181 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10183 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10186 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10188 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10190 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10196 c----------------------------------------------------------------------------
10197 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10198 implicit real*8 (a-h,o-z)
10199 include 'DIMENSIONS'
10200 include 'COMMON.IOUNITS'
10201 include 'COMMON.CHAIN'
10202 include 'COMMON.DERIV'
10203 include 'COMMON.INTERACT'
10204 include 'COMMON.CONTACTS'
10205 include 'COMMON.TORSION'
10206 include 'COMMON.VAR'
10207 include 'COMMON.GEO'
10208 include 'COMMON.FFIELD'
10209 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10210 & auxvec1(2),auxmat1(2,2)
10212 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10214 C Parallel Antiparallel C
10219 C /| o |o o| o |\ C
10220 C \ j|/k\| \ |/k\|l C
10225 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10227 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10228 C energy moment and not to the cluster cumulant.
10229 cd write (2,*) 'eello_graph4: wturn6',wturn6
10230 iti=itortyp(itype(i))
10231 itj=itortyp(itype(j))
10232 if (j.lt.nres-1) then
10233 itj1=itortyp(itype(j+1))
10237 itk=itortyp(itype(k))
10238 if (k.lt.nres-1) then
10239 itk1=itortyp(itype(k+1))
10243 itl=itortyp(itype(l))
10244 if (l.lt.nres-1) then
10245 itl1=itortyp(itype(l+1))
10249 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10250 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10251 cd & ' itl',itl,' itl1',itl1
10253 if (imat.eq.1) then
10254 s1=dip(3,jj,i)*dip(3,kk,k)
10256 s1=dip(2,jj,j)*dip(2,kk,l)
10259 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10260 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10262 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
10263 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10265 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
10266 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10268 call transpose2(EUg(1,1,k),auxmat(1,1))
10269 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10270 vv(1)=pizda(1,1)-pizda(2,2)
10271 vv(2)=pizda(2,1)+pizda(1,2)
10272 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10273 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10275 eello6_graph4=-(s1+s2+s3+s4)
10277 eello6_graph4=-(s2+s3+s4)
10279 C Derivatives in gamma(i-1)
10282 if (imat.eq.1) then
10283 s1=dipderg(2,jj,i)*dip(3,kk,k)
10285 s1=dipderg(4,jj,j)*dip(2,kk,l)
10288 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10290 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
10291 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10293 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
10294 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10296 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10297 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10298 cd write (2,*) 'turn6 derivatives'
10300 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10302 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10306 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10308 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10312 C Derivatives in gamma(k-1)
10314 if (imat.eq.1) then
10315 s1=dip(3,jj,i)*dipderg(2,kk,k)
10317 s1=dip(2,jj,j)*dipderg(4,kk,l)
10320 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10321 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10323 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
10324 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10326 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
10327 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10329 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10330 call matmat2(AECA(1,1,imat),auxmat1(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 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10336 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10338 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10342 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10344 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10347 C Derivatives in gamma(j-1) or gamma(l-1)
10348 if (l.eq.j+1 .and. l.gt.1) then
10349 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10350 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10351 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10352 vv(1)=pizda(1,1)-pizda(2,2)
10353 vv(2)=pizda(2,1)+pizda(1,2)
10354 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10355 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10356 else if (j.gt.1) then
10357 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10358 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10359 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10360 vv(1)=pizda(1,1)-pizda(2,2)
10361 vv(2)=pizda(2,1)+pizda(1,2)
10362 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10363 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10364 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10366 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10369 C Cartesian derivatives.
10375 if (imat.eq.1) then
10376 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10378 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10381 if (imat.eq.1) then
10382 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10384 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10388 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
10390 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10392 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10393 & b1(1,j+1),auxvec(1))
10394 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
10396 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10397 & b1(1,l+1),auxvec(1))
10398 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
10400 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10402 vv(1)=pizda(1,1)-pizda(2,2)
10403 vv(2)=pizda(2,1)+pizda(1,2)
10404 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10406 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10408 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10411 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10414 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10417 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10419 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10421 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10425 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10427 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10430 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10432 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10440 c----------------------------------------------------------------------------
10441 double precision function eello_turn6(i,jj,kk)
10442 implicit real*8 (a-h,o-z)
10443 include 'DIMENSIONS'
10444 include 'COMMON.IOUNITS'
10445 include 'COMMON.CHAIN'
10446 include 'COMMON.DERIV'
10447 include 'COMMON.INTERACT'
10448 include 'COMMON.CONTACTS'
10449 include 'COMMON.TORSION'
10450 include 'COMMON.VAR'
10451 include 'COMMON.GEO'
10452 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
10453 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
10455 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
10456 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
10457 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10458 C the respective energy moment and not to the cluster cumulant.
10467 iti=itortyp(itype(i))
10468 itk=itortyp(itype(k))
10469 itk1=itortyp(itype(k+1))
10470 itl=itortyp(itype(l))
10471 itj=itortyp(itype(j))
10472 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10473 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
10474 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10479 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10481 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10485 derx_turn(lll,kkk,iii)=0.0d0
10492 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10494 cd write (2,*) 'eello6_5',eello6_5
10496 call transpose2(AEA(1,1,1),auxmat(1,1))
10497 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10498 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10499 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10501 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10502 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10503 s2 = scalar2(b1(1,k),vtemp1(1))
10505 call transpose2(AEA(1,1,2),atemp(1,1))
10506 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10507 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10508 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10510 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10511 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10512 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10514 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10515 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10516 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10517 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10518 ss13 = scalar2(b1(1,k),vtemp4(1))
10519 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10521 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10527 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10528 C Derivatives in gamma(i+2)
10532 call transpose2(AEA(1,1,1),auxmatd(1,1))
10533 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10534 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10535 call transpose2(AEAderg(1,1,2),atempd(1,1))
10536 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10537 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10539 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10540 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10541 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10547 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10548 C Derivatives in gamma(i+3)
10550 call transpose2(AEA(1,1,1),auxmatd(1,1))
10551 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10552 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10553 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10555 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10556 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10557 s2d = scalar2(b1(1,k),vtemp1d(1))
10559 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10560 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10562 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10564 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10565 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10566 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10574 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10575 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10577 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10578 & -0.5d0*ekont*(s2d+s12d)
10580 C Derivatives in gamma(i+4)
10581 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10582 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10583 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10585 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10586 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10587 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10595 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10597 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10599 C Derivatives in gamma(i+5)
10601 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10602 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10603 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10605 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10606 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10607 s2d = scalar2(b1(1,k),vtemp1d(1))
10609 call transpose2(AEA(1,1,2),atempd(1,1))
10610 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10611 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10613 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10614 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10616 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10617 ss13d = scalar2(b1(1,k),vtemp4d(1))
10618 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10626 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10627 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10629 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10630 & -0.5d0*ekont*(s2d+s12d)
10632 C Cartesian derivatives
10637 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10638 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10639 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10641 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10642 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10644 s2d = scalar2(b1(1,k),vtemp1d(1))
10646 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10647 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10648 s8d = -(atempd(1,1)+atempd(2,2))*
10649 & scalar2(cc(1,1,itl),vtemp2(1))
10651 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10653 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10654 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10661 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10662 & - 0.5d0*(s1d+s2d)
10664 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10668 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10669 & - 0.5d0*(s8d+s12d)
10671 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10680 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10681 & achuj_tempd(1,1))
10682 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10683 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10684 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10685 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10686 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10688 ss13d = scalar2(b1(1,k),vtemp4d(1))
10689 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10690 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10694 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10695 cd & 16*eel_turn6_num
10697 if (j.lt.nres-1) then
10704 if (l.lt.nres-1) then
10712 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10713 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10714 cgrad ghalf=0.5d0*ggg1(ll)
10716 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10717 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10718 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10719 & +ekont*derx_turn(ll,2,1)
10720 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10721 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10722 & +ekont*derx_turn(ll,4,1)
10723 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10724 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10725 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10726 cgrad ghalf=0.5d0*ggg2(ll)
10728 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10729 & +ekont*derx_turn(ll,2,2)
10730 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10731 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10732 & +ekont*derx_turn(ll,4,2)
10733 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10734 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10735 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10740 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10745 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10751 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10756 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10760 cd write (2,*) iii,g_corr6_loc(iii)
10762 eello_turn6=ekont*eel_turn6
10763 cd write (2,*) 'ekont',ekont
10764 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10768 C-----------------------------------------------------------------------------
10769 double precision function scalar(u,v)
10770 !DIR$ INLINEALWAYS scalar
10772 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10775 double precision u(3),v(3)
10776 cd double precision sc
10784 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10787 crc-------------------------------------------------
10788 SUBROUTINE MATVEC2(A1,V1,V2)
10789 !DIR$ INLINEALWAYS MATVEC2
10791 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10793 implicit real*8 (a-h,o-z)
10794 include 'DIMENSIONS'
10795 DIMENSION A1(2,2),V1(2),V2(2)
10799 c 3 VI=VI+A1(I,K)*V1(K)
10803 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10804 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10809 C---------------------------------------
10810 SUBROUTINE MATMAT2(A1,A2,A3)
10812 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10814 implicit real*8 (a-h,o-z)
10815 include 'DIMENSIONS'
10816 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10817 c DIMENSION AI3(2,2)
10821 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10827 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10828 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10829 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10830 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10838 c-------------------------------------------------------------------------
10839 double precision function scalar2(u,v)
10840 !DIR$ INLINEALWAYS scalar2
10842 double precision u(2),v(2)
10843 double precision sc
10845 scalar2=u(1)*v(1)+u(2)*v(2)
10849 C-----------------------------------------------------------------------------
10851 subroutine transpose2(a,at)
10852 !DIR$ INLINEALWAYS transpose2
10854 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10857 double precision a(2,2),at(2,2)
10864 c--------------------------------------------------------------------------
10865 subroutine transpose(n,a,at)
10868 double precision a(n,n),at(n,n)
10876 C---------------------------------------------------------------------------
10877 subroutine prodmat3(a1,a2,kk,transp,prod)
10878 !DIR$ INLINEALWAYS prodmat3
10880 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10884 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10886 crc double precision auxmat(2,2),prod_(2,2)
10889 crc call transpose2(kk(1,1),auxmat(1,1))
10890 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10891 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10893 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10894 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10895 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10896 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10897 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10898 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10899 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10900 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10903 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10904 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10906 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10907 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10908 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10909 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10910 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10911 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10912 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10913 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10916 c call transpose2(a2(1,1),a2t(1,1))
10919 crc print *,((prod_(i,j),i=1,2),j=1,2)
10920 crc print *,((prod(i,j),i=1,2),j=1,2)
10924 CCC----------------------------------------------
10925 subroutine Eliptransfer(eliptran)
10926 implicit real*8 (a-h,o-z)
10927 include 'DIMENSIONS'
10928 include 'COMMON.GEO'
10929 include 'COMMON.VAR'
10930 include 'COMMON.LOCAL'
10931 include 'COMMON.CHAIN'
10932 include 'COMMON.DERIV'
10933 include 'COMMON.NAMES'
10934 include 'COMMON.INTERACT'
10935 include 'COMMON.IOUNITS'
10936 include 'COMMON.CALC'
10937 include 'COMMON.CONTROL'
10938 include 'COMMON.SPLITELE'
10939 include 'COMMON.SBRIDGE'
10940 C this is done by Adasko
10941 C print *,"wchodze"
10942 C structure of box:
10944 C--bordliptop-- buffore starts
10945 C--bufliptop--- here true lipid starts
10947 C--buflipbot--- lipid ends buffore starts
10948 C--bordlipbot--buffore ends
10950 do i=ilip_start,ilip_end
10952 if (itype(i).eq.ntyp1) cycle
10954 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10955 if (positi.le.0) positi=positi+boxzsize
10957 C first for peptide groups
10958 c for each residue check if it is in lipid or lipid water border area
10959 if ((positi.gt.bordlipbot)
10960 &.and.(positi.lt.bordliptop)) then
10961 C the energy transfer exist
10962 if (positi.lt.buflipbot) then
10963 C what fraction I am in
10965 & ((positi-bordlipbot)/lipbufthick)
10966 C lipbufthick is thickenes of lipid buffore
10967 sslip=sscalelip(fracinbuf)
10968 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10969 eliptran=eliptran+sslip*pepliptran
10970 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10971 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10972 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10974 C print *,"doing sccale for lower part"
10975 C print *,i,sslip,fracinbuf,ssgradlip
10976 elseif (positi.gt.bufliptop) then
10977 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10978 sslip=sscalelip(fracinbuf)
10979 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10980 eliptran=eliptran+sslip*pepliptran
10981 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10982 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10983 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10984 C print *, "doing sscalefor top part"
10985 C print *,i,sslip,fracinbuf,ssgradlip
10987 eliptran=eliptran+pepliptran
10988 C print *,"I am in true lipid"
10991 C eliptran=elpitran+0.0 ! I am in water
10994 C print *, "nic nie bylo w lipidzie?"
10995 C now multiply all by the peptide group transfer factor
10996 C eliptran=eliptran*pepliptran
10997 C now the same for side chains
10999 do i=ilip_start,ilip_end
11000 if (itype(i).eq.ntyp1) cycle
11001 positi=(mod(c(3,i+nres),boxzsize))
11002 if (positi.le.0) positi=positi+boxzsize
11003 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
11004 c for each residue check if it is in lipid or lipid water border area
11005 C respos=mod(c(3,i+nres),boxzsize)
11006 C print *,positi,bordlipbot,buflipbot
11007 if ((positi.gt.bordlipbot)
11008 & .and.(positi.lt.bordliptop)) then
11009 C the energy transfer exist
11010 if (positi.lt.buflipbot) then
11012 & ((positi-bordlipbot)/lipbufthick)
11013 C lipbufthick is thickenes of lipid buffore
11014 sslip=sscalelip(fracinbuf)
11015 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11016 eliptran=eliptran+sslip*liptranene(itype(i))
11017 gliptranx(3,i)=gliptranx(3,i)
11018 &+ssgradlip*liptranene(itype(i))
11019 gliptranc(3,i-1)= gliptranc(3,i-1)
11020 &+ssgradlip*liptranene(itype(i))
11021 C print *,"doing sccale for lower part"
11022 elseif (positi.gt.bufliptop) then
11024 &((bordliptop-positi)/lipbufthick)
11025 sslip=sscalelip(fracinbuf)
11026 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11027 eliptran=eliptran+sslip*liptranene(itype(i))
11028 gliptranx(3,i)=gliptranx(3,i)
11029 &+ssgradlip*liptranene(itype(i))
11030 gliptranc(3,i-1)= gliptranc(3,i-1)
11031 &+ssgradlip*liptranene(itype(i))
11032 C print *, "doing sscalefor top part",sslip,fracinbuf
11034 eliptran=eliptran+liptranene(itype(i))
11035 C print *,"I am in true lipid"
11037 endif ! if in lipid or buffor
11039 C eliptran=elpitran+0.0 ! I am in water
11043 C---------------------------------------------------------
11044 C AFM soubroutine for constant force
11045 subroutine AFMforce(Eafmforce)
11046 implicit real*8 (a-h,o-z)
11047 include 'DIMENSIONS'
11048 include 'COMMON.GEO'
11049 include 'COMMON.VAR'
11050 include 'COMMON.LOCAL'
11051 include 'COMMON.CHAIN'
11052 include 'COMMON.DERIV'
11053 include 'COMMON.NAMES'
11054 include 'COMMON.INTERACT'
11055 include 'COMMON.IOUNITS'
11056 include 'COMMON.CALC'
11057 include 'COMMON.CONTROL'
11058 include 'COMMON.SPLITELE'
11059 include 'COMMON.SBRIDGE'
11064 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11065 dist=dist+diffafm(i)**2
11068 Eafmforce=-forceAFMconst*(dist-distafminit)
11070 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
11071 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
11073 C print *,'AFM',Eafmforce
11076 C---------------------------------------------------------
11077 C AFM subroutine with pseudoconstant velocity
11078 subroutine AFMvel(Eafmforce)
11079 implicit real*8 (a-h,o-z)
11080 include 'DIMENSIONS'
11081 include 'COMMON.GEO'
11082 include 'COMMON.VAR'
11083 include 'COMMON.LOCAL'
11084 include 'COMMON.CHAIN'
11085 include 'COMMON.DERIV'
11086 include 'COMMON.NAMES'
11087 include 'COMMON.INTERACT'
11088 include 'COMMON.IOUNITS'
11089 include 'COMMON.CALC'
11090 include 'COMMON.CONTROL'
11091 include 'COMMON.SPLITELE'
11092 include 'COMMON.SBRIDGE'
11094 C Only for check grad COMMENT if not used for checkgrad
11096 C--------------------------------------------------------
11097 C print *,"wchodze"
11101 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11102 dist=dist+diffafm(i)**2
11105 Eafmforce=0.5d0*forceAFMconst
11106 & *(distafminit+totTafm*velAFMconst-dist)**2
11107 C Eafmforce=-forceAFMconst*(dist-distafminit)
11109 gradafm(i,afmend-1)=-forceAFMconst*
11110 &(distafminit+totTafm*velAFMconst-dist)
11112 gradafm(i,afmbeg-1)=forceAFMconst*
11113 &(distafminit+totTafm*velAFMconst-dist)
11116 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
11120 c----------------------------------------------------------------------------
11121 double precision function sscale2(r,r_cut,r0,rlamb)
11123 double precision r,gamm,r_cut,r0,rlamb,rr
11125 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
11126 c write (2,*) "rr",rr
11127 if(rr.lt.r_cut-rlamb) then
11129 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
11130 gamm=(rr-(r_cut-rlamb))/rlamb
11131 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
11137 C-----------------------------------------------------------------------
11138 double precision function sscalgrad2(r,r_cut,r0,rlamb)
11140 double precision r,gamm,r_cut,r0,rlamb,rr
11142 if(rr.lt.r_cut-rlamb) then
11144 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
11145 gamm=(rr-(r_cut-rlamb))/rlamb
11147 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
11149 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
11156 c----------------------------------------------------------------------------
11157 subroutine e_saxs(Esaxs_constr)
11159 include 'DIMENSIONS'
11162 include "COMMON.SETUP"
11165 include 'COMMON.SBRIDGE'
11166 include 'COMMON.CHAIN'
11167 include 'COMMON.GEO'
11168 include 'COMMON.DERIV'
11169 include 'COMMON.LOCAL'
11170 include 'COMMON.INTERACT'
11171 include 'COMMON.VAR'
11172 include 'COMMON.IOUNITS'
11173 include 'COMMON.MD'
11174 include 'COMMON.CONTROL'
11175 include 'COMMON.NAMES'
11176 include 'COMMON.TIME1'
11177 include 'COMMON.FFIELD'
11179 double precision Esaxs_constr
11180 integer i,iint,j,k,l
11181 double precision PgradC(maxSAXS,3,maxres),
11182 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
11184 double precision PgradC_(maxSAXS,3,maxres),
11185 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
11187 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
11188 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
11189 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
11190 & auxX,auxX1,CACAgrad,Cnorm
11191 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
11192 double precision dist
11194 c SAXS restraint penalty function
11196 write(iout,*) "------- SAXS penalty function start -------"
11197 write (iout,*) "nsaxs",nsaxs
11198 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
11199 write (iout,*) "Psaxs"
11201 write (iout,'(i5,e15.5)') i, Psaxs(i)
11204 Esaxs_constr = 0.0d0
11209 PgradC(k,l,j)=0.0d0
11210 PgradX(k,l,j)=0.0d0
11214 do i=iatsc_s,iatsc_e
11215 if (itype(i).eq.ntyp1) cycle
11216 do iint=1,nint_gr(i)
11217 do j=istart(i,iint),iend(i,iint)
11218 if (itype(j).eq.ntyp1) cycle
11221 dijCASC=dist(i,j+nres)
11222 dijSCCA=dist(i+nres,j)
11223 dijSCSC=dist(i+nres,j+nres)
11224 sigma2CACA=2.0d0/(pstok**2)
11225 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
11226 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
11227 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
11230 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
11231 if (itype(j).ne.10) then
11232 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
11236 if (itype(i).ne.10) then
11237 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
11241 if (itype(i).ne.10 .and. itype(j).ne.10) then
11242 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
11246 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
11248 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
11250 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
11251 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
11252 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
11253 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
11256 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
11257 PgradC(k,l,i) = PgradC(k,l,i)-aux
11258 PgradC(k,l,j) = PgradC(k,l,j)+aux
11260 if (itype(j).ne.10) then
11261 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
11262 PgradC(k,l,i) = PgradC(k,l,i)-aux
11263 PgradC(k,l,j) = PgradC(k,l,j)+aux
11264 PgradX(k,l,j) = PgradX(k,l,j)+aux
11267 if (itype(i).ne.10) then
11268 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
11269 PgradX(k,l,i) = PgradX(k,l,i)-aux
11270 PgradC(k,l,i) = PgradC(k,l,i)-aux
11271 PgradC(k,l,j) = PgradC(k,l,j)+aux
11274 if (itype(i).ne.10 .and. itype(j).ne.10) then
11275 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
11276 PgradC(k,l,i) = PgradC(k,l,i)-aux
11277 PgradC(k,l,j) = PgradC(k,l,j)+aux
11278 PgradX(k,l,i) = PgradX(k,l,i)-aux
11279 PgradX(k,l,j) = PgradX(k,l,j)+aux
11285 sigma2CACA=scal_rad**2*0.25d0/
11286 & (restok(itype(j))**2+restok(itype(i))**2)
11288 IF (saxs_cutoff.eq.0) THEN
11291 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
11292 Pcalc(k) = Pcalc(k)+expCACA
11293 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
11295 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
11296 PgradC(k,l,i) = PgradC(k,l,i)-aux
11297 PgradC(k,l,j) = PgradC(k,l,j)+aux
11301 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
11304 c write (2,*) "ijk",i,j,k
11305 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
11306 if (sss2.eq.0.0d0) cycle
11307 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
11308 if (energy_dec) write(iout,'(a4,3i5,5f10.4)')
11309 & 'saxs',i,j,k,dijCACA,rrr,dk,sss2,ssgrad2
11310 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
11311 Pcalc(k) = Pcalc(k)+expCACA
11313 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
11315 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
11316 & ssgrad2*expCACA/sss2
11319 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
11320 PgradC(k,l,i) = PgradC(k,l,i)+aux
11321 PgradC(k,l,j) = PgradC(k,l,j)-aux
11330 if (nfgtasks.gt.1) then
11331 call MPI_AllReduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
11332 & MPI_SUM,FG_COMM,IERR)
11333 c if (fg_rank.eq.king) then
11335 Pcalc(k) = Pcalc_(k)
11338 c call MPI_AllReduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
11339 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
11340 c if (fg_rank.eq.king) then
11344 c PgradC(k,l,i) = PgradC_(k,l,i)
11350 c call MPI_AllReduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
11351 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
11352 c if (fg_rank.eq.king) then
11356 c PgradX(k,l,i) = PgradX_(k,l,i)
11366 Cnorm = Cnorm + Pcalc(k)
11369 if (fg_rank.eq.king) then
11371 Esaxs_constr = dlog(Cnorm)-wsaxs0
11373 if (Pcalc(k).gt.0.0d0)
11374 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
11376 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
11380 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
11395 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
11396 auxC1 = auxC1+PgradC(k,l,i)
11398 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
11399 auxX1 = auxX1+PgradX(k,l,i)
11402 gsaxsC(l,i) = auxC - auxC1/Cnorm
11404 gsaxsX(l,i) = auxX - auxX1/Cnorm
11406 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
11407 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
11415 c----------------------------------------------------------------------------
11416 subroutine e_saxsC(Esaxs_constr)
11418 include 'DIMENSIONS'
11421 include "COMMON.SETUP"
11424 include 'COMMON.SBRIDGE'
11425 include 'COMMON.CHAIN'
11426 include 'COMMON.GEO'
11427 include 'COMMON.DERIV'
11428 include 'COMMON.LOCAL'
11429 include 'COMMON.INTERACT'
11430 include 'COMMON.VAR'
11431 include 'COMMON.IOUNITS'
11432 include 'COMMON.MD'
11433 include 'COMMON.CONTROL'
11434 include 'COMMON.NAMES'
11435 include 'COMMON.TIME1'
11436 include 'COMMON.FFIELD'
11438 double precision Esaxs_constr
11439 integer i,iint,j,k,l
11440 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
11442 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
11444 double precision dk,dijCASPH,dijSCSPH,
11445 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
11446 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
11448 c SAXS restraint penalty function
11450 write(iout,*) "------- SAXS penalty function start -------"
11451 write (iout,*) "nsaxs",nsaxs
11454 print *,MyRank,"C",i,(C(j,i),j=1,3)
11457 print *,MyRank,"CSaxs",i,(Csaxs(j,i),j=1,3)
11460 Esaxs_constr = 0.0d0
11462 do j=isaxs_start,isaxs_end
11471 if (itype(i).eq.ntyp1) cycle
11475 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
11477 if (itype(i).ne.10) then
11479 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
11482 sigma2CA=2.0d0/pstok**2
11483 sigma2SC=4.0d0/restok(itype(i))**2
11484 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
11485 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
11486 Pcalc = Pcalc+expCASPH+expSCSPH
11488 write(*,*) "processor i j Pcalc",
11489 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
11491 CASPHgrad = sigma2CA*expCASPH
11492 SCSPHgrad = sigma2SC*expSCSPH
11494 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
11495 PgradX(l,i) = PgradX(l,i) + aux
11496 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
11501 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
11502 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
11505 logPtot = logPtot - dlog(Pcalc)
11506 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
11507 c & " logPtot",logPtot
11510 if (nfgtasks.gt.1) then
11511 c write (iout,*) "logPtot before reduction",logPtot
11512 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
11513 & MPI_SUM,king,FG_COMM,IERR)
11515 c write (iout,*) "logPtot after reduction",logPtot
11516 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
11517 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11518 if (fg_rank.eq.king) then
11521 gsaxsC(l,i) = gsaxsC_(l,i)
11525 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
11526 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11527 if (fg_rank.eq.king) then
11530 gsaxsX(l,i) = gsaxsX_(l,i)
11536 Esaxs_constr = logPtot