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
1534 ccccc energy_dec=.false.
1535 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1538 c if (icall.eq.0) lprn=.false.
1540 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1541 C we have the original box)
1545 do i=iatsc_s,iatsc_e
1546 itypi=iabs(itype(i))
1547 if (itypi.eq.ntyp1) cycle
1548 itypi1=iabs(itype(i+1))
1552 C Return atom into box, boxxsize is size of box in x dimension
1554 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1555 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1556 C Condition for being inside the proper box
1557 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1558 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1562 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1563 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1564 C Condition for being inside the proper box
1565 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1566 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1570 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1571 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1572 C Condition for being inside the proper box
1573 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1574 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1578 if (xi.lt.0) xi=xi+boxxsize
1580 if (yi.lt.0) yi=yi+boxysize
1582 if (zi.lt.0) zi=zi+boxzsize
1583 C define scaling factor for lipids
1585 C if (positi.le.0) positi=positi+boxzsize
1587 C first for peptide groups
1588 c for each residue check if it is in lipid or lipid water border area
1589 if ((zi.gt.bordlipbot)
1590 &.and.(zi.lt.bordliptop)) then
1591 C the energy transfer exist
1592 if (zi.lt.buflipbot) then
1593 C what fraction I am in
1595 & ((zi-bordlipbot)/lipbufthick)
1596 C lipbufthick is thickenes of lipid buffore
1597 sslipi=sscalelip(fracinbuf)
1598 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1599 elseif (zi.gt.bufliptop) then
1600 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1601 sslipi=sscalelip(fracinbuf)
1602 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1612 C xi=xi+xshift*boxxsize
1613 C yi=yi+yshift*boxysize
1614 C zi=zi+zshift*boxzsize
1616 dxi=dc_norm(1,nres+i)
1617 dyi=dc_norm(2,nres+i)
1618 dzi=dc_norm(3,nres+i)
1619 c dsci_inv=dsc_inv(itypi)
1620 dsci_inv=vbld_inv(i+nres)
1621 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1622 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1624 C Calculate SC interaction energy.
1626 do iint=1,nint_gr(i)
1627 do j=istart(i,iint),iend(i,iint)
1628 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1629 call dyn_ssbond_ene(i,j,evdwij)
1631 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1632 & 'evdw',i,j,evdwij,' ss'
1635 itypj=iabs(itype(j))
1636 if (itypj.eq.ntyp1) cycle
1637 c dscj_inv=dsc_inv(itypj)
1638 dscj_inv=vbld_inv(j+nres)
1639 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1640 c & 1.0d0/vbld(j+nres)
1641 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1642 sig0ij=sigma(itypi,itypj)
1643 chi1=chi(itypi,itypj)
1644 chi2=chi(itypj,itypi)
1651 alf12=0.5D0*(alf1+alf2)
1652 C For diagnostics only!!!
1665 C Return atom J into box the original box
1667 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1668 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1669 C Condition for being inside the proper box
1670 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1671 c & (xj.lt.((-0.5d0)*boxxsize))) then
1675 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1676 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1677 C Condition for being inside the proper box
1678 c if ((yj.gt.((0.5d0)*boxysize)).or.
1679 c & (yj.lt.((-0.5d0)*boxysize))) then
1683 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1684 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1685 C Condition for being inside the proper box
1686 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1687 c & (zj.lt.((-0.5d0)*boxzsize))) then
1691 if (xj.lt.0) xj=xj+boxxsize
1693 if (yj.lt.0) yj=yj+boxysize
1695 if (zj.lt.0) zj=zj+boxzsize
1696 if ((zj.gt.bordlipbot)
1697 &.and.(zj.lt.bordliptop)) then
1698 C the energy transfer exist
1699 if (zj.lt.buflipbot) then
1700 C what fraction I am in
1702 & ((zj-bordlipbot)/lipbufthick)
1703 C lipbufthick is thickenes of lipid buffore
1704 sslipj=sscalelip(fracinbuf)
1705 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1706 elseif (zj.gt.bufliptop) then
1707 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1708 sslipj=sscalelip(fracinbuf)
1709 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1718 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1719 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1720 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1721 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1722 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1723 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1724 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1725 C print *,sslipi,sslipj,bordlipbot,zi,zj
1726 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1734 xj=xj_safe+xshift*boxxsize
1735 yj=yj_safe+yshift*boxysize
1736 zj=zj_safe+zshift*boxzsize
1737 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1738 if(dist_temp.lt.dist_init) then
1748 if (subchap.eq.1) then
1757 dxj=dc_norm(1,nres+j)
1758 dyj=dc_norm(2,nres+j)
1759 dzj=dc_norm(3,nres+j)
1763 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1764 c write (iout,*) "j",j," dc_norm",
1765 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1766 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1768 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1769 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1771 c write (iout,'(a7,4f8.3)')
1772 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1773 if (sss.gt.0.0d0) then
1774 C Calculate angle-dependent terms of energy and contributions to their
1778 sig=sig0ij*dsqrt(sigsq)
1779 rij_shift=1.0D0/rij-sig+sig0ij
1780 c for diagnostics; uncomment
1781 c rij_shift=1.2*sig0ij
1782 C I hate to put IF's in the loops, but here don't have another choice!!!!
1783 if (rij_shift.le.0.0D0) then
1785 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1786 cd & restyp(itypi),i,restyp(itypj),j,
1787 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1791 c---------------------------------------------------------------
1792 rij_shift=1.0D0/rij_shift
1793 fac=rij_shift**expon
1794 C here to start with
1799 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1800 eps2der=evdwij*eps3rt
1801 eps3der=evdwij*eps2rt
1802 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1803 C &((sslipi+sslipj)/2.0d0+
1804 C &(2.0d0-sslipi-sslipj)/2.0d0)
1805 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1806 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1807 evdwij=evdwij*eps2rt*eps3rt
1808 evdw=evdw+evdwij*sss
1810 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1812 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1813 & restyp(itypi),i,restyp(itypj),j,
1814 & epsi,sigm,chi1,chi2,chip1,chip2,
1815 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1816 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1820 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1823 C Calculate gradient components.
1824 e1=e1*eps1*eps2rt**2*eps3rt**2
1825 fac=-expon*(e1+evdwij)*rij_shift
1828 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1829 c & evdwij,fac,sigma(itypi,itypj),expon
1830 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1832 C Calculate the radial part of the gradient
1833 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1834 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1835 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1836 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1837 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1838 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1844 C Calculate angular part of the gradient.
1854 c write (iout,*) "Number of loop steps in EGB:",ind
1855 cccc energy_dec=.false.
1858 C-----------------------------------------------------------------------------
1859 subroutine egbv(evdw)
1861 C This subroutine calculates the interaction energy of nonbonded side chains
1862 C assuming the Gay-Berne-Vorobjev potential of interaction.
1864 implicit real*8 (a-h,o-z)
1865 include 'DIMENSIONS'
1866 include 'COMMON.GEO'
1867 include 'COMMON.VAR'
1868 include 'COMMON.LOCAL'
1869 include 'COMMON.CHAIN'
1870 include 'COMMON.DERIV'
1871 include 'COMMON.NAMES'
1872 include 'COMMON.INTERACT'
1873 include 'COMMON.IOUNITS'
1874 include 'COMMON.CALC'
1875 common /srutu/ icall
1878 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1881 c if (icall.eq.0) lprn=.true.
1883 do i=iatsc_s,iatsc_e
1884 itypi=iabs(itype(i))
1885 if (itypi.eq.ntyp1) cycle
1886 itypi1=iabs(itype(i+1))
1891 if (xi.lt.0) xi=xi+boxxsize
1893 if (yi.lt.0) yi=yi+boxysize
1895 if (zi.lt.0) zi=zi+boxzsize
1896 C define scaling factor for lipids
1898 C if (positi.le.0) positi=positi+boxzsize
1900 C first for peptide groups
1901 c for each residue check if it is in lipid or lipid water border area
1902 if ((zi.gt.bordlipbot)
1903 &.and.(zi.lt.bordliptop)) then
1904 C the energy transfer exist
1905 if (zi.lt.buflipbot) then
1906 C what fraction I am in
1908 & ((zi-bordlipbot)/lipbufthick)
1909 C lipbufthick is thickenes of lipid buffore
1910 sslipi=sscalelip(fracinbuf)
1911 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1912 elseif (zi.gt.bufliptop) then
1913 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1914 sslipi=sscalelip(fracinbuf)
1915 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1925 dxi=dc_norm(1,nres+i)
1926 dyi=dc_norm(2,nres+i)
1927 dzi=dc_norm(3,nres+i)
1928 c dsci_inv=dsc_inv(itypi)
1929 dsci_inv=vbld_inv(i+nres)
1931 C Calculate SC interaction energy.
1933 do iint=1,nint_gr(i)
1934 do j=istart(i,iint),iend(i,iint)
1936 itypj=iabs(itype(j))
1937 if (itypj.eq.ntyp1) cycle
1938 c dscj_inv=dsc_inv(itypj)
1939 dscj_inv=vbld_inv(j+nres)
1940 sig0ij=sigma(itypi,itypj)
1941 r0ij=r0(itypi,itypj)
1942 chi1=chi(itypi,itypj)
1943 chi2=chi(itypj,itypi)
1950 alf12=0.5D0*(alf1+alf2)
1951 C For diagnostics only!!!
1965 if (xj.lt.0) xj=xj+boxxsize
1967 if (yj.lt.0) yj=yj+boxysize
1969 if (zj.lt.0) zj=zj+boxzsize
1970 if ((zj.gt.bordlipbot)
1971 &.and.(zj.lt.bordliptop)) then
1972 C the energy transfer exist
1973 if (zj.lt.buflipbot) then
1974 C what fraction I am in
1976 & ((zj-bordlipbot)/lipbufthick)
1977 C lipbufthick is thickenes of lipid buffore
1978 sslipj=sscalelip(fracinbuf)
1979 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1980 elseif (zj.gt.bufliptop) then
1981 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1982 sslipj=sscalelip(fracinbuf)
1983 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1992 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1993 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1994 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1995 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1996 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
1997 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1998 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2006 xj=xj_safe+xshift*boxxsize
2007 yj=yj_safe+yshift*boxysize
2008 zj=zj_safe+zshift*boxzsize
2009 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2010 if(dist_temp.lt.dist_init) then
2020 if (subchap.eq.1) then
2029 dxj=dc_norm(1,nres+j)
2030 dyj=dc_norm(2,nres+j)
2031 dzj=dc_norm(3,nres+j)
2032 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2034 C Calculate angle-dependent terms of energy and contributions to their
2038 sig=sig0ij*dsqrt(sigsq)
2039 rij_shift=1.0D0/rij-sig+r0ij
2040 C I hate to put IF's in the loops, but here don't have another choice!!!!
2041 if (rij_shift.le.0.0D0) then
2046 c---------------------------------------------------------------
2047 rij_shift=1.0D0/rij_shift
2048 fac=rij_shift**expon
2051 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2052 eps2der=evdwij*eps3rt
2053 eps3der=evdwij*eps2rt
2054 fac_augm=rrij**expon
2055 e_augm=augm(itypi,itypj)*fac_augm
2056 evdwij=evdwij*eps2rt*eps3rt
2057 evdw=evdw+evdwij+e_augm
2059 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2061 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2062 & restyp(itypi),i,restyp(itypj),j,
2063 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2064 & chi1,chi2,chip1,chip2,
2065 & eps1,eps2rt**2,eps3rt**2,
2066 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2069 C Calculate gradient components.
2070 e1=e1*eps1*eps2rt**2*eps3rt**2
2071 fac=-expon*(e1+evdwij)*rij_shift
2073 fac=rij*fac-2*expon*rrij*e_augm
2074 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2075 C Calculate the radial part of the gradient
2079 C Calculate angular part of the gradient.
2085 C-----------------------------------------------------------------------------
2086 subroutine sc_angular
2087 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2088 C om12. Called by ebp, egb, and egbv.
2090 include 'COMMON.CALC'
2091 include 'COMMON.IOUNITS'
2095 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2096 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2097 om12=dxi*dxj+dyi*dyj+dzi*dzj
2099 C Calculate eps1(om12) and its derivative in om12
2100 faceps1=1.0D0-om12*chiom12
2101 faceps1_inv=1.0D0/faceps1
2102 eps1=dsqrt(faceps1_inv)
2103 C Following variable is eps1*deps1/dom12
2104 eps1_om12=faceps1_inv*chiom12
2109 c write (iout,*) "om12",om12," eps1",eps1
2110 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2115 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2116 sigsq=1.0D0-facsig*faceps1_inv
2117 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2118 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2119 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2125 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2126 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2128 C Calculate eps2 and its derivatives in om1, om2, and om12.
2131 chipom12=chip12*om12
2132 facp=1.0D0-om12*chipom12
2134 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2135 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2136 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2137 C Following variable is the square root of eps2
2138 eps2rt=1.0D0-facp1*facp_inv
2139 C Following three variables are the derivatives of the square root of eps
2140 C in om1, om2, and om12.
2141 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2142 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2143 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2144 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2145 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2146 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2147 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2148 c & " eps2rt_om12",eps2rt_om12
2149 C Calculate whole angle-dependent part of epsilon and contributions
2150 C to its derivatives
2153 C----------------------------------------------------------------------------
2155 implicit real*8 (a-h,o-z)
2156 include 'DIMENSIONS'
2157 include 'COMMON.CHAIN'
2158 include 'COMMON.DERIV'
2159 include 'COMMON.CALC'
2160 include 'COMMON.IOUNITS'
2161 double precision dcosom1(3),dcosom2(3)
2162 cc print *,'sss=',sss
2163 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2164 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2165 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2166 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2170 c eom12=evdwij*eps1_om12
2172 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2173 c & " sigder",sigder
2174 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2175 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2177 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2178 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2181 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2183 c write (iout,*) "gg",(gg(k),k=1,3)
2185 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2186 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2187 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2188 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2189 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2190 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2191 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2192 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2193 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2194 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2197 C Calculate the components of the gradient in DC and X
2201 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2205 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2206 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2210 C-----------------------------------------------------------------------
2211 subroutine e_softsphere(evdw)
2213 C This subroutine calculates the interaction energy of nonbonded side chains
2214 C assuming the LJ potential of interaction.
2216 implicit real*8 (a-h,o-z)
2217 include 'DIMENSIONS'
2218 parameter (accur=1.0d-10)
2219 include 'COMMON.GEO'
2220 include 'COMMON.VAR'
2221 include 'COMMON.LOCAL'
2222 include 'COMMON.CHAIN'
2223 include 'COMMON.DERIV'
2224 include 'COMMON.INTERACT'
2225 include 'COMMON.TORSION'
2226 include 'COMMON.SBRIDGE'
2227 include 'COMMON.NAMES'
2228 include 'COMMON.IOUNITS'
2229 include 'COMMON.CONTACTS'
2231 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2233 do i=iatsc_s,iatsc_e
2234 itypi=iabs(itype(i))
2235 if (itypi.eq.ntyp1) cycle
2236 itypi1=iabs(itype(i+1))
2241 C Calculate SC interaction energy.
2243 do iint=1,nint_gr(i)
2244 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2245 cd & 'iend=',iend(i,iint)
2246 do j=istart(i,iint),iend(i,iint)
2247 itypj=iabs(itype(j))
2248 if (itypj.eq.ntyp1) cycle
2252 rij=xj*xj+yj*yj+zj*zj
2253 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2254 r0ij=r0(itypi,itypj)
2256 c print *,i,j,r0ij,dsqrt(rij)
2257 if (rij.lt.r0ijsq) then
2258 evdwij=0.25d0*(rij-r0ijsq)**2
2266 C Calculate the components of the gradient in DC and X
2272 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2273 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2274 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2275 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2279 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2287 C--------------------------------------------------------------------------
2288 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2291 C Soft-sphere potential of p-p interaction
2293 implicit real*8 (a-h,o-z)
2294 include 'DIMENSIONS'
2295 include 'COMMON.CONTROL'
2296 include 'COMMON.IOUNITS'
2297 include 'COMMON.GEO'
2298 include 'COMMON.VAR'
2299 include 'COMMON.LOCAL'
2300 include 'COMMON.CHAIN'
2301 include 'COMMON.DERIV'
2302 include 'COMMON.INTERACT'
2303 include 'COMMON.CONTACTS'
2304 include 'COMMON.TORSION'
2305 include 'COMMON.VECTORS'
2306 include 'COMMON.FFIELD'
2308 C write(iout,*) 'In EELEC_soft_sphere'
2315 do i=iatel_s,iatel_e
2316 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2320 xmedi=c(1,i)+0.5d0*dxi
2321 ymedi=c(2,i)+0.5d0*dyi
2322 zmedi=c(3,i)+0.5d0*dzi
2323 xmedi=mod(xmedi,boxxsize)
2324 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2325 ymedi=mod(ymedi,boxysize)
2326 if (ymedi.lt.0) ymedi=ymedi+boxysize
2327 zmedi=mod(zmedi,boxzsize)
2328 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2330 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2331 do j=ielstart(i),ielend(i)
2332 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2336 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2337 r0ij=rpp(iteli,itelj)
2346 if (xj.lt.0) xj=xj+boxxsize
2348 if (yj.lt.0) yj=yj+boxysize
2350 if (zj.lt.0) zj=zj+boxzsize
2351 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2359 xj=xj_safe+xshift*boxxsize
2360 yj=yj_safe+yshift*boxysize
2361 zj=zj_safe+zshift*boxzsize
2362 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2363 if(dist_temp.lt.dist_init) then
2373 if (isubchap.eq.1) then
2382 rij=xj*xj+yj*yj+zj*zj
2383 sss=sscale(sqrt(rij))
2384 sssgrad=sscagrad(sqrt(rij))
2385 if (rij.lt.r0ijsq) then
2386 evdw1ij=0.25d0*(rij-r0ijsq)**2
2392 evdw1=evdw1+evdw1ij*sss
2394 C Calculate contributions to the Cartesian gradient.
2396 ggg(1)=fac*xj*sssgrad
2397 ggg(2)=fac*yj*sssgrad
2398 ggg(3)=fac*zj*sssgrad
2400 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2401 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2404 * Loop over residues i+1 thru j-1.
2408 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2413 cgrad do i=nnt,nct-1
2415 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2417 cgrad do j=i+1,nct-1
2419 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2425 c------------------------------------------------------------------------------
2426 subroutine vec_and_deriv
2427 implicit real*8 (a-h,o-z)
2428 include 'DIMENSIONS'
2432 include 'COMMON.IOUNITS'
2433 include 'COMMON.GEO'
2434 include 'COMMON.VAR'
2435 include 'COMMON.LOCAL'
2436 include 'COMMON.CHAIN'
2437 include 'COMMON.VECTORS'
2438 include 'COMMON.SETUP'
2439 include 'COMMON.TIME1'
2440 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2441 C Compute the local reference systems. For reference system (i), the
2442 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2443 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2445 do i=ivec_start,ivec_end
2449 if (i.eq.nres-1) then
2450 C Case of the last full residue
2451 C Compute the Z-axis
2452 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2453 costh=dcos(pi-theta(nres))
2454 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2458 C Compute the derivatives of uz
2460 uzder(2,1,1)=-dc_norm(3,i-1)
2461 uzder(3,1,1)= dc_norm(2,i-1)
2462 uzder(1,2,1)= dc_norm(3,i-1)
2464 uzder(3,2,1)=-dc_norm(1,i-1)
2465 uzder(1,3,1)=-dc_norm(2,i-1)
2466 uzder(2,3,1)= dc_norm(1,i-1)
2469 uzder(2,1,2)= dc_norm(3,i)
2470 uzder(3,1,2)=-dc_norm(2,i)
2471 uzder(1,2,2)=-dc_norm(3,i)
2473 uzder(3,2,2)= dc_norm(1,i)
2474 uzder(1,3,2)= dc_norm(2,i)
2475 uzder(2,3,2)=-dc_norm(1,i)
2477 C Compute the Y-axis
2480 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2482 C Compute the derivatives of uy
2485 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2486 & -dc_norm(k,i)*dc_norm(j,i-1)
2487 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2489 uyder(j,j,1)=uyder(j,j,1)-costh
2490 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2495 uygrad(l,k,j,i)=uyder(l,k,j)
2496 uzgrad(l,k,j,i)=uzder(l,k,j)
2500 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2501 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2502 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2503 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2506 C Compute the Z-axis
2507 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2508 costh=dcos(pi-theta(i+2))
2509 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2513 C Compute the derivatives of uz
2515 uzder(2,1,1)=-dc_norm(3,i+1)
2516 uzder(3,1,1)= dc_norm(2,i+1)
2517 uzder(1,2,1)= dc_norm(3,i+1)
2519 uzder(3,2,1)=-dc_norm(1,i+1)
2520 uzder(1,3,1)=-dc_norm(2,i+1)
2521 uzder(2,3,1)= dc_norm(1,i+1)
2524 uzder(2,1,2)= dc_norm(3,i)
2525 uzder(3,1,2)=-dc_norm(2,i)
2526 uzder(1,2,2)=-dc_norm(3,i)
2528 uzder(3,2,2)= dc_norm(1,i)
2529 uzder(1,3,2)= dc_norm(2,i)
2530 uzder(2,3,2)=-dc_norm(1,i)
2532 C Compute the Y-axis
2535 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2537 C Compute the derivatives of uy
2540 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2541 & -dc_norm(k,i)*dc_norm(j,i+1)
2542 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2544 uyder(j,j,1)=uyder(j,j,1)-costh
2545 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2550 uygrad(l,k,j,i)=uyder(l,k,j)
2551 uzgrad(l,k,j,i)=uzder(l,k,j)
2555 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2556 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2557 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2558 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2562 vbld_inv_temp(1)=vbld_inv(i+1)
2563 if (i.lt.nres-1) then
2564 vbld_inv_temp(2)=vbld_inv(i+2)
2566 vbld_inv_temp(2)=vbld_inv(i)
2571 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2572 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2577 #if defined(PARVEC) && defined(MPI)
2578 if (nfgtasks1.gt.1) then
2580 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2581 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2582 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2583 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2584 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2586 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2587 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2589 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2590 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2591 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2592 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2593 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2594 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2595 time_gather=time_gather+MPI_Wtime()-time00
2597 c if (fg_rank.eq.0) then
2598 c write (iout,*) "Arrays UY and UZ"
2600 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2607 C-----------------------------------------------------------------------------
2608 subroutine check_vecgrad
2609 implicit real*8 (a-h,o-z)
2610 include 'DIMENSIONS'
2611 include 'COMMON.IOUNITS'
2612 include 'COMMON.GEO'
2613 include 'COMMON.VAR'
2614 include 'COMMON.LOCAL'
2615 include 'COMMON.CHAIN'
2616 include 'COMMON.VECTORS'
2617 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2618 dimension uyt(3,maxres),uzt(3,maxres)
2619 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2620 double precision delta /1.0d-7/
2623 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2624 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2625 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2626 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2627 cd & (dc_norm(if90,i),if90=1,3)
2628 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2629 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2630 cd write(iout,'(a)')
2636 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2637 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2650 cd write (iout,*) 'i=',i
2652 erij(k)=dc_norm(k,i)
2656 dc_norm(k,i)=erij(k)
2658 dc_norm(j,i)=dc_norm(j,i)+delta
2659 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2661 c dc_norm(k,i)=dc_norm(k,i)/fac
2663 c write (iout,*) (dc_norm(k,i),k=1,3)
2664 c write (iout,*) (erij(k),k=1,3)
2667 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2668 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2669 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2670 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2672 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2673 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2674 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2677 dc_norm(k,i)=erij(k)
2680 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2681 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2682 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2683 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2684 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2685 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2686 cd write (iout,'(a)')
2691 C--------------------------------------------------------------------------
2692 subroutine set_matrices
2693 implicit real*8 (a-h,o-z)
2694 include 'DIMENSIONS'
2697 include "COMMON.SETUP"
2699 integer status(MPI_STATUS_SIZE)
2701 include 'COMMON.IOUNITS'
2702 include 'COMMON.GEO'
2703 include 'COMMON.VAR'
2704 include 'COMMON.LOCAL'
2705 include 'COMMON.CHAIN'
2706 include 'COMMON.DERIV'
2707 include 'COMMON.INTERACT'
2708 include 'COMMON.CONTACTS'
2709 include 'COMMON.TORSION'
2710 include 'COMMON.VECTORS'
2711 include 'COMMON.FFIELD'
2712 double precision auxvec(2),auxmat(2,2)
2714 C Compute the virtual-bond-torsional-angle dependent quantities needed
2715 C to calculate the el-loc multibody terms of various order.
2717 c write(iout,*) 'nphi=',nphi,nres
2719 do i=ivec_start+2,ivec_end+2
2724 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2725 iti = itortyp(itype(i-2))
2729 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2730 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2731 iti1 = itortyp(itype(i-1))
2736 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2737 & +bnew1(2,1,iti)*dsin(theta(i-1))
2738 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2739 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2740 & +bnew1(2,1,iti)*dcos(theta(i-1))
2741 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2742 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2743 c &*(cos(theta(i)/2.0)
2744 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2745 & +bnew2(2,1,iti)*dsin(theta(i-1))
2746 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2747 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2748 c &*(cos(theta(i)/2.0)
2749 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2750 & +bnew2(2,1,iti)*dcos(theta(i-1))
2751 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2752 c if (ggb1(1,i).eq.0.0d0) then
2753 c write(iout,*) 'i=',i,ggb1(1,i),
2754 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2755 c &bnew1(2,1,iti)*cos(theta(i)),
2756 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2758 b1(2,i-2)=bnew1(1,2,iti)
2760 b2(2,i-2)=bnew2(1,2,iti)
2762 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2763 EE(1,2,i-2)=eeold(1,2,iti)
2764 EE(2,1,i-2)=eeold(2,1,iti)
2765 EE(2,2,i-2)=eeold(2,2,iti)
2766 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2771 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2772 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2773 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2774 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2775 b1tilde(1,i-2)=b1(1,i-2)
2776 b1tilde(2,i-2)=-b1(2,i-2)
2777 b2tilde(1,i-2)=b2(1,i-2)
2778 b2tilde(2,i-2)=-b2(2,i-2)
2779 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2780 c write(iout,*) 'b1=',b1(1,i-2)
2781 c write (iout,*) 'theta=', theta(i-1)
2784 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2785 iti = itortyp(itype(i-2))
2789 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2790 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2791 iti1 = itortyp(itype(i-1))
2799 b1tilde(1,i-2)=b1(1,i-2)
2800 b1tilde(2,i-2)=-b1(2,i-2)
2801 b2tilde(1,i-2)=b2(1,i-2)
2802 b2tilde(2,i-2)=-b2(2,i-2)
2803 EE(1,2,i-2)=eeold(1,2,iti)
2804 EE(2,1,i-2)=eeold(2,1,iti)
2805 EE(2,2,i-2)=eeold(2,2,iti)
2806 EE(1,1,i-2)=eeold(1,1,iti)
2810 do i=ivec_start+2,ivec_end+2
2814 if (i .lt. nres+1) then
2851 if (i .gt. 3 .and. i .lt. nres+1) then
2852 obrot_der(1,i-2)=-sin1
2853 obrot_der(2,i-2)= cos1
2854 Ugder(1,1,i-2)= sin1
2855 Ugder(1,2,i-2)=-cos1
2856 Ugder(2,1,i-2)=-cos1
2857 Ugder(2,2,i-2)=-sin1
2860 obrot2_der(1,i-2)=-dwasin2
2861 obrot2_der(2,i-2)= dwacos2
2862 Ug2der(1,1,i-2)= dwasin2
2863 Ug2der(1,2,i-2)=-dwacos2
2864 Ug2der(2,1,i-2)=-dwacos2
2865 Ug2der(2,2,i-2)=-dwasin2
2867 obrot_der(1,i-2)=0.0d0
2868 obrot_der(2,i-2)=0.0d0
2869 Ugder(1,1,i-2)=0.0d0
2870 Ugder(1,2,i-2)=0.0d0
2871 Ugder(2,1,i-2)=0.0d0
2872 Ugder(2,2,i-2)=0.0d0
2873 obrot2_der(1,i-2)=0.0d0
2874 obrot2_der(2,i-2)=0.0d0
2875 Ug2der(1,1,i-2)=0.0d0
2876 Ug2der(1,2,i-2)=0.0d0
2877 Ug2der(2,1,i-2)=0.0d0
2878 Ug2der(2,2,i-2)=0.0d0
2880 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2881 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2882 iti = itortyp(itype(i-2))
2886 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2887 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2888 iti1 = itortyp(itype(i-1))
2892 cd write (iout,*) '*******i',i,' iti1',iti
2893 cd write (iout,*) 'b1',b1(:,iti)
2894 cd write (iout,*) 'b2',b2(:,iti)
2895 cd write (iout,*) "phi(",i,")=",phi(i)," sin1",sin1," cos1",cos1
2896 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2897 c if (i .gt. iatel_s+2) then
2898 if (i .gt. nnt+2) then
2899 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2901 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2902 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2904 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2905 c & EE(1,2,iti),EE(2,2,iti)
2906 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2907 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2908 c write(iout,*) "Macierz EUG",
2909 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2911 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2913 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2914 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2915 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2916 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2917 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2928 DtUg2(l,k,i-2)=0.0d0
2932 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2933 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2935 muder(k,i-2)=Ub2der(k,i-2)
2937 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2938 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2939 if (itype(i-1).le.ntyp) then
2940 iti1 = itortyp(itype(i-1))
2948 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2950 C write (iout,*) 'mumu',i,b1(1,i-1),Ub2(1,i-2)
2951 cd write (iout,*) 'mu ',mu(:,i-2),i-2
2952 cd write (iout,*) 'b1 ',b1(:,i-1),i-2
2953 cd write (iout,*) 'Ub2 ',Ub2(:,i-2),i-2
2954 cd write (iout,*) 'Ug ',Ug(:,:,i-2),i-2
2955 cd write (iout,*) 'b2 ',b2(:,i-2),i-2
2956 cd write (iout,*) 'mu1',mu1(:,i-2)
2957 cd write (iout,*) 'mu2',mu2(:,i-2)
2958 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2960 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2961 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2962 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2963 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2964 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2965 C Vectors and matrices dependent on a single virtual-bond dihedral.
2966 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2967 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2968 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2969 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2970 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2971 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2972 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2973 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2974 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2977 C Matrices dependent on two consecutive virtual-bond dihedrals.
2978 C The order of matrices is from left to right.
2979 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2981 c do i=max0(ivec_start,2),ivec_end
2983 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2984 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2985 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2986 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2987 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2988 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2989 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2990 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2993 #if defined(MPI) && defined(PARMAT)
2995 c if (fg_rank.eq.0) then
2996 write (iout,*) "Arrays UG and UGDER before GATHER"
2998 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2999 & ((ug(l,k,i),l=1,2),k=1,2),
3000 & ((ugder(l,k,i),l=1,2),k=1,2)
3002 write (iout,*) "Arrays UG2 and UG2DER"
3004 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3005 & ((ug2(l,k,i),l=1,2),k=1,2),
3006 & ((ug2der(l,k,i),l=1,2),k=1,2)
3008 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3010 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3011 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3012 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3014 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3016 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3017 & costab(i),sintab(i),costab2(i),sintab2(i)
3019 write (iout,*) "Array MUDER"
3021 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3025 if (nfgtasks.gt.1) then
3027 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
3028 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
3029 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
3031 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
3032 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3034 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
3035 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3037 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
3038 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3040 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
3041 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3043 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
3044 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3046 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
3047 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3049 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
3050 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
3051 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3052 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
3053 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
3054 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3055 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
3056 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
3057 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3058 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
3059 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
3060 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3061 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3063 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
3064 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3066 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
3067 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3069 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
3070 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3072 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3073 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3075 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3076 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3078 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3079 & ivec_count(fg_rank1),
3080 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3082 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3083 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3085 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3086 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3088 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3089 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3091 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3092 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3094 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3095 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3097 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3098 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3100 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3101 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3103 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3104 & ivec_count(fg_rank1),
3105 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3107 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3108 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3110 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3111 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3113 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3114 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3116 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3117 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3119 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3120 & ivec_count(fg_rank1),
3121 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3123 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3124 & ivec_count(fg_rank1),
3125 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3127 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3128 & ivec_count(fg_rank1),
3129 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3130 & MPI_MAT2,FG_COMM1,IERR)
3131 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3132 & ivec_count(fg_rank1),
3133 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3134 & MPI_MAT2,FG_COMM1,IERR)
3137 c Passes matrix info through the ring
3140 if (irecv.lt.0) irecv=nfgtasks1-1
3143 if (inext.ge.nfgtasks1) inext=0
3145 c write (iout,*) "isend",isend," irecv",irecv
3147 lensend=lentyp(isend)
3148 lenrecv=lentyp(irecv)
3149 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3150 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3151 c & MPI_ROTAT1(lensend),inext,2200+isend,
3152 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3153 c & iprev,2200+irecv,FG_COMM,status,IERR)
3154 c write (iout,*) "Gather ROTAT1"
3156 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3157 c & MPI_ROTAT2(lensend),inext,3300+isend,
3158 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3159 c & iprev,3300+irecv,FG_COMM,status,IERR)
3160 c write (iout,*) "Gather ROTAT2"
3162 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3163 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3164 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3165 & iprev,4400+irecv,FG_COMM,status,IERR)
3166 c write (iout,*) "Gather ROTAT_OLD"
3168 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3169 & MPI_PRECOMP11(lensend),inext,5500+isend,
3170 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3171 & iprev,5500+irecv,FG_COMM,status,IERR)
3172 c write (iout,*) "Gather PRECOMP11"
3174 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3175 & MPI_PRECOMP12(lensend),inext,6600+isend,
3176 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3177 & iprev,6600+irecv,FG_COMM,status,IERR)
3178 c write (iout,*) "Gather PRECOMP12"
3180 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3182 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3183 & MPI_ROTAT2(lensend),inext,7700+isend,
3184 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3185 & iprev,7700+irecv,FG_COMM,status,IERR)
3186 c write (iout,*) "Gather PRECOMP21"
3188 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3189 & MPI_PRECOMP22(lensend),inext,8800+isend,
3190 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3191 & iprev,8800+irecv,FG_COMM,status,IERR)
3192 c write (iout,*) "Gather PRECOMP22"
3194 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3195 & MPI_PRECOMP23(lensend),inext,9900+isend,
3196 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3197 & MPI_PRECOMP23(lenrecv),
3198 & iprev,9900+irecv,FG_COMM,status,IERR)
3199 c write (iout,*) "Gather PRECOMP23"
3204 if (irecv.lt.0) irecv=nfgtasks1-1
3207 time_gather=time_gather+MPI_Wtime()-time00
3210 c if (fg_rank.eq.0) then
3211 write (iout,*) "Arrays UG and UGDER"
3213 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3214 & ((ug(l,k,i),l=1,2),k=1,2),
3215 & ((ugder(l,k,i),l=1,2),k=1,2)
3217 write (iout,*) "Arrays UG2 and UG2DER"
3219 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3220 & ((ug2(l,k,i),l=1,2),k=1,2),
3221 & ((ug2der(l,k,i),l=1,2),k=1,2)
3223 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3225 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3226 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3227 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3229 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3231 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3232 & costab(i),sintab(i),costab2(i),sintab2(i)
3234 write (iout,*) "Array MUDER"
3236 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3242 cd iti = itortyp(itype(i))
3245 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3246 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3251 C--------------------------------------------------------------------------
3252 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3254 C This subroutine calculates the average interaction energy and its gradient
3255 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3256 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3257 C The potential depends both on the distance of peptide-group centers and on
3258 C the orientation of the CA-CA virtual bonds.
3260 implicit real*8 (a-h,o-z)
3264 include 'DIMENSIONS'
3265 include 'COMMON.CONTROL'
3266 include 'COMMON.SETUP'
3267 include 'COMMON.IOUNITS'
3268 include 'COMMON.GEO'
3269 include 'COMMON.VAR'
3270 include 'COMMON.LOCAL'
3271 include 'COMMON.CHAIN'
3272 include 'COMMON.DERIV'
3273 include 'COMMON.INTERACT'
3274 include 'COMMON.CONTACTS'
3275 include 'COMMON.TORSION'
3276 include 'COMMON.VECTORS'
3277 include 'COMMON.FFIELD'
3278 include 'COMMON.TIME1'
3279 include 'COMMON.SPLITELE'
3280 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3281 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3282 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3283 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3284 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3285 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3287 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3289 double precision scal_el /1.0d0/
3291 double precision scal_el /0.5d0/
3294 C 13-go grudnia roku pamietnego...
3295 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3296 & 0.0d0,1.0d0,0.0d0,
3297 & 0.0d0,0.0d0,1.0d0/
3298 cd write(iout,*) 'In EELEC'
3300 cd write(iout,*) 'Type',i
3301 cd write(iout,*) 'B1',B1(:,i)
3302 cd write(iout,*) 'B2',B2(:,i)
3303 cd write(iout,*) 'CC',CC(:,:,i)
3304 cd write(iout,*) 'DD',DD(:,:,i)
3305 cd write(iout,*) 'EE',EE(:,:,i)
3307 cd call check_vecgrad
3309 if (icheckgrad.eq.1) then
3311 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3313 dc_norm(k,i)=dc(k,i)*fac
3315 c write (iout,*) 'i',i,' fac',fac
3318 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3319 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3320 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3321 c call vec_and_deriv
3327 time_mat=time_mat+MPI_Wtime()-time01
3331 cd write (iout,*) 'i=',i
3333 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3336 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3337 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3350 cd print '(a)','Enter EELEC'
3351 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3353 gel_loc_loc(i)=0.0d0
3358 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3360 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3362 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3363 do i=iturn3_start,iturn3_end
3364 CAna if (i.le.1) cycle
3365 C write(iout,*) "tu jest i",i
3366 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3367 C changes suggested by Ana to avoid out of bounds
3368 CAna & .or.((i+4).gt.nres)
3369 CAna & .or.((i-1).le.0)
3370 C end of changes by Ana
3371 & .or. itype(i+2).eq.ntyp1
3372 & .or. itype(i+3).eq.ntyp1) cycle
3374 CAna if(itype(i-1).eq.ntyp1)cycle
3376 CAna if(i.LT.nres-3)then
3377 CAna if (itype(i+4).eq.ntyp1) cycle
3382 dx_normi=dc_norm(1,i)
3383 dy_normi=dc_norm(2,i)
3384 dz_normi=dc_norm(3,i)
3385 xmedi=c(1,i)+0.5d0*dxi
3386 ymedi=c(2,i)+0.5d0*dyi
3387 zmedi=c(3,i)+0.5d0*dzi
3388 xmedi=mod(xmedi,boxxsize)
3389 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3390 ymedi=mod(ymedi,boxysize)
3391 if (ymedi.lt.0) ymedi=ymedi+boxysize
3392 zmedi=mod(zmedi,boxzsize)
3393 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3395 call eelecij(i,i+2,ees,evdw1,eel_loc)
3396 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3397 num_cont_hb(i)=num_conti
3399 do i=iturn4_start,iturn4_end
3400 cAna if (i.le.1) cycle
3401 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3402 C changes suggested by Ana to avoid out of bounds
3403 cAna & .or.((i+5).gt.nres)
3404 cAna & .or.((i-1).le.0)
3405 C end of changes suggested by Ana
3406 & .or. itype(i+3).eq.ntyp1
3407 & .or. itype(i+4).eq.ntyp1
3408 cAna & .or. itype(i+5).eq.ntyp1
3409 cAna & .or. itype(i).eq.ntyp1
3410 cAna & .or. itype(i-1).eq.ntyp1
3415 dx_normi=dc_norm(1,i)
3416 dy_normi=dc_norm(2,i)
3417 dz_normi=dc_norm(3,i)
3418 xmedi=c(1,i)+0.5d0*dxi
3419 ymedi=c(2,i)+0.5d0*dyi
3420 zmedi=c(3,i)+0.5d0*dzi
3421 C Return atom into box, boxxsize is size of box in x dimension
3423 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3424 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3425 C Condition for being inside the proper box
3426 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3427 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3431 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3432 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3433 C Condition for being inside the proper box
3434 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3435 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3439 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3440 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3441 C Condition for being inside the proper box
3442 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3443 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3446 xmedi=mod(xmedi,boxxsize)
3447 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3448 ymedi=mod(ymedi,boxysize)
3449 if (ymedi.lt.0) ymedi=ymedi+boxysize
3450 zmedi=mod(zmedi,boxzsize)
3451 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3453 num_conti=num_cont_hb(i)
3454 c write(iout,*) "JESTEM W PETLI"
3455 call eelecij(i,i+3,ees,evdw1,eel_loc)
3456 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3457 & call eturn4(i,eello_turn4)
3458 num_cont_hb(i)=num_conti
3460 C Loop over all neighbouring boxes
3465 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3467 do i=iatel_s,iatel_e
3468 cAna if (i.le.1) cycle
3469 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3470 C changes suggested by Ana to avoid out of bounds
3471 cAna & .or.((i+2).gt.nres)
3472 cAna & .or.((i-1).le.0)
3473 C end of changes by Ana
3474 cAna & .or. itype(i+2).eq.ntyp1
3475 cAna & .or. itype(i-1).eq.ntyp1
3480 dx_normi=dc_norm(1,i)
3481 dy_normi=dc_norm(2,i)
3482 dz_normi=dc_norm(3,i)
3483 xmedi=c(1,i)+0.5d0*dxi
3484 ymedi=c(2,i)+0.5d0*dyi
3485 zmedi=c(3,i)+0.5d0*dzi
3486 xmedi=mod(xmedi,boxxsize)
3487 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3488 ymedi=mod(ymedi,boxysize)
3489 if (ymedi.lt.0) ymedi=ymedi+boxysize
3490 zmedi=mod(zmedi,boxzsize)
3491 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3492 C xmedi=xmedi+xshift*boxxsize
3493 C ymedi=ymedi+yshift*boxysize
3494 C zmedi=zmedi+zshift*boxzsize
3496 C Return tom into box, boxxsize is size of box in x dimension
3498 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3499 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3500 C Condition for being inside the proper box
3501 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3502 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3506 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3507 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3508 C Condition for being inside the proper box
3509 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3510 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3514 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3515 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3516 cC Condition for being inside the proper box
3517 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3518 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3522 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3523 num_conti=num_cont_hb(i)
3524 do j=ielstart(i),ielend(i)
3525 C write (iout,*) i,j
3526 cAna if (j.le.1) cycle
3527 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3528 C changes suggested by Ana to avoid out of bounds
3529 cAna & .or.((j+2).gt.nres)
3530 cAna & .or.((j-1).le.0)
3531 C end of changes by Ana
3532 cAna & .or.itype(j+2).eq.ntyp1
3533 cAna & .or.itype(j-1).eq.ntyp1
3535 call eelecij(i,j,ees,evdw1,eel_loc)
3537 num_cont_hb(i)=num_conti
3543 c write (iout,*) "Number of loop steps in EELEC:",ind
3545 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3546 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3548 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3549 ccc eel_loc=eel_loc+eello_turn3
3550 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3553 C-------------------------------------------------------------------------------
3554 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3555 implicit real*8 (a-h,o-z)
3556 include 'DIMENSIONS'
3560 include 'COMMON.CONTROL'
3561 include 'COMMON.IOUNITS'
3562 include 'COMMON.GEO'
3563 include 'COMMON.VAR'
3564 include 'COMMON.LOCAL'
3565 include 'COMMON.CHAIN'
3566 include 'COMMON.DERIV'
3567 include 'COMMON.INTERACT'
3568 include 'COMMON.CONTACTS'
3569 include 'COMMON.TORSION'
3570 include 'COMMON.VECTORS'
3571 include 'COMMON.FFIELD'
3572 include 'COMMON.TIME1'
3573 include 'COMMON.SPLITELE'
3574 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3575 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3576 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3577 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3578 & gmuij2(4),gmuji2(4)
3579 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3580 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3582 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3584 double precision scal_el /1.0d0/
3586 double precision scal_el /0.5d0/
3589 C 13-go grudnia roku pamietnego...
3590 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3591 & 0.0d0,1.0d0,0.0d0,
3592 & 0.0d0,0.0d0,1.0d0/
3593 c time00=MPI_Wtime()
3594 cd write (iout,*) "eelecij",i,j
3598 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3599 aaa=app(iteli,itelj)
3600 bbb=bpp(iteli,itelj)
3601 ael6i=ael6(iteli,itelj)
3602 ael3i=ael3(iteli,itelj)
3606 dx_normj=dc_norm(1,j)
3607 dy_normj=dc_norm(2,j)
3608 dz_normj=dc_norm(3,j)
3609 C xj=c(1,j)+0.5D0*dxj-xmedi
3610 C yj=c(2,j)+0.5D0*dyj-ymedi
3611 C zj=c(3,j)+0.5D0*dzj-zmedi
3616 if (xj.lt.0) xj=xj+boxxsize
3618 if (yj.lt.0) yj=yj+boxysize
3620 if (zj.lt.0) zj=zj+boxzsize
3621 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3622 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3630 xj=xj_safe+xshift*boxxsize
3631 yj=yj_safe+yshift*boxysize
3632 zj=zj_safe+zshift*boxzsize
3633 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3634 if(dist_temp.lt.dist_init) then
3644 if (isubchap.eq.1) then
3653 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3655 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3656 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3657 C Condition for being inside the proper box
3658 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3659 c & (xj.lt.((-0.5d0)*boxxsize))) then
3663 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3664 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3665 C Condition for being inside the proper box
3666 c if ((yj.gt.((0.5d0)*boxysize)).or.
3667 c & (yj.lt.((-0.5d0)*boxysize))) then
3671 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3672 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3673 C Condition for being inside the proper box
3674 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3675 c & (zj.lt.((-0.5d0)*boxzsize))) then
3678 C endif !endPBC condintion
3682 rij=xj*xj+yj*yj+zj*zj
3684 sss=sscale(sqrt(rij))
3685 sssgrad=sscagrad(sqrt(rij))
3686 c if (sss.gt.0.0d0) then
3692 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3693 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3694 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3695 fac=cosa-3.0D0*cosb*cosg
3697 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3698 if (j.eq.i+2) ev1=scal_el*ev1
3703 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3707 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3708 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3710 evdw1=evdw1+evdwij*sss
3711 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3712 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3713 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3714 cd & xmedi,ymedi,zmedi,xj,yj,zj
3716 if (energy_dec) then
3717 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3719 c &,iteli,itelj,aaa,evdw1
3720 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3724 C Calculate contributions to the Cartesian gradient.
3727 facvdw=-6*rrmij*(ev1+evdwij)*sss
3728 facel=-3*rrmij*(el1+eesij)
3734 * Radial derivatives. First process both termini of the fragment (i,j)
3740 c ghalf=0.5D0*ggg(k)
3741 c gelc(k,i)=gelc(k,i)+ghalf
3742 c gelc(k,j)=gelc(k,j)+ghalf
3744 c 9/28/08 AL Gradient compotents will be summed only at the end
3746 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3747 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3750 * Loop over residues i+1 thru j-1.
3754 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3757 if (sss.gt.0.0) then
3758 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3759 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3760 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3767 c ghalf=0.5D0*ggg(k)
3768 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3769 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3771 c 9/28/08 AL Gradient compotents will be summed only at the end
3773 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3774 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3777 * Loop over residues i+1 thru j-1.
3781 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3786 facvdw=(ev1+evdwij)*sss
3789 fac=-3*rrmij*(facvdw+facvdw+facel)
3794 * Radial derivatives. First process both termini of the fragment (i,j)
3800 c ghalf=0.5D0*ggg(k)
3801 c gelc(k,i)=gelc(k,i)+ghalf
3802 c gelc(k,j)=gelc(k,j)+ghalf
3804 c 9/28/08 AL Gradient compotents will be summed only at the end
3806 gelc_long(k,j)=gelc(k,j)+ggg(k)
3807 gelc_long(k,i)=gelc(k,i)-ggg(k)
3810 * Loop over residues i+1 thru j-1.
3814 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3817 c 9/28/08 AL Gradient compotents will be summed only at the end
3818 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3819 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3820 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3822 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3823 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3829 ecosa=2.0D0*fac3*fac1+fac4
3832 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3833 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3835 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3836 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3838 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3839 cd & (dcosg(k),k=1,3)
3841 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3844 c ghalf=0.5D0*ggg(k)
3845 c gelc(k,i)=gelc(k,i)+ghalf
3846 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3847 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3848 c gelc(k,j)=gelc(k,j)+ghalf
3849 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3850 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3854 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3859 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3860 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3862 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3863 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3864 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3865 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3869 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3870 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3871 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3873 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3874 C energy of a peptide unit is assumed in the form of a second-order
3875 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3876 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3877 C are computed for EVERY pair of non-contiguous peptide groups.
3880 if (j.lt.nres-1) then
3892 muij(kkk)=mu(k,i)*mu(l,j)
3893 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3895 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3896 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3897 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3898 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3899 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3900 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3904 cd write (iout,*) 'EELEC: i',i,' j',j
3905 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3906 cd write(iout,*) 'muij',muij
3907 ury=scalar(uy(1,i),erij)
3908 urz=scalar(uz(1,i),erij)
3909 vry=scalar(uy(1,j),erij)
3910 vrz=scalar(uz(1,j),erij)
3911 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3912 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3913 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3914 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3915 fac=dsqrt(-ael6i)*r3ij
3920 cd write (iout,'(4i5,4f10.5)')
3921 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3922 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3923 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3924 cd & uy(:,j),uz(:,j)
3925 cd write (iout,'(4f10.5)')
3926 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3927 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3928 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3929 cd write (iout,'(9f10.5/)')
3930 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3931 C Derivatives of the elements of A in virtual-bond vectors
3932 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3934 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3935 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3936 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3937 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3938 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3939 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3940 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3941 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3942 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3943 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3944 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3945 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3947 C Compute radial contributions to the gradient
3965 C Add the contributions coming from er
3968 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3969 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3970 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3971 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3974 C Derivatives in DC(i)
3975 cgrad ghalf1=0.5d0*agg(k,1)
3976 cgrad ghalf2=0.5d0*agg(k,2)
3977 cgrad ghalf3=0.5d0*agg(k,3)
3978 cgrad ghalf4=0.5d0*agg(k,4)
3979 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3980 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3981 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3982 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3983 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3984 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3985 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3986 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3987 C Derivatives in DC(i+1)
3988 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3989 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3990 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3991 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3992 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3993 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3994 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3995 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3996 C Derivatives in DC(j)
3997 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3998 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3999 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4000 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4001 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4002 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4003 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4004 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4005 C Derivatives in DC(j+1) or DC(nres-1)
4006 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4007 & -3.0d0*vryg(k,3)*ury)
4008 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4009 & -3.0d0*vrzg(k,3)*ury)
4010 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4011 & -3.0d0*vryg(k,3)*urz)
4012 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4013 & -3.0d0*vrzg(k,3)*urz)
4014 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4016 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4029 aggi(k,l)=-aggi(k,l)
4030 aggi1(k,l)=-aggi1(k,l)
4031 aggj(k,l)=-aggj(k,l)
4032 aggj1(k,l)=-aggj1(k,l)
4035 if (j.lt.nres-1) then
4041 aggi(k,l)=-aggi(k,l)
4042 aggi1(k,l)=-aggi1(k,l)
4043 aggj(k,l)=-aggj(k,l)
4044 aggj1(k,l)=-aggj1(k,l)
4055 aggi(k,l)=-aggi(k,l)
4056 aggi1(k,l)=-aggi1(k,l)
4057 aggj(k,l)=-aggj(k,l)
4058 aggj1(k,l)=-aggj1(k,l)
4063 IF (wel_loc.gt.0.0d0) THEN
4064 C Contribution to the local-electrostatic energy coming from the i-j pair
4065 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4067 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4068 c & ' eel_loc_ij',eel_loc_ij
4069 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4070 C Calculate patrial derivative for theta angle
4072 geel_loc_ij=a22*gmuij1(1)
4076 c write(iout,*) "derivative over thatai"
4077 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4079 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4080 & geel_loc_ij*wel_loc
4081 c write(iout,*) "derivative over thatai-1"
4082 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4089 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4090 & geel_loc_ij*wel_loc
4091 c Derivative over j residue
4092 geel_loc_ji=a22*gmuji1(1)
4096 c write(iout,*) "derivative over thataj"
4097 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4100 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4101 & geel_loc_ji*wel_loc
4107 c write(iout,*) "derivative over thataj-1"
4108 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4110 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4111 & geel_loc_ji*wel_loc
4113 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4115 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4116 & 'eelloc',i,j,eel_loc_ij
4117 c if (eel_loc_ij.ne.0)
4118 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4119 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4121 eel_loc=eel_loc+eel_loc_ij
4122 C Partial derivatives in virtual-bond dihedral angles gamma
4124 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4125 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4126 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
4127 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4128 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4129 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
4130 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4132 ggg(l)=agg(l,1)*muij(1)+
4133 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
4134 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4135 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4136 cgrad ghalf=0.5d0*ggg(l)
4137 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4138 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4142 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4145 C Remaining derivatives of eello
4147 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4148 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4149 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4150 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4151 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4152 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4153 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4154 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4157 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4158 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4159 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4160 & .and. num_conti.le.maxconts) then
4161 c write (iout,*) i,j," entered corr"
4163 C Calculate the contact function. The ith column of the array JCONT will
4164 C contain the numbers of atoms that make contacts with the atom I (of numbers
4165 C greater than I). The arrays FACONT and GACONT will contain the values of
4166 C the contact function and its derivative.
4167 c r0ij=1.02D0*rpp(iteli,itelj)
4168 c r0ij=1.11D0*rpp(iteli,itelj)
4169 r0ij=2.20D0*rpp(iteli,itelj)
4170 c r0ij=1.55D0*rpp(iteli,itelj)
4171 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4172 if (fcont.gt.0.0D0) then
4173 num_conti=num_conti+1
4174 if (num_conti.gt.maxconts) then
4175 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4176 & ' will skip next contacts for this conf.'
4178 jcont_hb(num_conti,i)=j
4179 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4180 cd & " jcont_hb",jcont_hb(num_conti,i)
4181 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4182 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4183 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4185 d_cont(num_conti,i)=rij
4186 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4187 C --- Electrostatic-interaction matrix ---
4188 a_chuj(1,1,num_conti,i)=a22
4189 a_chuj(1,2,num_conti,i)=a23
4190 a_chuj(2,1,num_conti,i)=a32
4191 a_chuj(2,2,num_conti,i)=a33
4192 C --- Gradient of rij
4194 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4201 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4202 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4203 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4204 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4205 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4210 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4211 C Calculate contact energies
4213 wij=cosa-3.0D0*cosb*cosg
4216 c fac3=dsqrt(-ael6i)/r0ij**3
4217 fac3=dsqrt(-ael6i)*r3ij
4218 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4219 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4220 if (ees0tmp.gt.0) then
4221 ees0pij=dsqrt(ees0tmp)
4225 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4226 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4227 if (ees0tmp.gt.0) then
4228 ees0mij=dsqrt(ees0tmp)
4233 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4234 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4235 C Diagnostics. Comment out or remove after debugging!
4236 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4237 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4238 c ees0m(num_conti,i)=0.0D0
4240 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4241 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4242 C Angular derivatives of the contact function
4243 ees0pij1=fac3/ees0pij
4244 ees0mij1=fac3/ees0mij
4245 fac3p=-3.0D0*fac3*rrmij
4246 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4247 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4249 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4250 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4251 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4252 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4253 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4254 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4255 ecosap=ecosa1+ecosa2
4256 ecosbp=ecosb1+ecosb2
4257 ecosgp=ecosg1+ecosg2
4258 ecosam=ecosa1-ecosa2
4259 ecosbm=ecosb1-ecosb2
4260 ecosgm=ecosg1-ecosg2
4269 facont_hb(num_conti,i)=fcont
4270 fprimcont=fprimcont/rij
4271 cd facont_hb(num_conti,i)=1.0D0
4272 C Following line is for diagnostics.
4275 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4276 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4279 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4280 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4282 gggp(1)=gggp(1)+ees0pijp*xj
4283 gggp(2)=gggp(2)+ees0pijp*yj
4284 gggp(3)=gggp(3)+ees0pijp*zj
4285 gggm(1)=gggm(1)+ees0mijp*xj
4286 gggm(2)=gggm(2)+ees0mijp*yj
4287 gggm(3)=gggm(3)+ees0mijp*zj
4288 C Derivatives due to the contact function
4289 gacont_hbr(1,num_conti,i)=fprimcont*xj
4290 gacont_hbr(2,num_conti,i)=fprimcont*yj
4291 gacont_hbr(3,num_conti,i)=fprimcont*zj
4294 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4295 c following the change of gradient-summation algorithm.
4297 cgrad ghalfp=0.5D0*gggp(k)
4298 cgrad ghalfm=0.5D0*gggm(k)
4299 gacontp_hb1(k,num_conti,i)=!ghalfp
4300 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4301 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4302 gacontp_hb2(k,num_conti,i)=!ghalfp
4303 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4304 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4305 gacontp_hb3(k,num_conti,i)=gggp(k)
4306 gacontm_hb1(k,num_conti,i)=!ghalfm
4307 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4308 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4309 gacontm_hb2(k,num_conti,i)=!ghalfm
4310 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4311 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4312 gacontm_hb3(k,num_conti,i)=gggm(k)
4314 C Diagnostics. Comment out or remove after debugging!
4316 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4317 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4318 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4319 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4320 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4321 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4324 endif ! num_conti.le.maxconts
4327 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4330 ghalf=0.5d0*agg(l,k)
4331 aggi(l,k)=aggi(l,k)+ghalf
4332 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4333 aggj(l,k)=aggj(l,k)+ghalf
4336 if (j.eq.nres-1 .and. i.lt.j-2) then
4339 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4344 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4347 C-----------------------------------------------------------------------------
4348 subroutine eturn3(i,eello_turn3)
4349 C Third- and fourth-order contributions from turns
4350 implicit real*8 (a-h,o-z)
4351 include 'DIMENSIONS'
4352 include 'COMMON.IOUNITS'
4353 include 'COMMON.GEO'
4354 include 'COMMON.VAR'
4355 include 'COMMON.LOCAL'
4356 include 'COMMON.CHAIN'
4357 include 'COMMON.DERIV'
4358 include 'COMMON.INTERACT'
4359 include 'COMMON.CONTACTS'
4360 include 'COMMON.TORSION'
4361 include 'COMMON.VECTORS'
4362 include 'COMMON.FFIELD'
4363 include 'COMMON.CONTROL'
4365 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4366 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4367 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4368 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4369 & auxgmat2(2,2),auxgmatt2(2,2)
4370 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4371 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4372 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4373 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4376 c write (iout,*) "eturn3",i,j,j1,j2
4381 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4383 C Third-order contributions
4390 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4391 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4392 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4393 c auxalary matices for theta gradient
4394 c auxalary matrix for i+1 and constant i+2
4395 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4396 c auxalary matrix for i+2 and constant i+1
4397 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4398 call transpose2(auxmat(1,1),auxmat1(1,1))
4399 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4400 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4401 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4402 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4403 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4404 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4405 C Derivatives in theta
4406 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4407 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4408 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4409 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4411 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4412 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4413 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4414 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4415 cd & ' eello_turn3_num',4*eello_turn3_num
4416 C Derivatives in gamma(i)
4417 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4418 call transpose2(auxmat2(1,1),auxmat3(1,1))
4419 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4420 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4421 C Derivatives in gamma(i+1)
4422 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4423 call transpose2(auxmat2(1,1),auxmat3(1,1))
4424 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4425 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4426 & +0.5d0*(pizda(1,1)+pizda(2,2))
4427 C Cartesian derivatives
4430 c ghalf1=0.5d0*agg(l,1)
4431 c ghalf2=0.5d0*agg(l,2)
4432 c ghalf3=0.5d0*agg(l,3)
4433 c ghalf4=0.5d0*agg(l,4)
4434 a_temp(1,1)=aggi(l,1)!+ghalf1
4435 a_temp(1,2)=aggi(l,2)!+ghalf2
4436 a_temp(2,1)=aggi(l,3)!+ghalf3
4437 a_temp(2,2)=aggi(l,4)!+ghalf4
4438 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4439 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4440 & +0.5d0*(pizda(1,1)+pizda(2,2))
4441 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4442 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4443 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4444 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4445 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4446 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4447 & +0.5d0*(pizda(1,1)+pizda(2,2))
4448 a_temp(1,1)=aggj(l,1)!+ghalf1
4449 a_temp(1,2)=aggj(l,2)!+ghalf2
4450 a_temp(2,1)=aggj(l,3)!+ghalf3
4451 a_temp(2,2)=aggj(l,4)!+ghalf4
4452 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4453 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4454 & +0.5d0*(pizda(1,1)+pizda(2,2))
4455 a_temp(1,1)=aggj1(l,1)
4456 a_temp(1,2)=aggj1(l,2)
4457 a_temp(2,1)=aggj1(l,3)
4458 a_temp(2,2)=aggj1(l,4)
4459 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4460 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4461 & +0.5d0*(pizda(1,1)+pizda(2,2))
4465 C-------------------------------------------------------------------------------
4466 subroutine eturn4(i,eello_turn4)
4467 C Third- and fourth-order contributions from turns
4468 implicit real*8 (a-h,o-z)
4469 include 'DIMENSIONS'
4470 include 'COMMON.IOUNITS'
4471 include 'COMMON.GEO'
4472 include 'COMMON.VAR'
4473 include 'COMMON.LOCAL'
4474 include 'COMMON.CHAIN'
4475 include 'COMMON.DERIV'
4476 include 'COMMON.INTERACT'
4477 include 'COMMON.CONTACTS'
4478 include 'COMMON.TORSION'
4479 include 'COMMON.VECTORS'
4480 include 'COMMON.FFIELD'
4481 include 'COMMON.CONTROL'
4483 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4484 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4485 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4486 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4487 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4488 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4489 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4490 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4491 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4492 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4493 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4496 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4498 C Fourth-order contributions
4506 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4507 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4508 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4509 c write(iout,*)"WCHODZE W PROGRAM"
4514 iti1=itortyp(itype(i+1))
4515 iti2=itortyp(itype(i+2))
4516 iti3=itortyp(itype(i+3))
4517 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4518 call transpose2(EUg(1,1,i+1),e1t(1,1))
4519 call transpose2(Eug(1,1,i+2),e2t(1,1))
4520 call transpose2(Eug(1,1,i+3),e3t(1,1))
4521 C Ematrix derivative in theta
4522 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4523 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4524 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4525 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4526 c eta1 in derivative theta
4527 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4528 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4529 c auxgvec is derivative of Ub2 so i+3 theta
4530 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4531 c auxalary matrix of E i+1
4532 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4535 s1=scalar2(b1(1,i+2),auxvec(1))
4536 c derivative of theta i+2 with constant i+3
4537 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4538 c derivative of theta i+2 with constant i+2
4539 gs32=scalar2(b1(1,i+2),auxgvec(1))
4540 c derivative of E matix in theta of i+1
4541 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4543 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4544 c ea31 in derivative theta
4545 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4546 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4547 c auxilary matrix auxgvec of Ub2 with constant E matirx
4548 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4549 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4550 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4554 s2=scalar2(b1(1,i+1),auxvec(1))
4555 c derivative of theta i+1 with constant i+3
4556 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4557 c derivative of theta i+2 with constant i+1
4558 gs21=scalar2(b1(1,i+1),auxgvec(1))
4559 c derivative of theta i+3 with constant i+1
4560 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4561 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4563 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4564 c two derivatives over diffetent matrices
4565 c gtae3e2 is derivative over i+3
4566 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4567 c ae3gte2 is derivative over i+2
4568 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4569 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4570 c three possible derivative over theta E matices
4572 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4574 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4576 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4577 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4579 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4580 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4581 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4583 eello_turn4=eello_turn4-(s1+s2+s3)
4584 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4585 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4586 c & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4587 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4588 cd & ' eello_turn4_num',8*eello_turn4_num
4590 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4591 & -(gs13+gsE13+gsEE1)*wturn4
4592 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4593 & -(gs23+gs21+gsEE2)*wturn4
4594 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4595 & -(gs32+gsE31+gsEE3)*wturn4
4596 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4599 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4600 & 'eturn4',i,j,-(s1+s2+s3)
4601 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4602 c & ' eello_turn4_num',8*eello_turn4_num
4603 C Derivatives in gamma(i)
4604 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4605 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4606 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4607 s1=scalar2(b1(1,i+2),auxvec(1))
4608 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4609 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4610 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4611 C Derivatives in gamma(i+1)
4612 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4613 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4614 s2=scalar2(b1(1,i+1),auxvec(1))
4615 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4616 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4617 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4618 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4619 C Derivatives in gamma(i+2)
4620 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4621 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4622 s1=scalar2(b1(1,i+2),auxvec(1))
4623 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4624 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4625 s2=scalar2(b1(1,i+1),auxvec(1))
4626 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4627 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4628 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4629 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4630 C Cartesian derivatives
4631 C Derivatives of this turn contributions in DC(i+2)
4632 if (j.lt.nres-1) then
4634 a_temp(1,1)=agg(l,1)
4635 a_temp(1,2)=agg(l,2)
4636 a_temp(2,1)=agg(l,3)
4637 a_temp(2,2)=agg(l,4)
4638 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4639 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4640 s1=scalar2(b1(1,i+2),auxvec(1))
4641 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4642 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4643 s2=scalar2(b1(1,i+1),auxvec(1))
4644 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4645 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4646 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4648 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4651 C Remaining derivatives of this turn contribution
4653 a_temp(1,1)=aggi(l,1)
4654 a_temp(1,2)=aggi(l,2)
4655 a_temp(2,1)=aggi(l,3)
4656 a_temp(2,2)=aggi(l,4)
4657 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4658 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4659 s1=scalar2(b1(1,i+2),auxvec(1))
4660 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4661 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4662 s2=scalar2(b1(1,i+1),auxvec(1))
4663 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4664 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4665 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4666 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4667 a_temp(1,1)=aggi1(l,1)
4668 a_temp(1,2)=aggi1(l,2)
4669 a_temp(2,1)=aggi1(l,3)
4670 a_temp(2,2)=aggi1(l,4)
4671 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4672 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4673 s1=scalar2(b1(1,i+2),auxvec(1))
4674 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4675 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4676 s2=scalar2(b1(1,i+1),auxvec(1))
4677 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4678 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4679 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4680 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4681 a_temp(1,1)=aggj(l,1)
4682 a_temp(1,2)=aggj(l,2)
4683 a_temp(2,1)=aggj(l,3)
4684 a_temp(2,2)=aggj(l,4)
4685 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4686 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4687 s1=scalar2(b1(1,i+2),auxvec(1))
4688 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4689 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4690 s2=scalar2(b1(1,i+1),auxvec(1))
4691 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4692 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4693 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4694 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4695 a_temp(1,1)=aggj1(l,1)
4696 a_temp(1,2)=aggj1(l,2)
4697 a_temp(2,1)=aggj1(l,3)
4698 a_temp(2,2)=aggj1(l,4)
4699 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4700 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4701 s1=scalar2(b1(1,i+2),auxvec(1))
4702 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4703 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4704 s2=scalar2(b1(1,i+1),auxvec(1))
4705 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4706 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4707 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4708 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4709 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4713 C-----------------------------------------------------------------------------
4714 subroutine vecpr(u,v,w)
4715 implicit real*8(a-h,o-z)
4716 dimension u(3),v(3),w(3)
4717 w(1)=u(2)*v(3)-u(3)*v(2)
4718 w(2)=-u(1)*v(3)+u(3)*v(1)
4719 w(3)=u(1)*v(2)-u(2)*v(1)
4722 C-----------------------------------------------------------------------------
4723 subroutine unormderiv(u,ugrad,unorm,ungrad)
4724 C This subroutine computes the derivatives of a normalized vector u, given
4725 C the derivatives computed without normalization conditions, ugrad. Returns
4728 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4729 double precision vec(3)
4730 double precision scalar
4732 c write (2,*) 'ugrad',ugrad
4735 vec(i)=scalar(ugrad(1,i),u(1))
4737 c write (2,*) 'vec',vec
4740 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4743 c write (2,*) 'ungrad',ungrad
4746 C-----------------------------------------------------------------------------
4747 subroutine escp_soft_sphere(evdw2,evdw2_14)
4749 C This subroutine calculates the excluded-volume interaction energy between
4750 C peptide-group centers and side chains and its gradient in virtual-bond and
4751 C side-chain vectors.
4753 implicit real*8 (a-h,o-z)
4754 include 'DIMENSIONS'
4755 include 'COMMON.GEO'
4756 include 'COMMON.VAR'
4757 include 'COMMON.LOCAL'
4758 include 'COMMON.CHAIN'
4759 include 'COMMON.DERIV'
4760 include 'COMMON.INTERACT'
4761 include 'COMMON.FFIELD'
4762 include 'COMMON.IOUNITS'
4763 include 'COMMON.CONTROL'
4768 cd print '(a)','Enter ESCP'
4769 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4773 do i=iatscp_s,iatscp_e
4774 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4776 xi=0.5D0*(c(1,i)+c(1,i+1))
4777 yi=0.5D0*(c(2,i)+c(2,i+1))
4778 zi=0.5D0*(c(3,i)+c(3,i+1))
4779 C Return atom into box, boxxsize is size of box in x dimension
4781 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4782 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4783 C Condition for being inside the proper box
4784 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4785 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4789 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4790 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4791 C Condition for being inside the proper box
4792 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4793 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4797 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4798 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4799 cC Condition for being inside the proper box
4800 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4801 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4805 if (xi.lt.0) xi=xi+boxxsize
4807 if (yi.lt.0) yi=yi+boxysize
4809 if (zi.lt.0) zi=zi+boxzsize
4810 C xi=xi+xshift*boxxsize
4811 C yi=yi+yshift*boxysize
4812 C zi=zi+zshift*boxzsize
4813 do iint=1,nscp_gr(i)
4815 do j=iscpstart(i,iint),iscpend(i,iint)
4816 if (itype(j).eq.ntyp1) cycle
4817 itypj=iabs(itype(j))
4818 C Uncomment following three lines for SC-p interactions
4822 C Uncomment following three lines for Ca-p interactions
4827 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4828 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4829 C Condition for being inside the proper box
4830 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4831 c & (xj.lt.((-0.5d0)*boxxsize))) then
4835 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4836 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4837 cC Condition for being inside the proper box
4838 c if ((yj.gt.((0.5d0)*boxysize)).or.
4839 c & (yj.lt.((-0.5d0)*boxysize))) then
4843 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4844 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4845 C Condition for being inside the proper box
4846 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4847 c & (zj.lt.((-0.5d0)*boxzsize))) then
4850 if (xj.lt.0) xj=xj+boxxsize
4852 if (yj.lt.0) yj=yj+boxysize
4854 if (zj.lt.0) zj=zj+boxzsize
4855 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4863 xj=xj_safe+xshift*boxxsize
4864 yj=yj_safe+yshift*boxysize
4865 zj=zj_safe+zshift*boxzsize
4866 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4867 if(dist_temp.lt.dist_init) then
4877 if (subchap.eq.1) then
4890 rij=xj*xj+yj*yj+zj*zj
4894 if (rij.lt.r0ijsq) then
4895 evdwij=0.25d0*(rij-r0ijsq)**2
4903 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4908 cgrad if (j.lt.i) then
4909 cd write (iout,*) 'j<i'
4910 C Uncomment following three lines for SC-p interactions
4912 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4915 cd write (iout,*) 'j>i'
4917 cgrad ggg(k)=-ggg(k)
4918 C Uncomment following line for SC-p interactions
4919 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4923 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4925 cgrad kstart=min0(i+1,j)
4926 cgrad kend=max0(i-1,j-1)
4927 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4928 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4929 cgrad do k=kstart,kend
4931 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4935 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4936 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4947 C-----------------------------------------------------------------------------
4948 subroutine escp(evdw2,evdw2_14)
4950 C This subroutine calculates the excluded-volume interaction energy between
4951 C peptide-group centers and side chains and its gradient in virtual-bond and
4952 C side-chain vectors.
4954 implicit real*8 (a-h,o-z)
4955 include 'DIMENSIONS'
4956 include 'COMMON.GEO'
4957 include 'COMMON.VAR'
4958 include 'COMMON.LOCAL'
4959 include 'COMMON.CHAIN'
4960 include 'COMMON.DERIV'
4961 include 'COMMON.INTERACT'
4962 include 'COMMON.FFIELD'
4963 include 'COMMON.IOUNITS'
4964 include 'COMMON.CONTROL'
4965 include 'COMMON.SPLITELE'
4969 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4970 cd print '(a)','Enter ESCP'
4971 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4975 do i=iatscp_s,iatscp_e
4976 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4978 xi=0.5D0*(c(1,i)+c(1,i+1))
4979 yi=0.5D0*(c(2,i)+c(2,i+1))
4980 zi=0.5D0*(c(3,i)+c(3,i+1))
4982 if (xi.lt.0) xi=xi+boxxsize
4984 if (yi.lt.0) yi=yi+boxysize
4986 if (zi.lt.0) zi=zi+boxzsize
4987 c xi=xi+xshift*boxxsize
4988 c yi=yi+yshift*boxysize
4989 c zi=zi+zshift*boxzsize
4990 c print *,xi,yi,zi,'polozenie i'
4991 C Return atom into box, boxxsize is size of box in x dimension
4993 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4994 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4995 C Condition for being inside the proper box
4996 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4997 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5001 c print *,xi,boxxsize,"pierwszy"
5003 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5004 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5005 C Condition for being inside the proper box
5006 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5007 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5011 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5012 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5013 C Condition for being inside the proper box
5014 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5015 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5018 do iint=1,nscp_gr(i)
5020 do j=iscpstart(i,iint),iscpend(i,iint)
5021 itypj=iabs(itype(j))
5022 if (itypj.eq.ntyp1) cycle
5023 C Uncomment following three lines for SC-p interactions
5027 C Uncomment following three lines for Ca-p interactions
5032 if (xj.lt.0) xj=xj+boxxsize
5034 if (yj.lt.0) yj=yj+boxysize
5036 if (zj.lt.0) zj=zj+boxzsize
5038 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5039 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5040 C Condition for being inside the proper box
5041 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5042 c & (xj.lt.((-0.5d0)*boxxsize))) then
5046 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5047 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5048 cC Condition for being inside the proper box
5049 c if ((yj.gt.((0.5d0)*boxysize)).or.
5050 c & (yj.lt.((-0.5d0)*boxysize))) then
5054 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5055 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5056 C Condition for being inside the proper box
5057 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5058 c & (zj.lt.((-0.5d0)*boxzsize))) then
5061 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5062 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5070 xj=xj_safe+xshift*boxxsize
5071 yj=yj_safe+yshift*boxysize
5072 zj=zj_safe+zshift*boxzsize
5073 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5074 if(dist_temp.lt.dist_init) then
5084 if (subchap.eq.1) then
5093 c print *,xj,yj,zj,'polozenie j'
5094 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5096 sss=sscale(1.0d0/(dsqrt(rrij)))
5097 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5098 c if (sss.eq.0) print *,'czasem jest OK'
5099 if (sss.le.0.0d0) cycle
5100 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5102 e1=fac*fac*aad(itypj,iteli)
5103 e2=fac*bad(itypj,iteli)
5104 if (iabs(j-i) .le. 2) then
5107 evdw2_14=evdw2_14+(e1+e2)*sss
5110 evdw2=evdw2+evdwij*sss
5111 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5112 & 'evdw2',i,j,evdwij
5113 c & ,iteli,itypj,fac,aad(itypj,iteli),bad(itypj,iteli)
5115 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5117 fac=-(evdwij+e1)*rrij*sss
5118 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5122 cgrad if (j.lt.i) then
5123 cd write (iout,*) 'j<i'
5124 C Uncomment following three lines for SC-p interactions
5126 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5129 cd write (iout,*) 'j>i'
5131 cgrad ggg(k)=-ggg(k)
5132 C Uncomment following line for SC-p interactions
5133 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5134 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5138 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5140 cgrad kstart=min0(i+1,j)
5141 cgrad kend=max0(i-1,j-1)
5142 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5143 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5144 cgrad do k=kstart,kend
5146 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5150 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5151 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5153 c endif !endif for sscale cutoff
5163 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5164 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5165 gradx_scp(j,i)=expon*gradx_scp(j,i)
5168 C******************************************************************************
5172 C To save time the factor EXPON has been extracted from ALL components
5173 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5176 C******************************************************************************
5179 C--------------------------------------------------------------------------
5180 subroutine edis(ehpb)
5182 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5184 implicit real*8 (a-h,o-z)
5185 include 'DIMENSIONS'
5186 include 'COMMON.SBRIDGE'
5187 include 'COMMON.CHAIN'
5188 include 'COMMON.DERIV'
5189 include 'COMMON.VAR'
5190 include 'COMMON.INTERACT'
5191 include 'COMMON.IOUNITS'
5194 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5195 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5196 if (link_end.eq.0) return
5197 do i=link_start,link_end
5198 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5199 C CA-CA distance used in regularization of structure.
5202 C iii and jjj point to the residues for which the distance is assigned.
5203 if (ii.gt.nres) then
5210 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5211 c & dhpb(i),dhpb1(i),forcon(i)
5212 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5213 C distance and angle dependent SS bond potential.
5214 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5215 C & iabs(itype(jjj)).eq.1) then
5216 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5217 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5218 if (.not.dyn_ss .and. i.le.nss) then
5219 C 15/02/13 CC dynamic SSbond - additional check
5221 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5222 call ssbond_ene(iii,jjj,eij)
5225 cd write (iout,*) "eij",eij
5227 C Calculate the distance between the two points and its difference from the
5231 C Get the force constant corresponding to this distance.
5233 C Calculate the contribution to energy.
5234 ehpb=ehpb+waga*rdis*rdis
5236 C Evaluate gradient.
5239 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
5240 cd & ' waga=',waga,' fac=',fac
5242 ggg(j)=fac*(c(j,jj)-c(j,ii))
5244 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5245 C If this is a SC-SC distance, we need to calculate the contributions to the
5246 C Cartesian gradient in the SC vectors (ghpbx).
5249 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5250 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5253 cgrad do j=iii,jjj-1
5255 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5259 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5260 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5267 C--------------------------------------------------------------------------
5268 subroutine ssbond_ene(i,j,eij)
5270 C Calculate the distance and angle dependent SS-bond potential energy
5271 C using a free-energy function derived based on RHF/6-31G** ab initio
5272 C calculations of diethyl disulfide.
5274 C A. Liwo and U. Kozlowska, 11/24/03
5276 implicit real*8 (a-h,o-z)
5277 include 'DIMENSIONS'
5278 include 'COMMON.SBRIDGE'
5279 include 'COMMON.CHAIN'
5280 include 'COMMON.DERIV'
5281 include 'COMMON.LOCAL'
5282 include 'COMMON.INTERACT'
5283 include 'COMMON.VAR'
5284 include 'COMMON.IOUNITS'
5285 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5286 itypi=iabs(itype(i))
5290 dxi=dc_norm(1,nres+i)
5291 dyi=dc_norm(2,nres+i)
5292 dzi=dc_norm(3,nres+i)
5293 c dsci_inv=dsc_inv(itypi)
5294 dsci_inv=vbld_inv(nres+i)
5295 itypj=iabs(itype(j))
5296 c dscj_inv=dsc_inv(itypj)
5297 dscj_inv=vbld_inv(nres+j)
5301 dxj=dc_norm(1,nres+j)
5302 dyj=dc_norm(2,nres+j)
5303 dzj=dc_norm(3,nres+j)
5304 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5309 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5310 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5311 om12=dxi*dxj+dyi*dyj+dzi*dzj
5313 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5314 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5320 deltat12=om2-om1+2.0d0
5322 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5323 & +akct*deltad*deltat12
5324 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5325 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5326 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5327 c & " deltat12",deltat12," eij",eij
5328 ed=2*akcm*deltad+akct*deltat12
5330 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5331 eom1=-2*akth*deltat1-pom1-om2*pom2
5332 eom2= 2*akth*deltat2+pom1-om1*pom2
5335 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5336 ghpbx(k,i)=ghpbx(k,i)-ggk
5337 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5338 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5339 ghpbx(k,j)=ghpbx(k,j)+ggk
5340 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5341 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5342 ghpbc(k,i)=ghpbc(k,i)-ggk
5343 ghpbc(k,j)=ghpbc(k,j)+ggk
5346 C Calculate the components of the gradient in DC and X
5350 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5355 C--------------------------------------------------------------------------
5356 subroutine ebond(estr)
5358 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5360 implicit real*8 (a-h,o-z)
5361 include 'DIMENSIONS'
5362 include 'COMMON.LOCAL'
5363 include 'COMMON.GEO'
5364 include 'COMMON.INTERACT'
5365 include 'COMMON.DERIV'
5366 include 'COMMON.VAR'
5367 include 'COMMON.CHAIN'
5368 include 'COMMON.IOUNITS'
5369 include 'COMMON.NAMES'
5370 include 'COMMON.FFIELD'
5371 include 'COMMON.CONTROL'
5372 include 'COMMON.SETUP'
5373 double precision u(3),ud(3)
5376 do i=ibondp_start,ibondp_end
5377 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5378 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5380 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5381 c & *dc(j,i-1)/vbld(i)
5383 c if (energy_dec) write(iout,*)
5384 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5386 C Checking if it involves dummy (NH3+ or COO-) group
5387 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5388 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5389 diff = vbld(i)-vbldpDUM
5391 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5392 diff = vbld(i)-vbldp0
5394 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5395 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5398 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5400 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5403 estr=0.5d0*AKP*estr+estr1
5405 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5407 do i=ibond_start,ibond_end
5409 if (iti.ne.10 .and. iti.ne.ntyp1) then
5412 diff=vbld(i+nres)-vbldsc0(1,iti)
5413 if (energy_dec) write (iout,*)
5414 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5415 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5416 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5418 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5422 diff=vbld(i+nres)-vbldsc0(j,iti)
5423 ud(j)=aksc(j,iti)*diff
5424 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5438 uprod2=uprod2*u(k)*u(k)
5442 usumsqder=usumsqder+ud(j)*uprod2
5444 estr=estr+uprod/usum
5446 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5454 C--------------------------------------------------------------------------
5455 subroutine ebend(etheta)
5457 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5458 C angles gamma and its derivatives in consecutive thetas and gammas.
5460 implicit real*8 (a-h,o-z)
5461 include 'DIMENSIONS'
5462 include 'COMMON.LOCAL'
5463 include 'COMMON.GEO'
5464 include 'COMMON.INTERACT'
5465 include 'COMMON.DERIV'
5466 include 'COMMON.VAR'
5467 include 'COMMON.CHAIN'
5468 include 'COMMON.IOUNITS'
5469 include 'COMMON.NAMES'
5470 include 'COMMON.FFIELD'
5471 include 'COMMON.CONTROL'
5472 common /calcthet/ term1,term2,termm,diffak,ratak,
5473 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5474 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5475 double precision y(2),z(2)
5477 c time11=dexp(-2*time)
5480 c write (*,'(a,i2)') 'EBEND ICG=',icg
5481 do i=ithet_start,ithet_end
5482 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5483 & .or.itype(i).eq.ntyp1) cycle
5484 C Zero the energy function and its derivative at 0 or pi.
5485 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5487 ichir1=isign(1,itype(i-2))
5488 ichir2=isign(1,itype(i))
5489 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5490 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5491 if (itype(i-1).eq.10) then
5492 itype1=isign(10,itype(i-2))
5493 ichir11=isign(1,itype(i-2))
5494 ichir12=isign(1,itype(i-2))
5495 itype2=isign(10,itype(i))
5496 ichir21=isign(1,itype(i))
5497 ichir22=isign(1,itype(i))
5500 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5503 if (phii.ne.phii) phii=150.0
5513 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5516 if (phii1.ne.phii1) phii1=150.0
5528 C Calculate the "mean" value of theta from the part of the distribution
5529 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5530 C In following comments this theta will be referred to as t_c.
5531 thet_pred_mean=0.0d0
5533 athetk=athet(k,it,ichir1,ichir2)
5534 bthetk=bthet(k,it,ichir1,ichir2)
5536 athetk=athet(k,itype1,ichir11,ichir12)
5537 bthetk=bthet(k,itype2,ichir21,ichir22)
5539 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5540 c write(iout,*) 'chuj tu', y(k),z(k)
5542 dthett=thet_pred_mean*ssd
5543 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5544 C Derivatives of the "mean" values in gamma1 and gamma2.
5545 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5546 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5547 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5548 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5550 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5551 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5552 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5553 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5555 if (theta(i).gt.pi-delta) then
5556 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5558 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5559 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5560 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5562 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5564 else if (theta(i).lt.delta) then
5565 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5566 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5567 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5569 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5570 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5573 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5576 etheta=etheta+ethetai
5577 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5578 & 'ebend',i,ethetai,theta(i),itype(i)
5579 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5580 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5581 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5583 C Ufff.... We've done all this!!!
5586 C---------------------------------------------------------------------------
5587 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5589 implicit real*8 (a-h,o-z)
5590 include 'DIMENSIONS'
5591 include 'COMMON.LOCAL'
5592 include 'COMMON.IOUNITS'
5593 common /calcthet/ term1,term2,termm,diffak,ratak,
5594 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5595 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5596 C Calculate the contributions to both Gaussian lobes.
5597 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5598 C The "polynomial part" of the "standard deviation" of this part of
5599 C the distributioni.
5600 ccc write (iout,*) thetai,thet_pred_mean
5603 sig=sig*thet_pred_mean+polthet(j,it)
5605 C Derivative of the "interior part" of the "standard deviation of the"
5606 C gamma-dependent Gaussian lobe in t_c.
5607 sigtc=3*polthet(3,it)
5609 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5612 C Set the parameters of both Gaussian lobes of the distribution.
5613 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5614 fac=sig*sig+sigc0(it)
5617 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5618 sigsqtc=-4.0D0*sigcsq*sigtc
5619 c print *,i,sig,sigtc,sigsqtc
5620 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5621 sigtc=-sigtc/(fac*fac)
5622 C Following variable is sigma(t_c)**(-2)
5623 sigcsq=sigcsq*sigcsq
5625 sig0inv=1.0D0/sig0i**2
5626 delthec=thetai-thet_pred_mean
5627 delthe0=thetai-theta0i
5628 term1=-0.5D0*sigcsq*delthec*delthec
5629 term2=-0.5D0*sig0inv*delthe0*delthe0
5630 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5631 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5632 C NaNs in taking the logarithm. We extract the largest exponent which is added
5633 C to the energy (this being the log of the distribution) at the end of energy
5634 C term evaluation for this virtual-bond angle.
5635 if (term1.gt.term2) then
5637 term2=dexp(term2-termm)
5641 term1=dexp(term1-termm)
5644 C The ratio between the gamma-independent and gamma-dependent lobes of
5645 C the distribution is a Gaussian function of thet_pred_mean too.
5646 diffak=gthet(2,it)-thet_pred_mean
5647 ratak=diffak/gthet(3,it)**2
5648 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5649 C Let's differentiate it in thet_pred_mean NOW.
5651 C Now put together the distribution terms to make complete distribution.
5652 termexp=term1+ak*term2
5653 termpre=sigc+ak*sig0i
5654 C Contribution of the bending energy from this theta is just the -log of
5655 C the sum of the contributions from the two lobes and the pre-exponential
5656 C factor. Simple enough, isn't it?
5657 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5658 C write (iout,*) 'termexp',termexp,termm,termpre,i
5659 C NOW the derivatives!!!
5660 C 6/6/97 Take into account the deformation.
5661 E_theta=(delthec*sigcsq*term1
5662 & +ak*delthe0*sig0inv*term2)/termexp
5663 E_tc=((sigtc+aktc*sig0i)/termpre
5664 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5665 & aktc*term2)/termexp)
5668 c-----------------------------------------------------------------------------
5669 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5670 implicit real*8 (a-h,o-z)
5671 include 'DIMENSIONS'
5672 include 'COMMON.LOCAL'
5673 include 'COMMON.IOUNITS'
5674 common /calcthet/ term1,term2,termm,diffak,ratak,
5675 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5676 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5677 delthec=thetai-thet_pred_mean
5678 delthe0=thetai-theta0i
5679 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5680 t3 = thetai-thet_pred_mean
5684 t14 = t12+t6*sigsqtc
5686 t21 = thetai-theta0i
5692 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5693 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5694 & *(-t12*t9-ak*sig0inv*t27)
5698 C--------------------------------------------------------------------------
5699 subroutine ebend(etheta)
5701 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5702 C angles gamma and its derivatives in consecutive thetas and gammas.
5703 C ab initio-derived potentials from
5704 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5706 implicit real*8 (a-h,o-z)
5707 include 'DIMENSIONS'
5708 include 'COMMON.LOCAL'
5709 include 'COMMON.GEO'
5710 include 'COMMON.INTERACT'
5711 include 'COMMON.DERIV'
5712 include 'COMMON.VAR'
5713 include 'COMMON.CHAIN'
5714 include 'COMMON.IOUNITS'
5715 include 'COMMON.NAMES'
5716 include 'COMMON.FFIELD'
5717 include 'COMMON.CONTROL'
5718 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5719 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5720 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5721 & sinph1ph2(maxdouble,maxdouble)
5722 logical lprn /.false./, lprn1 /.false./
5724 do i=ithet_start,ithet_end
5726 c print *,i,itype(i-1),itype(i),itype(i-2)
5727 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1)
5728 & .or.(itype(i).eq.ntyp1)) cycle
5729 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5731 if (iabs(itype(i+1)).eq.20) iblock=2
5732 if (iabs(itype(i+1)).ne.20) iblock=1
5736 theti2=0.5d0*theta(i)
5737 ityp2=ithetyp((itype(i-1)))
5739 coskt(k)=dcos(k*theti2)
5740 sinkt(k)=dsin(k*theti2)
5742 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
5745 if (phii.ne.phii) phii=150.0
5749 ityp1=ithetyp((itype(i-2)))
5750 C propagation of chirality for glycine type
5752 cosph1(k)=dcos(k*phii)
5753 sinph1(k)=dsin(k*phii)
5757 ityp1=ithetyp(itype(i-2))
5763 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5766 if (phii1.ne.phii1) phii1=150.0
5771 ityp3=ithetyp((itype(i)))
5773 cosph2(k)=dcos(k*phii1)
5774 sinph2(k)=dsin(k*phii1)
5778 ityp3=ithetyp(itype(i))
5784 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5787 ccl=cosph1(l)*cosph2(k-l)
5788 ssl=sinph1(l)*sinph2(k-l)
5789 scl=sinph1(l)*cosph2(k-l)
5790 csl=cosph1(l)*sinph2(k-l)
5791 cosph1ph2(l,k)=ccl-ssl
5792 cosph1ph2(k,l)=ccl+ssl
5793 sinph1ph2(l,k)=scl+csl
5794 sinph1ph2(k,l)=scl-csl
5798 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5799 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5800 write (iout,*) "coskt and sinkt"
5802 write (iout,*) k,coskt(k),sinkt(k)
5806 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5807 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5810 & write (iout,*) "k",k,"
5811 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5812 & " ethetai",ethetai
5815 write (iout,*) "cosph and sinph"
5817 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5819 write (iout,*) "cosph1ph2 and sinph2ph2"
5822 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5823 & sinph1ph2(l,k),sinph1ph2(k,l)
5826 write(iout,*) "ethetai",ethetai
5830 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5831 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5832 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5833 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5834 ethetai=ethetai+sinkt(m)*aux
5835 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5836 dephii=dephii+k*sinkt(m)*(
5837 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5838 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5839 dephii1=dephii1+k*sinkt(m)*(
5840 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5841 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5843 & write (iout,*) "m",m," k",k," bbthet",
5844 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5845 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5846 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5847 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5851 & write(iout,*) "ethetai",ethetai
5855 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5856 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5857 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5858 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5859 ethetai=ethetai+sinkt(m)*aux
5860 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5861 dephii=dephii+l*sinkt(m)*(
5862 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5863 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5864 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5865 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5866 dephii1=dephii1+(k-l)*sinkt(m)*(
5867 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5868 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5869 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5870 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5872 write (iout,*) "m",m," k",k," l",l," ffthet",
5873 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5874 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5875 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5876 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5877 & " ethetai",ethetai
5878 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5879 & cosph1ph2(k,l)*sinkt(m),
5880 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5888 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5889 & i,theta(i)*rad2deg,phii*rad2deg,
5890 & phii1*rad2deg,ethetai
5892 etheta=etheta+ethetai
5893 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5895 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5896 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5897 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
5903 c-----------------------------------------------------------------------------
5904 subroutine esc(escloc)
5905 C Calculate the local energy of a side chain and its derivatives in the
5906 C corresponding virtual-bond valence angles THETA and the spherical angles
5908 implicit real*8 (a-h,o-z)
5909 include 'DIMENSIONS'
5910 include 'COMMON.GEO'
5911 include 'COMMON.LOCAL'
5912 include 'COMMON.VAR'
5913 include 'COMMON.INTERACT'
5914 include 'COMMON.DERIV'
5915 include 'COMMON.CHAIN'
5916 include 'COMMON.IOUNITS'
5917 include 'COMMON.NAMES'
5918 include 'COMMON.FFIELD'
5919 include 'COMMON.CONTROL'
5920 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5921 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5922 common /sccalc/ time11,time12,time112,theti,it,nlobit
5925 c write (iout,'(a)') 'ESC'
5926 do i=loc_start,loc_end
5928 if (it.eq.ntyp1) cycle
5929 if (it.eq.10) goto 1
5930 nlobit=nlob(iabs(it))
5931 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5932 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5933 theti=theta(i+1)-pipol
5938 if (x(2).gt.pi-delta) then
5942 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5944 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5945 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5947 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5948 & ddersc0(1),dersc(1))
5949 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5950 & ddersc0(3),dersc(3))
5952 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5954 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5955 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5956 & dersc0(2),esclocbi,dersc02)
5957 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5959 call splinthet(x(2),0.5d0*delta,ss,ssd)
5964 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5966 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5967 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5969 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5971 c write (iout,*) escloci
5972 else if (x(2).lt.delta) then
5976 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5978 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5979 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5981 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5982 & ddersc0(1),dersc(1))
5983 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5984 & ddersc0(3),dersc(3))
5986 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5988 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5989 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5990 & dersc0(2),esclocbi,dersc02)
5991 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5996 call splinthet(x(2),0.5d0*delta,ss,ssd)
5998 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6000 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6001 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6003 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6004 c write (iout,*) escloci
6006 call enesc(x,escloci,dersc,ddummy,.false.)
6009 escloc=escloc+escloci
6010 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6011 & 'escloc',i,escloci
6012 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6014 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6016 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6017 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6022 C---------------------------------------------------------------------------
6023 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6024 implicit real*8 (a-h,o-z)
6025 include 'DIMENSIONS'
6026 include 'COMMON.GEO'
6027 include 'COMMON.LOCAL'
6028 include 'COMMON.IOUNITS'
6029 common /sccalc/ time11,time12,time112,theti,it,nlobit
6030 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6031 double precision contr(maxlob,-1:1)
6033 c write (iout,*) 'it=',it,' nlobit=',nlobit
6037 if (mixed) ddersc(j)=0.0d0
6041 C Because of periodicity of the dependence of the SC energy in omega we have
6042 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6043 C To avoid underflows, first compute & store the exponents.
6051 z(k)=x(k)-censc(k,j,it)
6056 Axk=Axk+gaussc(l,k,j,it)*z(l)
6062 expfac=expfac+Ax(k,j,iii)*z(k)
6070 C As in the case of ebend, we want to avoid underflows in exponentiation and
6071 C subsequent NaNs and INFs in energy calculation.
6072 C Find the largest exponent
6076 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6080 cd print *,'it=',it,' emin=',emin
6082 C Compute the contribution to SC energy and derivatives
6087 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6088 if(adexp.ne.adexp) adexp=1.0
6091 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6093 cd print *,'j=',j,' expfac=',expfac
6094 escloc_i=escloc_i+expfac
6096 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6100 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6101 & +gaussc(k,2,j,it))*expfac
6108 dersc(1)=dersc(1)/cos(theti)**2
6109 ddersc(1)=ddersc(1)/cos(theti)**2
6112 escloci=-(dlog(escloc_i)-emin)
6114 dersc(j)=dersc(j)/escloc_i
6118 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6123 C------------------------------------------------------------------------------
6124 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6125 implicit real*8 (a-h,o-z)
6126 include 'DIMENSIONS'
6127 include 'COMMON.GEO'
6128 include 'COMMON.LOCAL'
6129 include 'COMMON.IOUNITS'
6130 common /sccalc/ time11,time12,time112,theti,it,nlobit
6131 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6132 double precision contr(maxlob)
6143 z(k)=x(k)-censc(k,j,it)
6149 Axk=Axk+gaussc(l,k,j,it)*z(l)
6155 expfac=expfac+Ax(k,j)*z(k)
6160 C As in the case of ebend, we want to avoid underflows in exponentiation and
6161 C subsequent NaNs and INFs in energy calculation.
6162 C Find the largest exponent
6165 if (emin.gt.contr(j)) emin=contr(j)
6169 C Compute the contribution to SC energy and derivatives
6173 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6174 escloc_i=escloc_i+expfac
6176 dersc(k)=dersc(k)+Ax(k,j)*expfac
6178 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6179 & +gaussc(1,2,j,it))*expfac
6183 dersc(1)=dersc(1)/cos(theti)**2
6184 dersc12=dersc12/cos(theti)**2
6185 escloci=-(dlog(escloc_i)-emin)
6187 dersc(j)=dersc(j)/escloc_i
6189 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6193 c----------------------------------------------------------------------------------
6194 subroutine esc(escloc)
6195 C Calculate the local energy of a side chain and its derivatives in the
6196 C corresponding virtual-bond valence angles THETA and the spherical angles
6197 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6198 C added by Urszula Kozlowska. 07/11/2007
6200 implicit real*8 (a-h,o-z)
6201 include 'DIMENSIONS'
6202 include 'COMMON.GEO'
6203 include 'COMMON.LOCAL'
6204 include 'COMMON.VAR'
6205 include 'COMMON.SCROT'
6206 include 'COMMON.INTERACT'
6207 include 'COMMON.DERIV'
6208 include 'COMMON.CHAIN'
6209 include 'COMMON.IOUNITS'
6210 include 'COMMON.NAMES'
6211 include 'COMMON.FFIELD'
6212 include 'COMMON.CONTROL'
6213 include 'COMMON.VECTORS'
6214 double precision x_prime(3),y_prime(3),z_prime(3)
6215 & , sumene,dsc_i,dp2_i,x(65),
6216 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6217 & de_dxx,de_dyy,de_dzz,de_dt
6218 double precision s1_t,s1_6_t,s2_t,s2_6_t
6220 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6221 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6222 & dt_dCi(3),dt_dCi1(3)
6223 common /sccalc/ time11,time12,time112,theti,it,nlobit
6226 do i=loc_start,loc_end
6227 if (itype(i).eq.ntyp1) cycle
6228 costtab(i+1) =dcos(theta(i+1))
6229 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6230 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6231 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6232 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6233 cosfac=dsqrt(cosfac2)
6234 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6235 sinfac=dsqrt(sinfac2)
6237 if (it.eq.10) goto 1
6239 C Compute the axes of tghe local cartesian coordinates system; store in
6240 c x_prime, y_prime and z_prime
6247 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6248 C & dc_norm(3,i+nres)
6250 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6251 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6254 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6257 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6258 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6259 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6260 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6261 c & " xy",scalar(x_prime(1),y_prime(1)),
6262 c & " xz",scalar(x_prime(1),z_prime(1)),
6263 c & " yy",scalar(y_prime(1),y_prime(1)),
6264 c & " yz",scalar(y_prime(1),z_prime(1)),
6265 c & " zz",scalar(z_prime(1),z_prime(1))
6267 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6268 C to local coordinate system. Store in xx, yy, zz.
6274 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6275 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6276 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6283 C Compute the energy of the ith side cbain
6285 c write (2,*) "xx",xx," yy",yy," zz",zz
6288 x(j) = sc_parmin(j,it)
6291 Cc diagnostics - remove later
6293 yy1 = dsin(alph(2))*dcos(omeg(2))
6294 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6295 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6296 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6298 C," --- ", xx_w,yy_w,zz_w
6301 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6302 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6304 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6305 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6307 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6308 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6309 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6310 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6311 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6313 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6314 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6315 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6316 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6317 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6319 dsc_i = 0.743d0+x(61)
6321 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6322 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6323 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6324 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6325 s1=(1+x(63))/(0.1d0 + dscp1)
6326 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6327 s2=(1+x(65))/(0.1d0 + dscp2)
6328 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6329 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6330 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6331 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6333 c & dscp1,dscp2,sumene
6334 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6335 escloc = escloc + sumene
6336 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6338 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6343 C This section to check the numerical derivatives of the energy of ith side
6344 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6345 C #define DEBUG in the code to turn it on.
6347 write (2,*) "sumene =",sumene
6351 write (2,*) xx,yy,zz
6352 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6353 de_dxx_num=(sumenep-sumene)/aincr
6355 write (2,*) "xx+ sumene from enesc=",sumenep
6358 write (2,*) xx,yy,zz
6359 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6360 de_dyy_num=(sumenep-sumene)/aincr
6362 write (2,*) "yy+ sumene from enesc=",sumenep
6365 write (2,*) xx,yy,zz
6366 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6367 de_dzz_num=(sumenep-sumene)/aincr
6369 write (2,*) "zz+ sumene from enesc=",sumenep
6370 costsave=cost2tab(i+1)
6371 sintsave=sint2tab(i+1)
6372 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6373 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6374 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6375 de_dt_num=(sumenep-sumene)/aincr
6376 write (2,*) " t+ sumene from enesc=",sumenep
6377 cost2tab(i+1)=costsave
6378 sint2tab(i+1)=sintsave
6379 C End of diagnostics section.
6382 C Compute the gradient of esc
6384 c zz=zz*dsign(1.0,dfloat(itype(i)))
6385 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6386 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6387 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6388 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6389 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6390 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6391 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6392 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6393 pom1=(sumene3*sint2tab(i+1)+sumene1)
6394 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6395 pom2=(sumene4*cost2tab(i+1)+sumene2)
6396 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6397 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6398 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6399 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6401 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6402 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6403 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6405 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6406 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6407 & +(pom1+pom2)*pom_dx
6409 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6412 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6413 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6414 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6416 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6417 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6418 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6419 & +x(59)*zz**2 +x(60)*xx*zz
6420 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6421 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6422 & +(pom1-pom2)*pom_dy
6424 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6427 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6428 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6429 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6430 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6431 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6432 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6433 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6434 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6436 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6439 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6440 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6441 & +pom1*pom_dt1+pom2*pom_dt2
6443 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6448 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6449 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6450 cosfac2xx=cosfac2*xx
6451 sinfac2yy=sinfac2*yy
6453 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6455 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6457 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6458 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6459 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6460 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6461 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6462 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6463 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6464 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6465 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6466 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6470 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6471 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6472 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6473 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6476 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6477 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6478 dZZ_XYZ(k)=vbld_inv(i+nres)*
6479 & (z_prime(k)-zz*dC_norm(k,i+nres))
6481 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6482 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6486 dXX_Ctab(k,i)=dXX_Ci(k)
6487 dXX_C1tab(k,i)=dXX_Ci1(k)
6488 dYY_Ctab(k,i)=dYY_Ci(k)
6489 dYY_C1tab(k,i)=dYY_Ci1(k)
6490 dZZ_Ctab(k,i)=dZZ_Ci(k)
6491 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6492 dXX_XYZtab(k,i)=dXX_XYZ(k)
6493 dYY_XYZtab(k,i)=dYY_XYZ(k)
6494 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6498 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6499 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6500 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6501 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6502 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6504 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6505 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6506 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6507 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6508 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6509 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6510 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6511 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6513 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6514 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6516 C to check gradient call subroutine check_grad
6522 c------------------------------------------------------------------------------
6523 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6525 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6526 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6527 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6528 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6530 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6531 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6533 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6534 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6535 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6536 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6537 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6539 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6540 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6541 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6542 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6543 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6545 dsc_i = 0.743d0+x(61)
6547 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6548 & *(xx*cost2+yy*sint2))
6549 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6550 & *(xx*cost2-yy*sint2))
6551 s1=(1+x(63))/(0.1d0 + dscp1)
6552 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6553 s2=(1+x(65))/(0.1d0 + dscp2)
6554 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6555 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6556 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6561 c------------------------------------------------------------------------------
6562 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6564 C This procedure calculates two-body contact function g(rij) and its derivative:
6567 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6570 C where x=(rij-r0ij)/delta
6572 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6575 double precision rij,r0ij,eps0ij,fcont,fprimcont
6576 double precision x,x2,x4,delta
6580 if (x.lt.-1.0D0) then
6583 else if (x.le.1.0D0) then
6586 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6587 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6594 c------------------------------------------------------------------------------
6595 subroutine splinthet(theti,delta,ss,ssder)
6596 implicit real*8 (a-h,o-z)
6597 include 'DIMENSIONS'
6598 include 'COMMON.VAR'
6599 include 'COMMON.GEO'
6602 if (theti.gt.pipol) then
6603 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6605 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6610 c------------------------------------------------------------------------------
6611 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6613 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6614 double precision ksi,ksi2,ksi3,a1,a2,a3
6615 a1=fprim0*delta/(f1-f0)
6621 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6622 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6625 c------------------------------------------------------------------------------
6626 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6628 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6629 double precision ksi,ksi2,ksi3,a1,a2,a3
6634 a2=3*(f1x-f0x)-2*fprim0x*delta
6635 a3=fprim0x*delta-2*(f1x-f0x)
6636 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6639 C-----------------------------------------------------------------------------
6641 C-----------------------------------------------------------------------------
6642 subroutine etor(etors,edihcnstr)
6643 implicit real*8 (a-h,o-z)
6644 include 'DIMENSIONS'
6645 include 'COMMON.VAR'
6646 include 'COMMON.GEO'
6647 include 'COMMON.LOCAL'
6648 include 'COMMON.TORSION'
6649 include 'COMMON.INTERACT'
6650 include 'COMMON.DERIV'
6651 include 'COMMON.CHAIN'
6652 include 'COMMON.NAMES'
6653 include 'COMMON.IOUNITS'
6654 include 'COMMON.FFIELD'
6655 include 'COMMON.TORCNSTR'
6656 include 'COMMON.CONTROL'
6658 C Set lprn=.true. for debugging
6662 do i=iphi_start,iphi_end
6664 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6665 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6666 itori=itortyp(itype(i-2))
6667 itori1=itortyp(itype(i-1))
6670 C Proline-Proline pair is a special case...
6671 if (itori.eq.3 .and. itori1.eq.3) then
6672 if (phii.gt.-dwapi3) then
6674 fac=1.0D0/(1.0D0-cosphi)
6675 etorsi=v1(1,3,3)*fac
6676 etorsi=etorsi+etorsi
6677 etors=etors+etorsi-v1(1,3,3)
6678 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6679 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6682 v1ij=v1(j+1,itori,itori1)
6683 v2ij=v2(j+1,itori,itori1)
6686 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6687 if (energy_dec) etors_ii=etors_ii+
6688 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6689 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6693 v1ij=v1(j,itori,itori1)
6694 v2ij=v2(j,itori,itori1)
6697 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6698 if (energy_dec) etors_ii=etors_ii+
6699 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6700 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6703 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6706 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6707 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6708 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6709 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6710 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6712 ! 6/20/98 - dihedral angle constraints
6715 itori=idih_constr(i)
6718 if (difi.gt.drange(i)) then
6720 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6721 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6722 else if (difi.lt.-drange(i)) then
6724 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6725 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6727 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6728 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6730 ! write (iout,*) 'edihcnstr',edihcnstr
6733 c------------------------------------------------------------------------------
6734 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
6735 subroutine e_modeller(ehomology_constr)
6736 ehomology_constr=0.0d0
6737 write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
6740 C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
6742 c------------------------------------------------------------------------------
6743 subroutine etor_d(etors_d)
6747 c----------------------------------------------------------------------------
6749 subroutine etor(etors,edihcnstr)
6750 implicit real*8 (a-h,o-z)
6751 include 'DIMENSIONS'
6752 include 'COMMON.VAR'
6753 include 'COMMON.GEO'
6754 include 'COMMON.LOCAL'
6755 include 'COMMON.TORSION'
6756 include 'COMMON.INTERACT'
6757 include 'COMMON.DERIV'
6758 include 'COMMON.CHAIN'
6759 include 'COMMON.NAMES'
6760 include 'COMMON.IOUNITS'
6761 include 'COMMON.FFIELD'
6762 include 'COMMON.TORCNSTR'
6763 include 'COMMON.CONTROL'
6765 C Set lprn=.true. for debugging
6769 do i=iphi_start,iphi_end
6770 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6771 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6772 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6773 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6774 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6775 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6776 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6777 C For introducing the NH3+ and COO- group please check the etor_d for reference
6780 if (iabs(itype(i)).eq.20) then
6785 itori=itortyp(itype(i-2))
6786 itori1=itortyp(itype(i-1))
6789 C Regular cosine and sine terms
6790 do j=1,nterm(itori,itori1,iblock)
6791 v1ij=v1(j,itori,itori1,iblock)
6792 v2ij=v2(j,itori,itori1,iblock)
6795 etors=etors+v1ij*cosphi+v2ij*sinphi
6796 if (energy_dec) etors_ii=etors_ii+
6797 & v1ij*cosphi+v2ij*sinphi
6798 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6802 C E = SUM ----------------------------------- - v1
6803 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6805 cosphi=dcos(0.5d0*phii)
6806 sinphi=dsin(0.5d0*phii)
6807 do j=1,nlor(itori,itori1,iblock)
6808 vl1ij=vlor1(j,itori,itori1)
6809 vl2ij=vlor2(j,itori,itori1)
6810 vl3ij=vlor3(j,itori,itori1)
6811 pom=vl2ij*cosphi+vl3ij*sinphi
6812 pom1=1.0d0/(pom*pom+1.0d0)
6813 etors=etors+vl1ij*pom1
6814 if (energy_dec) etors_ii=etors_ii+
6817 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6819 C Subtract the constant term
6820 etors=etors-v0(itori,itori1,iblock)
6821 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6822 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6824 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6825 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6826 & (v1(j,itori,itori1,iblock),j=1,6),
6827 & (v2(j,itori,itori1,iblock),j=1,6)
6828 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6829 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6831 ! 6/20/98 - dihedral angle constraints
6833 c do i=1,ndih_constr
6834 do i=idihconstr_start,idihconstr_end
6835 itori=idih_constr(i)
6837 difi=pinorm(phii-phi0(i))
6838 if (difi.gt.drange(i)) then
6840 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6841 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6842 else if (difi.lt.-drange(i)) then
6844 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6845 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6849 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6850 cd & rad2deg*phi0(i), rad2deg*drange(i),
6851 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6853 cd write (iout,*) 'edihcnstr',edihcnstr
6856 c----------------------------------------------------------------------------
6857 c MODELLER restraint function
6858 subroutine e_modeller(ehomology_constr)
6859 implicit real*8 (a-h,o-z)
6860 include 'DIMENSIONS'
6862 integer nnn, i, j, k, ki, irec, l
6863 integer katy, odleglosci, test7
6864 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
6866 real*8 distance(max_template),distancek(max_template),
6867 & min_odl,godl(max_template),dih_diff(max_template)
6870 c FP - 30/10/2014 Temporary specifications for homology restraints
6872 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
6874 double precision, dimension (maxres) :: guscdiff,usc_diff
6875 double precision, dimension (max_template) ::
6876 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
6880 include 'COMMON.SBRIDGE'
6881 include 'COMMON.CHAIN'
6882 include 'COMMON.GEO'
6883 include 'COMMON.DERIV'
6884 include 'COMMON.LOCAL'
6885 include 'COMMON.INTERACT'
6886 include 'COMMON.VAR'
6887 include 'COMMON.IOUNITS'
6889 include 'COMMON.CONTROL'
6891 c From subroutine Econstr_back
6893 include 'COMMON.NAMES'
6894 include 'COMMON.TIME1'
6899 distancek(i)=9999999.9
6905 c Pseudo-energy and gradient from homology restraints (MODELLER-like
6907 C AL 5/2/14 - Introduce list of restraints
6908 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
6910 write(iout,*) "------- dist restrs start -------"
6912 do ii = link_start_homo,link_end_homo
6916 c write (iout,*) "dij(",i,j,") =",dij
6917 do k=1,constr_homology
6918 c write(iout,*) ii,k,i,j,l_homo(k,ii),dij,odl(k,ii)
6919 if(.not.l_homo(k,ii)) cycle
6920 distance(k)=odl(k,ii)-dij
6921 c write (iout,*) "distance(",k,") =",distance(k)
6923 c For Gaussian-type Urestr
6925 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
6926 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
6927 c write (iout,*) "distancek(",k,") =",distancek(k)
6928 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
6930 c For Lorentzian-type Urestr
6932 if (waga_dist.lt.0.0d0) then
6933 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
6934 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
6935 & (distance(k)**2+sigma_odlir(k,ii)**2))
6939 c min_odl=minval(distancek)
6940 do kk=1,constr_homology
6941 if(l_homo(kk,ii)) then
6942 min_odl=distancek(kk)
6946 do kk=1,constr_homology
6947 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
6948 & min_odl=distancek(kk)
6951 c write (iout,* )"min_odl",min_odl
6953 write (iout,*) "ij dij",i,j,dij
6954 write (iout,*) "distance",(distance(k),k=1,constr_homology)
6955 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
6956 write (iout,* )"min_odl",min_odl
6959 do k=1,constr_homology
6960 c Nie wiem po co to liczycie jeszcze raz!
6961 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
6962 c & (2*(sigma_odl(i,j,k))**2))
6963 if(.not.l_homo(k,ii)) cycle
6964 if (waga_dist.ge.0.0d0) then
6966 c For Gaussian-type Urestr
6968 godl(k)=dexp(-distancek(k)+min_odl)
6969 odleg2=odleg2+godl(k)
6971 c For Lorentzian-type Urestr
6974 odleg2=odleg2+distancek(k)
6977 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
6978 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
6979 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
6980 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
6983 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6984 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6986 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6987 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6989 if (waga_dist.ge.0.0d0) then
6991 c For Gaussian-type Urestr
6993 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
6995 c For Lorentzian-type Urestr
6998 odleg=odleg+odleg2/constr_homology
7001 c write (iout,*) "odleg",odleg ! sum of -ln-s
7004 c For Gaussian-type Urestr
7006 if (waga_dist.ge.0.0d0) sum_godl=odleg2
7008 do k=1,constr_homology
7009 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
7010 c & *waga_dist)+min_odl
7011 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
7013 if(.not.l_homo(k,ii)) cycle
7014 if (waga_dist.ge.0.0d0) then
7015 c For Gaussian-type Urestr
7017 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
7019 c For Lorentzian-type Urestr
7022 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
7023 & sigma_odlir(k,ii)**2)**2)
7025 sum_sgodl=sum_sgodl+sgodl
7027 c sgodl2=sgodl2+sgodl
7028 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
7029 c write(iout,*) "constr_homology=",constr_homology
7030 c write(iout,*) i, j, k, "TEST K"
7032 if (waga_dist.ge.0.0d0) then
7034 c For Gaussian-type Urestr
7036 grad_odl3=waga_homology(iset)*waga_dist
7037 & *sum_sgodl/(sum_godl*dij)
7039 c For Lorentzian-type Urestr
7042 c Original grad expr modified by analogy w Gaussian-type Urestr grad
7043 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
7044 grad_odl3=-waga_homology(iset)*waga_dist*
7045 & sum_sgodl/(constr_homology*dij)
7048 c grad_odl3=sum_sgodl/(sum_godl*dij)
7051 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
7052 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
7053 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
7055 ccc write(iout,*) godl, sgodl, grad_odl3
7057 c grad_odl=grad_odl+grad_odl3
7060 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
7061 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
7062 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
7063 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
7064 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
7065 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
7066 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
7067 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
7068 c if (i.eq.25.and.j.eq.27) then
7069 c write(iout,*) "jik",jik,"i",i,"j",j
7070 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
7071 c write(iout,*) "grad_odl3",grad_odl3
7072 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
7073 c write(iout,*) "ggodl",ggodl
7074 c write(iout,*) "ghpbc(",jik,i,")",
7075 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
7079 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
7080 ccc & dLOG(odleg2),"-odleg=", -odleg
7082 enddo ! ii-loop for dist
7084 write(iout,*) "------- dist restrs end -------"
7085 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
7086 c & waga_d.eq.1.0d0) call sum_gradient
7088 c Pseudo-energy and gradient from dihedral-angle restraints from
7089 c homology templates
7090 c write (iout,*) "End of distance loop"
7093 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
7095 write(iout,*) "------- dih restrs start -------"
7096 do i=idihconstr_start_homo,idihconstr_end_homo
7097 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
7100 do i=idihconstr_start_homo,idihconstr_end_homo
7102 c betai=beta(i,i+1,i+2,i+3)
7104 c write (iout,*) "betai =",betai
7105 do k=1,constr_homology
7106 dih_diff(k)=pinorm(dih(k,i)-betai)
7107 cd write (iout,'(a8,2i4,2f15.8)') "dih_diff",i,k,dih_diff(k)
7108 cd & ,sigma_dih(k,i)
7109 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
7110 c & -(6.28318-dih_diff(i,k))
7111 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
7112 c & 6.28318+dih_diff(i,k)
7114 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
7115 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
7118 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
7121 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
7122 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
7124 write (iout,*) "i",i," betai",betai," kat2",kat2
7125 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
7127 if (kat2.le.1.0d-14) cycle
7128 kat=kat-dLOG(kat2/constr_homology)
7129 c write (iout,*) "kat",kat ! sum of -ln-s
7131 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
7132 ccc & dLOG(kat2), "-kat=", -kat
7134 c ----------------------------------------------------------------------
7136 c ----------------------------------------------------------------------
7140 do k=1,constr_homology
7141 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
7142 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
7143 sum_sgdih=sum_sgdih+sgdih
7145 c grad_dih3=sum_sgdih/sum_gdih
7146 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
7148 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
7149 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
7150 ccc & gloc(nphi+i-3,icg)
7151 gloc(i-3,icg)=gloc(i-3,icg)+grad_dih3
7153 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
7155 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
7156 ccc & gloc(nphi+i-3,icg)
7158 enddo ! i-loop for dih
7160 write(iout,*) "------- dih restrs end -------"
7163 c Pseudo-energy and gradient for theta angle restraints from
7164 c homology templates
7165 c FP 01/15 - inserted from econstr_local_test.F, loop structure
7169 c For constr_homology reference structures (FP)
7171 c Uconst_back_tot=0.0d0
7174 c Econstr_back legacy
7176 c do i=ithet_start,ithet_end
7179 c do i=loc_start,loc_end
7182 duscdiffx(j,i)=0.0d0
7187 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
7188 c write (iout,*) "waga_theta",waga_theta
7189 if (waga_theta.gt.0.0d0) then
7191 write (iout,*) "usampl",usampl
7192 write(iout,*) "------- theta restrs start -------"
7193 c do i=ithet_start,ithet_end
7194 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
7197 c write (iout,*) "maxres",maxres,"nres",nres
7199 do i=ithet_start,ithet_end
7202 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
7204 c Deviation of theta angles wrt constr_homology ref structures
7206 utheta_i=0.0d0 ! argument of Gaussian for single k
7207 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
7208 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
7209 c over residues in a fragment
7210 c write (iout,*) "theta(",i,")=",theta(i)
7211 do k=1,constr_homology
7213 c dtheta_i=theta(j)-thetaref(j,iref)
7214 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
7215 theta_diff(k)=thetatpl(k,i)-theta(i)
7216 cd write (iout,'(a8,2i4,2f15.8)') "theta_diff",i,k,theta_diff(k)
7217 cd & ,sigma_theta(k,i)
7220 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
7221 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
7222 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
7223 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
7224 c Gradient for single Gaussian restraint in subr Econstr_back
7225 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
7228 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
7229 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
7232 c Gradient for multiple Gaussian restraint
7233 sum_gtheta=gutheta_i
7235 do k=1,constr_homology
7236 c New generalized expr for multiple Gaussian from Econstr_back
7237 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
7239 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
7240 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
7242 c Final value of gradient using same var as in Econstr_back
7243 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)
7244 & +sum_sgtheta/sum_gtheta*waga_theta
7245 & *waga_homology(iset)
7246 c dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
7247 c & *waga_homology(iset)
7248 c dutheta(i)=sum_sgtheta/sum_gtheta
7250 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
7251 Eval=Eval-dLOG(gutheta_i/constr_homology)
7252 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
7253 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
7254 c Uconst_back=Uconst_back+utheta(i)
7255 enddo ! (i-loop for theta)
7257 write(iout,*) "------- theta restrs end -------"
7261 c Deviation of local SC geometry
7263 c Separation of two i-loops (instructed by AL - 11/3/2014)
7265 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
7266 c write (iout,*) "waga_d",waga_d
7269 write(iout,*) "------- SC restrs start -------"
7270 write (iout,*) "Initial duscdiff,duscdiffx"
7271 do i=loc_start,loc_end
7272 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
7273 & (duscdiffx(jik,i),jik=1,3)
7276 do i=loc_start,loc_end
7277 usc_diff_i=0.0d0 ! argument of Gaussian for single k
7278 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
7279 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
7280 c write(iout,*) "xxtab, yytab, zztab"
7281 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
7282 do k=1,constr_homology
7284 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
7285 c Original sign inverted for calc of gradients (s. Econstr_back)
7286 dyy=-yytpl(k,i)+yytab(i) ! ibid y
7287 dzz=-zztpl(k,i)+zztab(i) ! ibid z
7288 c write(iout,*) "dxx, dyy, dzz"
7289 cd write(iout,'(2i5,4f8.2)') k,i,dxx,dyy,dzz,sigma_d(k,i)
7291 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
7292 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
7293 c uscdiffk(k)=usc_diff(i)
7294 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
7295 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
7296 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
7297 c & xxref(j),yyref(j),zzref(j)
7302 c Generalized expression for multiple Gaussian acc to that for a single
7303 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
7305 c Original implementation
7306 c sum_guscdiff=guscdiff(i)
7308 c sum_sguscdiff=0.0d0
7309 c do k=1,constr_homology
7310 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
7311 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
7312 c sum_sguscdiff=sum_sguscdiff+sguscdiff
7315 c Implementation of new expressions for gradient (Jan. 2015)
7317 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
7318 do k=1,constr_homology
7320 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
7321 c before. Now the drivatives should be correct
7323 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
7324 c Original sign inverted for calc of gradients (s. Econstr_back)
7325 dyy=-yytpl(k,i)+yytab(i) ! ibid y
7326 dzz=-zztpl(k,i)+zztab(i) ! ibid z
7328 c New implementation
7330 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
7331 & sigma_d(k,i) ! for the grad wrt r'
7332 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
7335 c New implementation
7336 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
7338 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
7339 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
7340 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
7341 duscdiff(jik,i)=duscdiff(jik,i)+
7342 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
7343 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
7344 duscdiffx(jik,i)=duscdiffx(jik,i)+
7345 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
7346 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
7349 write(iout,*) "jik",jik,"i",i
7350 write(iout,*) "dxx, dyy, dzz"
7351 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
7352 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
7353 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
7354 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
7355 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
7356 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
7357 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
7358 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
7359 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
7360 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
7361 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
7362 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
7363 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
7364 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
7365 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
7371 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
7372 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
7374 c write (iout,*) i," uscdiff",uscdiff(i)
7376 c Put together deviations from local geometry
7378 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
7379 c & wfrag_back(3,i,iset)*uscdiff(i)
7380 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
7381 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
7382 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
7383 c Uconst_back=Uconst_back+usc_diff(i)
7385 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
7387 c New implment: multiplied by sum_sguscdiff
7390 enddo ! (i-loop for dscdiff)
7395 write(iout,*) "------- SC restrs end -------"
7396 write (iout,*) "------ After SC loop in e_modeller ------"
7397 do i=loc_start,loc_end
7398 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
7399 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
7401 if (waga_theta.eq.1.0d0) then
7402 write (iout,*) "in e_modeller after SC restr end: dutheta"
7403 do i=ithet_start,ithet_end
7404 write (iout,*) i,dutheta(i)
7407 if (waga_d.eq.1.0d0) then
7408 write (iout,*) "e_modeller after SC loop: duscdiff/x"
7410 write (iout,*) i,(duscdiff(j,i),j=1,3)
7411 write (iout,*) i,(duscdiffx(j,i),j=1,3)
7416 c Total energy from homology restraints
7418 write (iout,*) "odleg",odleg," kat",kat
7421 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
7423 c ehomology_constr=odleg+kat
7425 c For Lorentzian-type Urestr
7428 if (waga_dist.ge.0.0d0) then
7430 c For Gaussian-type Urestr
7432 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
7433 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
7434 c write (iout,*) "ehomology_constr=",ehomology_constr
7437 c For Lorentzian-type Urestr
7439 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
7440 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
7441 c write (iout,*) "ehomology_constr=",ehomology_constr
7444 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
7445 & "Eval",waga_theta,eval,
7446 & "Erot",waga_d,Erot
7447 write (iout,*) "ehomology_constr",ehomology_constr
7453 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
7454 747 format(a12,i4,i4,i4,f8.3,f8.3)
7455 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
7456 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
7457 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
7458 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
7461 c------------------------------------------------------------------------------
7462 subroutine etor_d(etors_d)
7463 C 6/23/01 Compute double torsional energy
7464 implicit real*8 (a-h,o-z)
7465 include 'DIMENSIONS'
7466 include 'COMMON.VAR'
7467 include 'COMMON.GEO'
7468 include 'COMMON.LOCAL'
7469 include 'COMMON.TORSION'
7470 include 'COMMON.INTERACT'
7471 include 'COMMON.DERIV'
7472 include 'COMMON.CHAIN'
7473 include 'COMMON.NAMES'
7474 include 'COMMON.IOUNITS'
7475 include 'COMMON.FFIELD'
7476 include 'COMMON.TORCNSTR'
7477 include 'COMMON.CONTROL'
7479 C Set lprn=.true. for debugging
7483 c write(iout,*) "a tu??"
7484 do i=iphid_start,iphid_end
7485 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7486 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7487 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7488 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7489 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7490 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7491 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7492 & (itype(i+1).eq.ntyp1)) cycle
7493 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7495 itori=itortyp(itype(i-2))
7496 itori1=itortyp(itype(i-1))
7497 itori2=itortyp(itype(i))
7503 if (iabs(itype(i+1)).eq.20) iblock=2
7504 C Iblock=2 Proline type
7505 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7506 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7507 C if (itype(i+1).eq.ntyp1) iblock=3
7508 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7509 C IS or IS NOT need for this
7510 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7511 C is (itype(i-3).eq.ntyp1) ntblock=2
7512 C ntblock is N-terminal blocking group
7514 C Regular cosine and sine terms
7515 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7516 C Example of changes for NH3+ blocking group
7517 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7518 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7519 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7520 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7521 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7522 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7523 cosphi1=dcos(j*phii)
7524 sinphi1=dsin(j*phii)
7525 cosphi2=dcos(j*phii1)
7526 sinphi2=dsin(j*phii1)
7527 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7528 & v2cij*cosphi2+v2sij*sinphi2
7529 if (energy_dec) etors_d_ii=etors_d_ii+
7530 & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
7531 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7532 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7534 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7536 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7537 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7538 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7539 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7540 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7541 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7542 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7543 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7544 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7545 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7546 if (energy_dec) etors_d_ii=etors_d_ii+
7547 & v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7548 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7549 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7550 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7551 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7552 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7555 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7556 & 'etor_d',i,etors_d_ii
7557 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7558 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7563 c------------------------------------------------------------------------------
7564 subroutine eback_sc_corr(esccor)
7565 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7566 c conformational states; temporarily implemented as differences
7567 c between UNRES torsional potentials (dependent on three types of
7568 c residues) and the torsional potentials dependent on all 20 types
7569 c of residues computed from AM1 energy surfaces of terminally-blocked
7570 c amino-acid residues.
7571 implicit real*8 (a-h,o-z)
7572 include 'DIMENSIONS'
7573 include 'COMMON.VAR'
7574 include 'COMMON.GEO'
7575 include 'COMMON.LOCAL'
7576 include 'COMMON.TORSION'
7577 include 'COMMON.SCCOR'
7578 include 'COMMON.INTERACT'
7579 include 'COMMON.DERIV'
7580 include 'COMMON.CHAIN'
7581 include 'COMMON.NAMES'
7582 include 'COMMON.IOUNITS'
7583 include 'COMMON.FFIELD'
7584 include 'COMMON.CONTROL'
7586 C Set lprn=.true. for debugging
7589 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7591 do i=itau_start,itau_end
7592 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7593 isccori=isccortyp(itype(i-2))
7594 isccori1=isccortyp(itype(i-1))
7595 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7597 do intertyp=1,3 !intertyp
7599 cc Added 09 May 2012 (Adasko)
7600 cc Intertyp means interaction type of backbone mainchain correlation:
7601 c 1 = SC...Ca...Ca...Ca
7602 c 2 = Ca...Ca...Ca...SC
7603 c 3 = SC...Ca...Ca...SCi
7605 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7606 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7607 & (itype(i-1).eq.ntyp1)))
7608 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7609 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7610 & .or.(itype(i).eq.ntyp1)))
7611 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7612 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7613 & (itype(i-3).eq.ntyp1)))) cycle
7614 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7615 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7617 do j=1,nterm_sccor(isccori,isccori1)
7618 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7619 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7620 cosphi=dcos(j*tauangle(intertyp,i))
7621 sinphi=dsin(j*tauangle(intertyp,i))
7622 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
7623 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7624 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7626 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)')
7627 & 'esccor',i,intertyp,esccor_ii
7628 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7629 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7631 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7632 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
7633 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
7634 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7635 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7641 c----------------------------------------------------------------------------
7642 subroutine multibody(ecorr)
7643 C This subroutine calculates multi-body contributions to energy following
7644 C the idea of Skolnick et al. If side chains I and J make a contact and
7645 C at the same time side chains I+1 and J+1 make a contact, an extra
7646 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7647 implicit real*8 (a-h,o-z)
7648 include 'DIMENSIONS'
7649 include 'COMMON.IOUNITS'
7650 include 'COMMON.DERIV'
7651 include 'COMMON.INTERACT'
7652 include 'COMMON.CONTACTS'
7653 double precision gx(3),gx1(3)
7656 C Set lprn=.true. for debugging
7660 write (iout,'(a)') 'Contact function values:'
7662 write (iout,'(i2,20(1x,i2,f10.5))')
7663 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7678 num_conti=num_cont(i)
7679 num_conti1=num_cont(i1)
7684 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7685 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7686 cd & ' ishift=',ishift
7687 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7688 C The system gains extra energy.
7689 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7690 endif ! j1==j+-ishift
7699 c------------------------------------------------------------------------------
7700 double precision function esccorr(i,j,k,l,jj,kk)
7701 implicit real*8 (a-h,o-z)
7702 include 'DIMENSIONS'
7703 include 'COMMON.IOUNITS'
7704 include 'COMMON.DERIV'
7705 include 'COMMON.INTERACT'
7706 include 'COMMON.CONTACTS'
7707 double precision gx(3),gx1(3)
7712 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7713 C Calculate the multi-body contribution to energy.
7714 C Calculate multi-body contributions to the gradient.
7715 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7716 cd & k,l,(gacont(m,kk,k),m=1,3)
7718 gx(m) =ekl*gacont(m,jj,i)
7719 gx1(m)=eij*gacont(m,kk,k)
7720 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7721 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7722 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7723 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7727 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7732 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7738 c------------------------------------------------------------------------------
7739 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7740 C This subroutine calculates multi-body contributions to hydrogen-bonding
7741 implicit real*8 (a-h,o-z)
7742 include 'DIMENSIONS'
7743 include 'COMMON.IOUNITS'
7746 parameter (max_cont=maxconts)
7747 parameter (max_dim=26)
7748 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7749 double precision zapas(max_dim,maxconts,max_fg_procs),
7750 & zapas_recv(max_dim,maxconts,max_fg_procs)
7751 common /przechowalnia/ zapas
7752 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7753 & status_array(MPI_STATUS_SIZE,maxconts*2)
7755 include 'COMMON.SETUP'
7756 include 'COMMON.FFIELD'
7757 include 'COMMON.DERIV'
7758 include 'COMMON.INTERACT'
7759 include 'COMMON.CONTACTS'
7760 include 'COMMON.CONTROL'
7761 include 'COMMON.LOCAL'
7762 double precision gx(3),gx1(3),time00
7765 C Set lprn=.true. for debugging
7770 if (nfgtasks.le.1) goto 30
7772 write (iout,'(a)') 'Contact function values before RECEIVE:'
7774 write (iout,'(2i3,50(1x,i2,f5.2))')
7775 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7776 & j=1,num_cont_hb(i))
7780 do i=1,ntask_cont_from
7783 do i=1,ntask_cont_to
7786 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7788 C Make the list of contacts to send to send to other procesors
7789 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7791 do i=iturn3_start,iturn3_end
7792 c write (iout,*) "make contact list turn3",i," num_cont",
7794 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7796 do i=iturn4_start,iturn4_end
7797 c write (iout,*) "make contact list turn4",i," num_cont",
7799 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7803 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7805 do j=1,num_cont_hb(i)
7808 iproc=iint_sent_local(k,jjc,ii)
7809 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7810 if (iproc.gt.0) then
7811 ncont_sent(iproc)=ncont_sent(iproc)+1
7812 nn=ncont_sent(iproc)
7814 zapas(2,nn,iproc)=jjc
7815 zapas(3,nn,iproc)=facont_hb(j,i)
7816 zapas(4,nn,iproc)=ees0p(j,i)
7817 zapas(5,nn,iproc)=ees0m(j,i)
7818 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7819 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7820 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7821 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7822 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7823 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7824 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7825 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7826 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7827 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7828 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7829 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7830 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7831 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7832 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7833 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7834 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7835 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7836 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7837 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7838 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7845 & "Numbers of contacts to be sent to other processors",
7846 & (ncont_sent(i),i=1,ntask_cont_to)
7847 write (iout,*) "Contacts sent"
7848 do ii=1,ntask_cont_to
7850 iproc=itask_cont_to(ii)
7851 write (iout,*) nn," contacts to processor",iproc,
7852 & " of CONT_TO_COMM group"
7854 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7862 CorrelID1=nfgtasks+fg_rank+1
7864 C Receive the numbers of needed contacts from other processors
7865 do ii=1,ntask_cont_from
7866 iproc=itask_cont_from(ii)
7868 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7869 & FG_COMM,req(ireq),IERR)
7871 c write (iout,*) "IRECV ended"
7873 C Send the number of contacts needed by other processors
7874 do ii=1,ntask_cont_to
7875 iproc=itask_cont_to(ii)
7877 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7878 & FG_COMM,req(ireq),IERR)
7880 c write (iout,*) "ISEND ended"
7881 c write (iout,*) "number of requests (nn)",ireq
7884 & call MPI_Waitall(ireq,req,status_array,ierr)
7886 c & "Numbers of contacts to be received from other processors",
7887 c & (ncont_recv(i),i=1,ntask_cont_from)
7891 do ii=1,ntask_cont_from
7892 iproc=itask_cont_from(ii)
7894 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7895 c & " of CONT_TO_COMM group"
7899 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7900 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7901 c write (iout,*) "ireq,req",ireq,req(ireq)
7904 C Send the contacts to processors that need them
7905 do ii=1,ntask_cont_to
7906 iproc=itask_cont_to(ii)
7908 c write (iout,*) nn," contacts to processor",iproc,
7909 c & " of CONT_TO_COMM group"
7912 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7913 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7914 c write (iout,*) "ireq,req",ireq,req(ireq)
7916 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7920 c write (iout,*) "number of requests (contacts)",ireq
7921 c write (iout,*) "req",(req(i),i=1,4)
7924 & call MPI_Waitall(ireq,req,status_array,ierr)
7925 do iii=1,ntask_cont_from
7926 iproc=itask_cont_from(iii)
7929 write (iout,*) "Received",nn," contacts from processor",iproc,
7930 & " of CONT_FROM_COMM group"
7933 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7938 ii=zapas_recv(1,i,iii)
7939 c Flag the received contacts to prevent double-counting
7940 jj=-zapas_recv(2,i,iii)
7941 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7943 nnn=num_cont_hb(ii)+1
7946 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7947 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7948 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7949 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7950 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7951 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7952 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7953 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7954 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7955 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7956 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7957 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7958 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7959 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7960 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7961 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7962 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7963 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7964 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7965 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7966 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7967 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7968 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7969 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7974 write (iout,'(a)') 'Contact function values after receive:'
7976 write (iout,'(2i3,50(1x,i3,f5.2))')
7977 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7978 & j=1,num_cont_hb(i))
7985 write (iout,'(a)') 'Contact function values:'
7987 write (iout,'(2i3,50(1x,i3,f5.2))')
7988 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7989 & j=1,num_cont_hb(i))
7993 C Remove the loop below after debugging !!!
8000 C Calculate the local-electrostatic correlation terms
8001 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8003 num_conti=num_cont_hb(i)
8004 num_conti1=num_cont_hb(i+1)
8011 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8012 c & ' jj=',jj,' kk=',kk
8013 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8014 & .or. j.lt.0 .and. j1.gt.0) .and.
8015 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8016 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8017 C The system gains extra energy.
8018 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8019 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
8020 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
8022 else if (j1.eq.j) then
8023 C Contacts I-J and I-(J+1) occur simultaneously.
8024 C The system loses extra energy.
8025 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8030 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8031 c & ' jj=',jj,' kk=',kk
8033 C Contacts I-J and (I+1)-J occur simultaneously.
8034 C The system loses extra energy.
8035 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8042 c------------------------------------------------------------------------------
8043 subroutine add_hb_contact(ii,jj,itask)
8044 implicit real*8 (a-h,o-z)
8045 include "DIMENSIONS"
8046 include "COMMON.IOUNITS"
8049 parameter (max_cont=maxconts)
8050 parameter (max_dim=26)
8051 include "COMMON.CONTACTS"
8052 double precision zapas(max_dim,maxconts,max_fg_procs),
8053 & zapas_recv(max_dim,maxconts,max_fg_procs)
8054 common /przechowalnia/ zapas
8055 integer i,j,ii,jj,iproc,itask(4),nn
8056 c write (iout,*) "itask",itask
8059 if (iproc.gt.0) then
8060 do j=1,num_cont_hb(ii)
8062 c write (iout,*) "i",ii," j",jj," jjc",jjc
8064 ncont_sent(iproc)=ncont_sent(iproc)+1
8065 nn=ncont_sent(iproc)
8066 zapas(1,nn,iproc)=ii
8067 zapas(2,nn,iproc)=jjc
8068 zapas(3,nn,iproc)=facont_hb(j,ii)
8069 zapas(4,nn,iproc)=ees0p(j,ii)
8070 zapas(5,nn,iproc)=ees0m(j,ii)
8071 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8072 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8073 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8074 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8075 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8076 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8077 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8078 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8079 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8080 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8081 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8082 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8083 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8084 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8085 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8086 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8087 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8088 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8089 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8090 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8091 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8099 c------------------------------------------------------------------------------
8100 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8102 C This subroutine calculates multi-body contributions to hydrogen-bonding
8103 implicit real*8 (a-h,o-z)
8104 include 'DIMENSIONS'
8105 include 'COMMON.IOUNITS'
8108 parameter (max_cont=maxconts)
8109 parameter (max_dim=70)
8110 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8111 double precision zapas(max_dim,maxconts,max_fg_procs),
8112 & zapas_recv(max_dim,maxconts,max_fg_procs)
8113 common /przechowalnia/ zapas
8114 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8115 & status_array(MPI_STATUS_SIZE,maxconts*2)
8117 include 'COMMON.SETUP'
8118 include 'COMMON.FFIELD'
8119 include 'COMMON.DERIV'
8120 include 'COMMON.LOCAL'
8121 include 'COMMON.INTERACT'
8122 include 'COMMON.CONTACTS'
8123 include 'COMMON.CHAIN'
8124 include 'COMMON.CONTROL'
8125 double precision gx(3),gx1(3)
8126 integer num_cont_hb_old(maxres)
8128 double precision eello4,eello5,eelo6,eello_turn6
8129 external eello4,eello5,eello6,eello_turn6
8130 C Set lprn=.true. for debugging
8135 num_cont_hb_old(i)=num_cont_hb(i)
8139 if (nfgtasks.le.1) goto 30
8141 write (iout,'(a)') 'Contact function values before RECEIVE:'
8143 write (iout,'(2i3,50(1x,i2,f5.2))')
8144 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8145 & j=1,num_cont_hb(i))
8149 do i=1,ntask_cont_from
8152 do i=1,ntask_cont_to
8155 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8157 C Make the list of contacts to send to send to other procesors
8158 do i=iturn3_start,iturn3_end
8159 c write (iout,*) "make contact list turn3",i," num_cont",
8161 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8163 do i=iturn4_start,iturn4_end
8164 c write (iout,*) "make contact list turn4",i," num_cont",
8166 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8170 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8172 do j=1,num_cont_hb(i)
8175 iproc=iint_sent_local(k,jjc,ii)
8176 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8177 if (iproc.ne.0) then
8178 ncont_sent(iproc)=ncont_sent(iproc)+1
8179 nn=ncont_sent(iproc)
8181 zapas(2,nn,iproc)=jjc
8182 zapas(3,nn,iproc)=d_cont(j,i)
8186 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8191 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8199 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8210 & "Numbers of contacts to be sent to other processors",
8211 & (ncont_sent(i),i=1,ntask_cont_to)
8212 write (iout,*) "Contacts sent"
8213 do ii=1,ntask_cont_to
8215 iproc=itask_cont_to(ii)
8216 write (iout,*) nn," contacts to processor",iproc,
8217 & " of CONT_TO_COMM group"
8219 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8227 CorrelID1=nfgtasks+fg_rank+1
8229 C Receive the numbers of needed contacts from other processors
8230 do ii=1,ntask_cont_from
8231 iproc=itask_cont_from(ii)
8233 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8234 & FG_COMM,req(ireq),IERR)
8236 c write (iout,*) "IRECV ended"
8238 C Send the number of contacts needed by other processors
8239 do ii=1,ntask_cont_to
8240 iproc=itask_cont_to(ii)
8242 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8243 & FG_COMM,req(ireq),IERR)
8245 c write (iout,*) "ISEND ended"
8246 c write (iout,*) "number of requests (nn)",ireq
8249 & call MPI_Waitall(ireq,req,status_array,ierr)
8251 c & "Numbers of contacts to be received from other processors",
8252 c & (ncont_recv(i),i=1,ntask_cont_from)
8256 do ii=1,ntask_cont_from
8257 iproc=itask_cont_from(ii)
8259 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8260 c & " of CONT_TO_COMM group"
8264 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8265 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8266 c write (iout,*) "ireq,req",ireq,req(ireq)
8269 C Send the contacts to processors that need them
8270 do ii=1,ntask_cont_to
8271 iproc=itask_cont_to(ii)
8273 c write (iout,*) nn," contacts to processor",iproc,
8274 c & " of CONT_TO_COMM group"
8277 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8278 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8279 c write (iout,*) "ireq,req",ireq,req(ireq)
8281 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8285 c write (iout,*) "number of requests (contacts)",ireq
8286 c write (iout,*) "req",(req(i),i=1,4)
8289 & call MPI_Waitall(ireq,req,status_array,ierr)
8290 do iii=1,ntask_cont_from
8291 iproc=itask_cont_from(iii)
8294 write (iout,*) "Received",nn," contacts from processor",iproc,
8295 & " of CONT_FROM_COMM group"
8298 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8303 ii=zapas_recv(1,i,iii)
8304 c Flag the received contacts to prevent double-counting
8305 jj=-zapas_recv(2,i,iii)
8306 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8308 nnn=num_cont_hb(ii)+1
8311 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8315 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8320 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8328 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8337 write (iout,'(a)') 'Contact function values after receive:'
8339 write (iout,'(2i3,50(1x,i3,5f6.3))')
8340 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8341 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8348 write (iout,'(a)') 'Contact function values:'
8350 write (iout,'(2i3,50(1x,i2,5f6.3))')
8351 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8352 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8358 C Remove the loop below after debugging !!!
8365 C Calculate the dipole-dipole interaction energies
8366 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8367 do i=iatel_s,iatel_e+1
8368 num_conti=num_cont_hb(i)
8377 C Calculate the local-electrostatic correlation terms
8378 c write (iout,*) "gradcorr5 in eello5 before loop"
8380 c write (iout,'(i5,3f10.5)')
8381 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8383 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8384 c write (iout,*) "corr loop i",i
8386 num_conti=num_cont_hb(i)
8387 num_conti1=num_cont_hb(i+1)
8394 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8395 c & ' jj=',jj,' kk=',kk
8396 c if (j1.eq.j+1 .or. j1.eq.j-1) then
8397 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8398 & .or. j.lt.0 .and. j1.gt.0) .and.
8399 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8400 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8401 C The system gains extra energy.
8403 sqd1=dsqrt(d_cont(jj,i))
8404 sqd2=dsqrt(d_cont(kk,i1))
8405 sred_geom = sqd1*sqd2
8406 IF (sred_geom.lt.cutoff_corr) THEN
8407 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
8409 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8410 cd & ' jj=',jj,' kk=',kk
8411 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8412 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8414 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8415 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8418 cd write (iout,*) 'sred_geom=',sred_geom,
8419 cd & ' ekont=',ekont,' fprim=',fprimcont,
8420 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8421 cd write (iout,*) "g_contij",g_contij
8422 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8423 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8424 call calc_eello(i,jp,i+1,jp1,jj,kk)
8425 if (wcorr4.gt.0.0d0)
8426 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8427 if (energy_dec.and.wcorr4.gt.0.0d0)
8428 1 write (iout,'(a6,4i5,0pf7.3)')
8429 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8430 c write (iout,*) "gradcorr5 before eello5"
8432 c write (iout,'(i5,3f10.5)')
8433 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8435 if (wcorr5.gt.0.0d0)
8436 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8437 c write (iout,*) "gradcorr5 after eello5"
8439 c write (iout,'(i5,3f10.5)')
8440 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8442 if (energy_dec.and.wcorr5.gt.0.0d0)
8443 1 write (iout,'(a6,4i5,0pf7.3)')
8444 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8445 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8446 cd write(2,*)'ijkl',i,jp,i+1,jp1
8447 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
8448 & .or. wturn6.eq.0.0d0))then
8449 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8450 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8451 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8452 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8453 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8454 cd & 'ecorr6=',ecorr6
8455 cd write (iout,'(4e15.5)') sred_geom,
8456 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8457 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8458 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8459 else if (wturn6.gt.0.0d0
8460 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8461 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8462 eturn6=eturn6+eello_turn6(i,jj,kk)
8463 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8464 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8465 cd write (2,*) 'multibody_eello:eturn6',eturn6
8474 num_cont_hb(i)=num_cont_hb_old(i)
8476 c write (iout,*) "gradcorr5 in eello5"
8478 c write (iout,'(i5,3f10.5)')
8479 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8483 c------------------------------------------------------------------------------
8484 subroutine add_hb_contact_eello(ii,jj,itask)
8485 implicit real*8 (a-h,o-z)
8486 include "DIMENSIONS"
8487 include "COMMON.IOUNITS"
8490 parameter (max_cont=maxconts)
8491 parameter (max_dim=70)
8492 include "COMMON.CONTACTS"
8493 double precision zapas(max_dim,maxconts,max_fg_procs),
8494 & zapas_recv(max_dim,maxconts,max_fg_procs)
8495 common /przechowalnia/ zapas
8496 integer i,j,ii,jj,iproc,itask(4),nn
8497 c write (iout,*) "itask",itask
8500 if (iproc.gt.0) then
8501 do j=1,num_cont_hb(ii)
8503 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8505 ncont_sent(iproc)=ncont_sent(iproc)+1
8506 nn=ncont_sent(iproc)
8507 zapas(1,nn,iproc)=ii
8508 zapas(2,nn,iproc)=jjc
8509 zapas(3,nn,iproc)=d_cont(j,ii)
8513 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8518 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8526 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8538 c------------------------------------------------------------------------------
8539 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8540 implicit real*8 (a-h,o-z)
8541 include 'DIMENSIONS'
8542 include 'COMMON.IOUNITS'
8543 include 'COMMON.DERIV'
8544 include 'COMMON.INTERACT'
8545 include 'COMMON.CONTACTS'
8546 double precision gx(3),gx1(3)
8556 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8557 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8558 C Following 4 lines for diagnostics.
8563 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8564 c & 'Contacts ',i,j,
8565 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8566 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8568 C Calculate the multi-body contribution to energy.
8569 c ecorr=ecorr+ekont*ees
8570 C Calculate multi-body contributions to the gradient.
8571 coeffpees0pij=coeffp*ees0pij
8572 coeffmees0mij=coeffm*ees0mij
8573 coeffpees0pkl=coeffp*ees0pkl
8574 coeffmees0mkl=coeffm*ees0mkl
8576 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8577 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8578 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8579 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8580 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8581 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8582 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8583 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8584 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8585 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8586 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8587 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8588 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8589 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8590 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8591 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8592 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8593 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8594 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8595 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8596 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8597 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8598 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8599 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8600 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8605 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8606 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8607 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8608 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8613 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8614 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8615 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8616 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8619 c write (iout,*) "ehbcorr",ekont*ees
8624 C---------------------------------------------------------------------------
8625 subroutine dipole(i,j,jj)
8626 implicit real*8 (a-h,o-z)
8627 include 'DIMENSIONS'
8628 include 'COMMON.IOUNITS'
8629 include 'COMMON.CHAIN'
8630 include 'COMMON.FFIELD'
8631 include 'COMMON.DERIV'
8632 include 'COMMON.INTERACT'
8633 include 'COMMON.CONTACTS'
8634 include 'COMMON.TORSION'
8635 include 'COMMON.VAR'
8636 include 'COMMON.GEO'
8637 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8639 iti1 = itortyp(itype(i+1))
8640 if (j.lt.nres-1) then
8641 itj1 = itortyp(itype(j+1))
8646 dipi(iii,1)=Ub2(iii,i)
8647 dipderi(iii)=Ub2der(iii,i)
8648 dipi(iii,2)=b1(iii,i+1)
8649 dipj(iii,1)=Ub2(iii,j)
8650 dipderj(iii)=Ub2der(iii,j)
8651 dipj(iii,2)=b1(iii,j+1)
8655 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8658 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8665 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8669 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8674 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8675 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8677 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8679 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8681 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8686 C---------------------------------------------------------------------------
8687 subroutine calc_eello(i,j,k,l,jj,kk)
8689 C This subroutine computes matrices and vectors needed to calculate
8690 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8692 implicit real*8 (a-h,o-z)
8693 include 'DIMENSIONS'
8694 include 'COMMON.IOUNITS'
8695 include 'COMMON.CHAIN'
8696 include 'COMMON.DERIV'
8697 include 'COMMON.INTERACT'
8698 include 'COMMON.CONTACTS'
8699 include 'COMMON.TORSION'
8700 include 'COMMON.VAR'
8701 include 'COMMON.GEO'
8702 include 'COMMON.FFIELD'
8703 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8704 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8707 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8708 cd & ' jj=',jj,' kk=',kk
8709 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8710 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8711 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8714 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8715 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8718 call transpose2(aa1(1,1),aa1t(1,1))
8719 call transpose2(aa2(1,1),aa2t(1,1))
8722 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8723 & aa1tder(1,1,lll,kkk))
8724 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8725 & aa2tder(1,1,lll,kkk))
8729 C parallel orientation of the two CA-CA-CA frames.
8731 iti=itortyp(itype(i))
8735 itk1=itortyp(itype(k+1))
8736 itj=itortyp(itype(j))
8737 if (l.lt.nres-1) then
8738 itl1=itortyp(itype(l+1))
8742 C A1 kernel(j+1) A2T
8744 cd write (iout,'(3f10.5,5x,3f10.5)')
8745 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8747 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8748 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8749 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8750 C Following matrices are needed only for 6-th order cumulants
8751 IF (wcorr6.gt.0.0d0) THEN
8752 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8753 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8754 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8755 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8756 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8757 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8758 & ADtEAderx(1,1,1,1,1,1))
8760 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8761 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8762 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8763 & ADtEA1derx(1,1,1,1,1,1))
8765 C End 6-th order cumulants
8768 cd write (2,*) 'In calc_eello6'
8770 cd write (2,*) 'iii=',iii
8772 cd write (2,*) 'kkk=',kkk
8774 cd write (2,'(3(2f10.5),5x)')
8775 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8780 call transpose2(EUgder(1,1,k),auxmat(1,1))
8781 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8782 call transpose2(EUg(1,1,k),auxmat(1,1))
8783 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8784 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8788 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8789 & EAEAderx(1,1,lll,kkk,iii,1))
8793 C A1T kernel(i+1) A2
8794 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8795 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8796 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8797 C Following matrices are needed only for 6-th order cumulants
8798 IF (wcorr6.gt.0.0d0) THEN
8799 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8800 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8801 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8802 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8803 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8804 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8805 & ADtEAderx(1,1,1,1,1,2))
8806 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8807 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8808 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8809 & ADtEA1derx(1,1,1,1,1,2))
8811 C End 6-th order cumulants
8812 call transpose2(EUgder(1,1,l),auxmat(1,1))
8813 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8814 call transpose2(EUg(1,1,l),auxmat(1,1))
8815 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8816 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8820 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8821 & EAEAderx(1,1,lll,kkk,iii,2))
8826 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8827 C They are needed only when the fifth- or the sixth-order cumulants are
8829 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8830 call transpose2(AEA(1,1,1),auxmat(1,1))
8831 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8832 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8833 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8834 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8835 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8836 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8837 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8838 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8839 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8840 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8841 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8842 call transpose2(AEA(1,1,2),auxmat(1,1))
8843 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8844 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8845 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8846 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8847 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8848 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8849 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8850 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8851 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8852 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8853 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8854 C Calculate the Cartesian derivatives of the vectors.
8858 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8859 call matvec2(auxmat(1,1),b1(1,i),
8860 & AEAb1derx(1,lll,kkk,iii,1,1))
8861 call matvec2(auxmat(1,1),Ub2(1,i),
8862 & AEAb2derx(1,lll,kkk,iii,1,1))
8863 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8864 & AEAb1derx(1,lll,kkk,iii,2,1))
8865 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8866 & AEAb2derx(1,lll,kkk,iii,2,1))
8867 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8868 call matvec2(auxmat(1,1),b1(1,j),
8869 & AEAb1derx(1,lll,kkk,iii,1,2))
8870 call matvec2(auxmat(1,1),Ub2(1,j),
8871 & AEAb2derx(1,lll,kkk,iii,1,2))
8872 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8873 & AEAb1derx(1,lll,kkk,iii,2,2))
8874 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8875 & AEAb2derx(1,lll,kkk,iii,2,2))
8882 C Antiparallel orientation of the two CA-CA-CA frames.
8884 iti=itortyp(itype(i))
8888 itk1=itortyp(itype(k+1))
8889 itl=itortyp(itype(l))
8890 itj=itortyp(itype(j))
8891 if (j.lt.nres-1) then
8892 itj1=itortyp(itype(j+1))
8896 C A2 kernel(j-1)T A1T
8897 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8898 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8899 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8900 C Following matrices are needed only for 6-th order cumulants
8901 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8902 & j.eq.i+4 .and. l.eq.i+3)) THEN
8903 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8904 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8905 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8906 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8907 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8908 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8909 & ADtEAderx(1,1,1,1,1,1))
8910 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8911 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8912 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8913 & ADtEA1derx(1,1,1,1,1,1))
8915 C End 6-th order cumulants
8916 call transpose2(EUgder(1,1,k),auxmat(1,1))
8917 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8918 call transpose2(EUg(1,1,k),auxmat(1,1))
8919 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8920 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8924 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8925 & EAEAderx(1,1,lll,kkk,iii,1))
8929 C A2T kernel(i+1)T A1
8930 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8931 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8932 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8933 C Following matrices are needed only for 6-th order cumulants
8934 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8935 & j.eq.i+4 .and. l.eq.i+3)) THEN
8936 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8937 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8938 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8939 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8940 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8941 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8942 & ADtEAderx(1,1,1,1,1,2))
8943 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8944 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8945 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8946 & ADtEA1derx(1,1,1,1,1,2))
8948 C End 6-th order cumulants
8949 call transpose2(EUgder(1,1,j),auxmat(1,1))
8950 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8951 call transpose2(EUg(1,1,j),auxmat(1,1))
8952 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8953 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8957 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8958 & EAEAderx(1,1,lll,kkk,iii,2))
8963 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8964 C They are needed only when the fifth- or the sixth-order cumulants are
8966 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8967 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8968 call transpose2(AEA(1,1,1),auxmat(1,1))
8969 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8970 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8971 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8972 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8973 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8974 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8975 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8976 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8977 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8978 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8979 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8980 call transpose2(AEA(1,1,2),auxmat(1,1))
8981 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8982 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8983 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8984 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8985 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8986 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8987 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8988 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8989 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8990 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8991 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8992 C Calculate the Cartesian derivatives of the vectors.
8996 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8997 call matvec2(auxmat(1,1),b1(1,i),
8998 & AEAb1derx(1,lll,kkk,iii,1,1))
8999 call matvec2(auxmat(1,1),Ub2(1,i),
9000 & AEAb2derx(1,lll,kkk,iii,1,1))
9001 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9002 & AEAb1derx(1,lll,kkk,iii,2,1))
9003 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9004 & AEAb2derx(1,lll,kkk,iii,2,1))
9005 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9006 call matvec2(auxmat(1,1),b1(1,l),
9007 & AEAb1derx(1,lll,kkk,iii,1,2))
9008 call matvec2(auxmat(1,1),Ub2(1,l),
9009 & AEAb2derx(1,lll,kkk,iii,1,2))
9010 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
9011 & AEAb1derx(1,lll,kkk,iii,2,2))
9012 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
9013 & AEAb2derx(1,lll,kkk,iii,2,2))
9022 C---------------------------------------------------------------------------
9023 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
9024 & KK,KKderg,AKA,AKAderg,AKAderx)
9028 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
9029 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
9030 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
9035 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9037 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
9040 cd if (lprn) write (2,*) 'In kernel'
9042 cd if (lprn) write (2,*) 'kkk=',kkk
9044 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
9045 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9047 cd write (2,*) 'lll=',lll
9048 cd write (2,*) 'iii=1'
9050 cd write (2,'(3(2f10.5),5x)')
9051 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9054 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
9055 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9057 cd write (2,*) 'lll=',lll
9058 cd write (2,*) 'iii=2'
9060 cd write (2,'(3(2f10.5),5x)')
9061 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9068 C---------------------------------------------------------------------------
9069 double precision function eello4(i,j,k,l,jj,kk)
9070 implicit real*8 (a-h,o-z)
9071 include 'DIMENSIONS'
9072 include 'COMMON.IOUNITS'
9073 include 'COMMON.CHAIN'
9074 include 'COMMON.DERIV'
9075 include 'COMMON.INTERACT'
9076 include 'COMMON.CONTACTS'
9077 include 'COMMON.TORSION'
9078 include 'COMMON.VAR'
9079 include 'COMMON.GEO'
9080 double precision pizda(2,2),ggg1(3),ggg2(3)
9081 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9085 cd print *,'eello4:',i,j,k,l,jj,kk
9086 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9087 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9088 cold eij=facont_hb(jj,i)
9089 cold ekl=facont_hb(kk,k)
9091 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9092 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9093 gcorr_loc(k-1)=gcorr_loc(k-1)
9094 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9096 gcorr_loc(l-1)=gcorr_loc(l-1)
9097 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9099 gcorr_loc(j-1)=gcorr_loc(j-1)
9100 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9105 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9106 & -EAEAderx(2,2,lll,kkk,iii,1)
9107 cd derx(lll,kkk,iii)=0.0d0
9111 cd gcorr_loc(l-1)=0.0d0
9112 cd gcorr_loc(j-1)=0.0d0
9113 cd gcorr_loc(k-1)=0.0d0
9115 cd write (iout,*)'Contacts have occurred for peptide groups',
9116 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9117 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9118 if (j.lt.nres-1) then
9125 if (l.lt.nres-1) then
9133 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9134 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9135 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9136 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9137 cgrad ghalf=0.5d0*ggg1(ll)
9138 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9139 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9140 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9141 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9142 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9143 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9144 cgrad ghalf=0.5d0*ggg2(ll)
9145 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9146 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9147 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9148 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9149 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9150 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9154 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9159 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9164 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9169 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9173 cd write (2,*) iii,gcorr_loc(iii)
9176 cd write (2,*) 'ekont',ekont
9177 cd write (iout,*) 'eello4',ekont*eel4
9180 C---------------------------------------------------------------------------
9181 double precision function eello5(i,j,k,l,jj,kk)
9182 implicit real*8 (a-h,o-z)
9183 include 'DIMENSIONS'
9184 include 'COMMON.IOUNITS'
9185 include 'COMMON.CHAIN'
9186 include 'COMMON.DERIV'
9187 include 'COMMON.INTERACT'
9188 include 'COMMON.CONTACTS'
9189 include 'COMMON.TORSION'
9190 include 'COMMON.VAR'
9191 include 'COMMON.GEO'
9192 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9193 double precision ggg1(3),ggg2(3)
9194 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9199 C /l\ / \ \ / \ / \ / C
9200 C / \ / \ \ / \ / \ / C
9201 C j| o |l1 | o | o| o | | o |o C
9202 C \ |/k\| |/ \| / |/ \| |/ \| C
9203 C \i/ \ / \ / / \ / \ C
9205 C (I) (II) (III) (IV) C
9207 C eello5_1 eello5_2 eello5_3 eello5_4 C
9209 C Antiparallel chains C
9212 C /j\ / \ \ / \ / \ / C
9213 C / \ / \ \ / \ / \ / C
9214 C j1| o |l | o | o| o | | o |o C
9215 C \ |/k\| |/ \| / |/ \| |/ \| C
9216 C \i/ \ / \ / / \ / \ C
9218 C (I) (II) (III) (IV) C
9220 C eello5_1 eello5_2 eello5_3 eello5_4 C
9222 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9224 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9225 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9230 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9232 itk=itortyp(itype(k))
9233 itl=itortyp(itype(l))
9234 itj=itortyp(itype(j))
9239 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9240 cd & eel5_3_num,eel5_4_num)
9244 derx(lll,kkk,iii)=0.0d0
9248 cd eij=facont_hb(jj,i)
9249 cd ekl=facont_hb(kk,k)
9251 cd write (iout,*)'Contacts have occurred for peptide groups',
9252 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9254 C Contribution from the graph I.
9255 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9256 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9257 call transpose2(EUg(1,1,k),auxmat(1,1))
9258 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9259 vv(1)=pizda(1,1)-pizda(2,2)
9260 vv(2)=pizda(1,2)+pizda(2,1)
9261 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9262 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9263 C Explicit gradient in virtual-dihedral angles.
9264 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9265 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9266 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9267 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9268 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9269 vv(1)=pizda(1,1)-pizda(2,2)
9270 vv(2)=pizda(1,2)+pizda(2,1)
9271 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9272 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9273 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9274 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9275 vv(1)=pizda(1,1)-pizda(2,2)
9276 vv(2)=pizda(1,2)+pizda(2,1)
9278 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9279 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9280 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9282 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9283 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9284 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9286 C Cartesian gradient
9290 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
9292 vv(1)=pizda(1,1)-pizda(2,2)
9293 vv(2)=pizda(1,2)+pizda(2,1)
9294 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9295 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
9296 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9302 C Contribution from graph II
9303 call transpose2(EE(1,1,itk),auxmat(1,1))
9304 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9305 vv(1)=pizda(1,1)+pizda(2,2)
9306 vv(2)=pizda(2,1)-pizda(1,2)
9307 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
9308 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9309 C Explicit gradient in virtual-dihedral angles.
9310 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9311 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9312 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9313 vv(1)=pizda(1,1)+pizda(2,2)
9314 vv(2)=pizda(2,1)-pizda(1,2)
9316 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9317 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9318 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9320 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9321 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9322 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9324 C Cartesian gradient
9328 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9330 vv(1)=pizda(1,1)+pizda(2,2)
9331 vv(2)=pizda(2,1)-pizda(1,2)
9332 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9333 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
9334 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9342 C Parallel orientation
9343 C Contribution from graph III
9344 call transpose2(EUg(1,1,l),auxmat(1,1))
9345 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9346 vv(1)=pizda(1,1)-pizda(2,2)
9347 vv(2)=pizda(1,2)+pizda(2,1)
9348 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
9349 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9350 C Explicit gradient in virtual-dihedral angles.
9351 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9352 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
9353 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9354 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9355 vv(1)=pizda(1,1)-pizda(2,2)
9356 vv(2)=pizda(1,2)+pizda(2,1)
9357 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9358 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
9359 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9360 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9361 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9362 vv(1)=pizda(1,1)-pizda(2,2)
9363 vv(2)=pizda(1,2)+pizda(2,1)
9364 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9365 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
9366 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9367 C Cartesian gradient
9371 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9373 vv(1)=pizda(1,1)-pizda(2,2)
9374 vv(2)=pizda(1,2)+pizda(2,1)
9375 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9376 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
9377 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9382 C Contribution from graph IV
9384 call transpose2(EE(1,1,itl),auxmat(1,1))
9385 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9386 vv(1)=pizda(1,1)+pizda(2,2)
9387 vv(2)=pizda(2,1)-pizda(1,2)
9388 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
9389 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9390 C Explicit gradient in virtual-dihedral angles.
9391 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9392 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9393 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9394 vv(1)=pizda(1,1)+pizda(2,2)
9395 vv(2)=pizda(2,1)-pizda(1,2)
9396 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9397 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
9398 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9399 C Cartesian gradient
9403 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9405 vv(1)=pizda(1,1)+pizda(2,2)
9406 vv(2)=pizda(2,1)-pizda(1,2)
9407 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9408 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
9409 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9414 C Antiparallel orientation
9415 C Contribution from graph III
9417 call transpose2(EUg(1,1,j),auxmat(1,1))
9418 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9419 vv(1)=pizda(1,1)-pizda(2,2)
9420 vv(2)=pizda(1,2)+pizda(2,1)
9421 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9422 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9423 C Explicit gradient in virtual-dihedral angles.
9424 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9425 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9426 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9427 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9428 vv(1)=pizda(1,1)-pizda(2,2)
9429 vv(2)=pizda(1,2)+pizda(2,1)
9430 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9431 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9432 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9433 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9434 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9435 vv(1)=pizda(1,1)-pizda(2,2)
9436 vv(2)=pizda(1,2)+pizda(2,1)
9437 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9438 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9439 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9440 C Cartesian gradient
9444 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9446 vv(1)=pizda(1,1)-pizda(2,2)
9447 vv(2)=pizda(1,2)+pizda(2,1)
9448 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9449 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9450 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9455 C Contribution from graph IV
9457 call transpose2(EE(1,1,itj),auxmat(1,1))
9458 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9459 vv(1)=pizda(1,1)+pizda(2,2)
9460 vv(2)=pizda(2,1)-pizda(1,2)
9461 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9462 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9463 C Explicit gradient in virtual-dihedral angles.
9464 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9465 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9466 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9467 vv(1)=pizda(1,1)+pizda(2,2)
9468 vv(2)=pizda(2,1)-pizda(1,2)
9469 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9470 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9471 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9472 C Cartesian gradient
9476 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9478 vv(1)=pizda(1,1)+pizda(2,2)
9479 vv(2)=pizda(2,1)-pizda(1,2)
9480 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9481 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9482 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9488 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9489 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9490 cd write (2,*) 'ijkl',i,j,k,l
9491 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9492 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9494 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9495 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9496 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9497 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9498 if (j.lt.nres-1) then
9505 if (l.lt.nres-1) then
9515 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9516 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9517 C summed up outside the subrouine as for the other subroutines
9518 C handling long-range interactions. The old code is commented out
9519 C with "cgrad" to keep track of changes.
9521 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9522 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9523 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9524 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9525 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9526 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9527 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9528 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9529 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9530 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9532 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9533 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9534 cgrad ghalf=0.5d0*ggg1(ll)
9536 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9537 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9538 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9539 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9540 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9541 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9542 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9543 cgrad ghalf=0.5d0*ggg2(ll)
9545 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
9546 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9547 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
9548 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9549 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9550 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9555 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9556 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9561 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9562 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9568 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9573 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9577 cd write (2,*) iii,g_corr5_loc(iii)
9580 cd write (2,*) 'ekont',ekont
9581 cd write (iout,*) 'eello5',ekont*eel5
9584 c--------------------------------------------------------------------------
9585 double precision function eello6(i,j,k,l,jj,kk)
9586 implicit real*8 (a-h,o-z)
9587 include 'DIMENSIONS'
9588 include 'COMMON.IOUNITS'
9589 include 'COMMON.CHAIN'
9590 include 'COMMON.DERIV'
9591 include 'COMMON.INTERACT'
9592 include 'COMMON.CONTACTS'
9593 include 'COMMON.TORSION'
9594 include 'COMMON.VAR'
9595 include 'COMMON.GEO'
9596 include 'COMMON.FFIELD'
9597 double precision ggg1(3),ggg2(3)
9598 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9603 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9611 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9612 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9616 derx(lll,kkk,iii)=0.0d0
9620 cd eij=facont_hb(jj,i)
9621 cd ekl=facont_hb(kk,k)
9627 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9628 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9629 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9630 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9631 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9632 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9634 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9635 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9636 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9637 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9638 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9639 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9643 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9645 C If turn contributions are considered, they will be handled separately.
9646 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9647 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9648 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9649 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9650 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9651 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9652 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9654 if (j.lt.nres-1) then
9661 if (l.lt.nres-1) then
9669 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9670 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9671 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9672 cgrad ghalf=0.5d0*ggg1(ll)
9674 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9675 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9676 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9677 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9678 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9679 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9680 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9681 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9682 cgrad ghalf=0.5d0*ggg2(ll)
9683 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9685 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9686 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9687 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9688 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9689 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9690 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9695 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9696 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9701 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9702 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9708 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9713 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9717 cd write (2,*) iii,g_corr6_loc(iii)
9720 cd write (2,*) 'ekont',ekont
9721 cd write (iout,*) 'eello6',ekont*eel6
9724 c--------------------------------------------------------------------------
9725 double precision function eello6_graph1(i,j,k,l,imat,swap)
9726 implicit real*8 (a-h,o-z)
9727 include 'DIMENSIONS'
9728 include 'COMMON.IOUNITS'
9729 include 'COMMON.CHAIN'
9730 include 'COMMON.DERIV'
9731 include 'COMMON.INTERACT'
9732 include 'COMMON.CONTACTS'
9733 include 'COMMON.TORSION'
9734 include 'COMMON.VAR'
9735 include 'COMMON.GEO'
9736 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9740 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9742 C Parallel Antiparallel C
9748 C \ j|/k\| / \ |/k\|l / C
9753 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9754 itk=itortyp(itype(k))
9755 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9756 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9757 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9758 call transpose2(EUgC(1,1,k),auxmat(1,1))
9759 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9760 vv1(1)=pizda1(1,1)-pizda1(2,2)
9761 vv1(2)=pizda1(1,2)+pizda1(2,1)
9762 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9763 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9764 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9765 s5=scalar2(vv(1),Dtobr2(1,i))
9766 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9767 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9768 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9769 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9770 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9771 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9772 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9773 & +scalar2(vv(1),Dtobr2der(1,i)))
9774 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9775 vv1(1)=pizda1(1,1)-pizda1(2,2)
9776 vv1(2)=pizda1(1,2)+pizda1(2,1)
9777 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9778 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9780 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9781 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9782 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9783 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9784 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9786 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9787 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9788 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9789 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9790 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9792 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9793 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9794 vv1(1)=pizda1(1,1)-pizda1(2,2)
9795 vv1(2)=pizda1(1,2)+pizda1(2,1)
9796 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9797 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9798 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9799 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9808 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9809 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9810 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9811 call transpose2(EUgC(1,1,k),auxmat(1,1))
9812 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9814 vv1(1)=pizda1(1,1)-pizda1(2,2)
9815 vv1(2)=pizda1(1,2)+pizda1(2,1)
9816 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9817 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9818 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9819 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9820 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9821 s5=scalar2(vv(1),Dtobr2(1,i))
9822 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9828 c----------------------------------------------------------------------------
9829 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9830 implicit real*8 (a-h,o-z)
9831 include 'DIMENSIONS'
9832 include 'COMMON.IOUNITS'
9833 include 'COMMON.CHAIN'
9834 include 'COMMON.DERIV'
9835 include 'COMMON.INTERACT'
9836 include 'COMMON.CONTACTS'
9837 include 'COMMON.TORSION'
9838 include 'COMMON.VAR'
9839 include 'COMMON.GEO'
9841 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9842 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9845 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9847 C Parallel Antiparallel C
9853 C \ j|/k\| \ |/k\|l C
9858 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9859 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9860 C AL 7/4/01 s1 would occur in the sixth-order moment,
9861 C but not in a cluster cumulant
9863 s1=dip(1,jj,i)*dip(1,kk,k)
9865 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9866 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9867 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9868 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9869 call transpose2(EUg(1,1,k),auxmat(1,1))
9870 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9871 vv(1)=pizda(1,1)-pizda(2,2)
9872 vv(2)=pizda(1,2)+pizda(2,1)
9873 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9874 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9876 eello6_graph2=-(s1+s2+s3+s4)
9878 eello6_graph2=-(s2+s3+s4)
9881 C Derivatives in gamma(i-1)
9884 s1=dipderg(1,jj,i)*dip(1,kk,k)
9886 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9887 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9888 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9889 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9891 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9893 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9895 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9897 C Derivatives in gamma(k-1)
9899 s1=dip(1,jj,i)*dipderg(1,kk,k)
9901 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9902 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9903 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9904 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9905 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9906 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9907 vv(1)=pizda(1,1)-pizda(2,2)
9908 vv(2)=pizda(1,2)+pizda(2,1)
9909 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9911 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9913 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9915 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9916 C Derivatives in gamma(j-1) or gamma(l-1)
9919 s1=dipderg(3,jj,i)*dip(1,kk,k)
9921 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9922 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9923 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9924 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9925 vv(1)=pizda(1,1)-pizda(2,2)
9926 vv(2)=pizda(1,2)+pizda(2,1)
9927 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9930 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9932 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9935 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9936 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9938 C Derivatives in gamma(l-1) or gamma(j-1)
9941 s1=dip(1,jj,i)*dipderg(3,kk,k)
9943 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9944 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9945 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9946 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9947 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9948 vv(1)=pizda(1,1)-pizda(2,2)
9949 vv(2)=pizda(1,2)+pizda(2,1)
9950 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9953 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9955 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9958 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9959 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9961 C Cartesian derivatives.
9963 write (2,*) 'In eello6_graph2'
9965 write (2,*) 'iii=',iii
9967 write (2,*) 'kkk=',kkk
9969 write (2,'(3(2f10.5),5x)')
9970 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9980 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9982 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9985 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9987 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9988 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9990 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9991 call transpose2(EUg(1,1,k),auxmat(1,1))
9992 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9994 vv(1)=pizda(1,1)-pizda(2,2)
9995 vv(2)=pizda(1,2)+pizda(2,1)
9996 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9997 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9999 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10001 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10004 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10006 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10013 c----------------------------------------------------------------------------
10014 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
10015 implicit real*8 (a-h,o-z)
10016 include 'DIMENSIONS'
10017 include 'COMMON.IOUNITS'
10018 include 'COMMON.CHAIN'
10019 include 'COMMON.DERIV'
10020 include 'COMMON.INTERACT'
10021 include 'COMMON.CONTACTS'
10022 include 'COMMON.TORSION'
10023 include 'COMMON.VAR'
10024 include 'COMMON.GEO'
10025 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
10027 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10029 C Parallel Antiparallel C
10034 C /| o |o o| o |\ C
10035 C j|/k\| / |/k\|l / C
10040 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10042 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10043 C energy moment and not to the cluster cumulant.
10044 iti=itortyp(itype(i))
10045 if (j.lt.nres-1) then
10046 itj1=itortyp(itype(j+1))
10050 itk=itortyp(itype(k))
10051 itk1=itortyp(itype(k+1))
10052 if (l.lt.nres-1) then
10053 itl1=itortyp(itype(l+1))
10058 s1=dip(4,jj,i)*dip(4,kk,k)
10060 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
10061 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10062 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
10063 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10064 call transpose2(EE(1,1,itk),auxmat(1,1))
10065 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10066 vv(1)=pizda(1,1)+pizda(2,2)
10067 vv(2)=pizda(2,1)-pizda(1,2)
10068 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10069 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10070 cd & "sum",-(s2+s3+s4)
10072 eello6_graph3=-(s1+s2+s3+s4)
10074 eello6_graph3=-(s2+s3+s4)
10076 c eello6_graph3=-s4
10077 C Derivatives in gamma(k-1)
10078 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
10079 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10080 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10081 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10082 C Derivatives in gamma(l-1)
10083 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
10084 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10085 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10086 vv(1)=pizda(1,1)+pizda(2,2)
10087 vv(2)=pizda(2,1)-pizda(1,2)
10088 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10089 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10090 C Cartesian derivatives.
10096 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10098 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10101 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
10103 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10104 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
10106 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10107 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
10109 vv(1)=pizda(1,1)+pizda(2,2)
10110 vv(2)=pizda(2,1)-pizda(1,2)
10111 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10113 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10115 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10118 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10120 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10122 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10128 c----------------------------------------------------------------------------
10129 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10130 implicit real*8 (a-h,o-z)
10131 include 'DIMENSIONS'
10132 include 'COMMON.IOUNITS'
10133 include 'COMMON.CHAIN'
10134 include 'COMMON.DERIV'
10135 include 'COMMON.INTERACT'
10136 include 'COMMON.CONTACTS'
10137 include 'COMMON.TORSION'
10138 include 'COMMON.VAR'
10139 include 'COMMON.GEO'
10140 include 'COMMON.FFIELD'
10141 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10142 & auxvec1(2),auxmat1(2,2)
10144 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10146 C Parallel Antiparallel C
10151 C /| o |o o| o |\ C
10152 C \ j|/k\| \ |/k\|l C
10157 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10159 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10160 C energy moment and not to the cluster cumulant.
10161 cd write (2,*) 'eello_graph4: wturn6',wturn6
10162 iti=itortyp(itype(i))
10163 itj=itortyp(itype(j))
10164 if (j.lt.nres-1) then
10165 itj1=itortyp(itype(j+1))
10169 itk=itortyp(itype(k))
10170 if (k.lt.nres-1) then
10171 itk1=itortyp(itype(k+1))
10175 itl=itortyp(itype(l))
10176 if (l.lt.nres-1) then
10177 itl1=itortyp(itype(l+1))
10181 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10182 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10183 cd & ' itl',itl,' itl1',itl1
10185 if (imat.eq.1) then
10186 s1=dip(3,jj,i)*dip(3,kk,k)
10188 s1=dip(2,jj,j)*dip(2,kk,l)
10191 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10192 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10194 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
10195 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10197 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
10198 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10200 call transpose2(EUg(1,1,k),auxmat(1,1))
10201 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10202 vv(1)=pizda(1,1)-pizda(2,2)
10203 vv(2)=pizda(2,1)+pizda(1,2)
10204 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10205 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10207 eello6_graph4=-(s1+s2+s3+s4)
10209 eello6_graph4=-(s2+s3+s4)
10211 C Derivatives in gamma(i-1)
10214 if (imat.eq.1) then
10215 s1=dipderg(2,jj,i)*dip(3,kk,k)
10217 s1=dipderg(4,jj,j)*dip(2,kk,l)
10220 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10222 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
10223 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10225 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
10226 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10228 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10229 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10230 cd write (2,*) 'turn6 derivatives'
10232 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10234 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10238 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10240 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10244 C Derivatives in gamma(k-1)
10246 if (imat.eq.1) then
10247 s1=dip(3,jj,i)*dipderg(2,kk,k)
10249 s1=dip(2,jj,j)*dipderg(4,kk,l)
10252 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10253 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10255 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
10256 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10258 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
10259 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10261 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10262 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10263 vv(1)=pizda(1,1)-pizda(2,2)
10264 vv(2)=pizda(2,1)+pizda(1,2)
10265 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10266 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10268 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10270 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10274 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10276 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10279 C Derivatives in gamma(j-1) or gamma(l-1)
10280 if (l.eq.j+1 .and. l.gt.1) then
10281 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10282 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10283 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10284 vv(1)=pizda(1,1)-pizda(2,2)
10285 vv(2)=pizda(2,1)+pizda(1,2)
10286 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10287 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10288 else if (j.gt.1) then
10289 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10290 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10291 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10292 vv(1)=pizda(1,1)-pizda(2,2)
10293 vv(2)=pizda(2,1)+pizda(1,2)
10294 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10295 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10296 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10298 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10301 C Cartesian derivatives.
10307 if (imat.eq.1) then
10308 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10310 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10313 if (imat.eq.1) then
10314 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10316 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10320 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
10322 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10324 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10325 & b1(1,j+1),auxvec(1))
10326 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
10328 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10329 & b1(1,l+1),auxvec(1))
10330 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
10332 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10334 vv(1)=pizda(1,1)-pizda(2,2)
10335 vv(2)=pizda(2,1)+pizda(1,2)
10336 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10338 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10340 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10343 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10346 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10349 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10351 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10353 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10357 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10359 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10362 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10364 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10372 c----------------------------------------------------------------------------
10373 double precision function eello_turn6(i,jj,kk)
10374 implicit real*8 (a-h,o-z)
10375 include 'DIMENSIONS'
10376 include 'COMMON.IOUNITS'
10377 include 'COMMON.CHAIN'
10378 include 'COMMON.DERIV'
10379 include 'COMMON.INTERACT'
10380 include 'COMMON.CONTACTS'
10381 include 'COMMON.TORSION'
10382 include 'COMMON.VAR'
10383 include 'COMMON.GEO'
10384 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
10385 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
10387 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
10388 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
10389 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10390 C the respective energy moment and not to the cluster cumulant.
10399 iti=itortyp(itype(i))
10400 itk=itortyp(itype(k))
10401 itk1=itortyp(itype(k+1))
10402 itl=itortyp(itype(l))
10403 itj=itortyp(itype(j))
10404 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10405 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
10406 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10411 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10413 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10417 derx_turn(lll,kkk,iii)=0.0d0
10424 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10426 cd write (2,*) 'eello6_5',eello6_5
10428 call transpose2(AEA(1,1,1),auxmat(1,1))
10429 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10430 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10431 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10433 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10434 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10435 s2 = scalar2(b1(1,k),vtemp1(1))
10437 call transpose2(AEA(1,1,2),atemp(1,1))
10438 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10439 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10440 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10442 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10443 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10444 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10446 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10447 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10448 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10449 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10450 ss13 = scalar2(b1(1,k),vtemp4(1))
10451 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10453 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10459 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10460 C Derivatives in gamma(i+2)
10464 call transpose2(AEA(1,1,1),auxmatd(1,1))
10465 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10466 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10467 call transpose2(AEAderg(1,1,2),atempd(1,1))
10468 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10469 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10471 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10472 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10473 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10479 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10480 C Derivatives in gamma(i+3)
10482 call transpose2(AEA(1,1,1),auxmatd(1,1))
10483 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10484 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10485 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10487 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10488 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10489 s2d = scalar2(b1(1,k),vtemp1d(1))
10491 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10492 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10494 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10496 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10497 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10498 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10506 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10507 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10509 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10510 & -0.5d0*ekont*(s2d+s12d)
10512 C Derivatives in gamma(i+4)
10513 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10514 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10515 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10517 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10518 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10519 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10527 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10529 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10531 C Derivatives in gamma(i+5)
10533 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10534 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10535 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10537 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10538 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10539 s2d = scalar2(b1(1,k),vtemp1d(1))
10541 call transpose2(AEA(1,1,2),atempd(1,1))
10542 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10543 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10545 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10546 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10548 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10549 ss13d = scalar2(b1(1,k),vtemp4d(1))
10550 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10558 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10559 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10561 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10562 & -0.5d0*ekont*(s2d+s12d)
10564 C Cartesian derivatives
10569 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10570 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10571 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10573 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10574 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10576 s2d = scalar2(b1(1,k),vtemp1d(1))
10578 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10579 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10580 s8d = -(atempd(1,1)+atempd(2,2))*
10581 & scalar2(cc(1,1,itl),vtemp2(1))
10583 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10585 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10586 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10593 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10594 & - 0.5d0*(s1d+s2d)
10596 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10600 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10601 & - 0.5d0*(s8d+s12d)
10603 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10612 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10613 & achuj_tempd(1,1))
10614 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10615 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10616 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10617 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10618 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10620 ss13d = scalar2(b1(1,k),vtemp4d(1))
10621 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10622 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10626 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10627 cd & 16*eel_turn6_num
10629 if (j.lt.nres-1) then
10636 if (l.lt.nres-1) then
10644 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10645 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10646 cgrad ghalf=0.5d0*ggg1(ll)
10648 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10649 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10650 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10651 & +ekont*derx_turn(ll,2,1)
10652 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10653 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10654 & +ekont*derx_turn(ll,4,1)
10655 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10656 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10657 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10658 cgrad ghalf=0.5d0*ggg2(ll)
10660 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10661 & +ekont*derx_turn(ll,2,2)
10662 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10663 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10664 & +ekont*derx_turn(ll,4,2)
10665 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10666 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10667 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10672 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10677 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10683 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10688 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10692 cd write (2,*) iii,g_corr6_loc(iii)
10694 eello_turn6=ekont*eel_turn6
10695 cd write (2,*) 'ekont',ekont
10696 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10700 C-----------------------------------------------------------------------------
10701 double precision function scalar(u,v)
10702 !DIR$ INLINEALWAYS scalar
10704 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10707 double precision u(3),v(3)
10708 cd double precision sc
10716 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10719 crc-------------------------------------------------
10720 SUBROUTINE MATVEC2(A1,V1,V2)
10721 !DIR$ INLINEALWAYS MATVEC2
10723 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10725 implicit real*8 (a-h,o-z)
10726 include 'DIMENSIONS'
10727 DIMENSION A1(2,2),V1(2),V2(2)
10731 c 3 VI=VI+A1(I,K)*V1(K)
10735 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10736 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10741 C---------------------------------------
10742 SUBROUTINE MATMAT2(A1,A2,A3)
10744 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10746 implicit real*8 (a-h,o-z)
10747 include 'DIMENSIONS'
10748 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10749 c DIMENSION AI3(2,2)
10753 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10759 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10760 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10761 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10762 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10770 c-------------------------------------------------------------------------
10771 double precision function scalar2(u,v)
10772 !DIR$ INLINEALWAYS scalar2
10774 double precision u(2),v(2)
10775 double precision sc
10777 scalar2=u(1)*v(1)+u(2)*v(2)
10781 C-----------------------------------------------------------------------------
10783 subroutine transpose2(a,at)
10784 !DIR$ INLINEALWAYS transpose2
10786 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10789 double precision a(2,2),at(2,2)
10796 c--------------------------------------------------------------------------
10797 subroutine transpose(n,a,at)
10800 double precision a(n,n),at(n,n)
10808 C---------------------------------------------------------------------------
10809 subroutine prodmat3(a1,a2,kk,transp,prod)
10810 !DIR$ INLINEALWAYS prodmat3
10812 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10816 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10818 crc double precision auxmat(2,2),prod_(2,2)
10821 crc call transpose2(kk(1,1),auxmat(1,1))
10822 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10823 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10825 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10826 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10827 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10828 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10829 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10830 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10831 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10832 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10835 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10836 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10838 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10839 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10840 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10841 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10842 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10843 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10844 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10845 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10848 c call transpose2(a2(1,1),a2t(1,1))
10851 crc print *,((prod_(i,j),i=1,2),j=1,2)
10852 crc print *,((prod(i,j),i=1,2),j=1,2)
10856 CCC----------------------------------------------
10857 subroutine Eliptransfer(eliptran)
10858 implicit real*8 (a-h,o-z)
10859 include 'DIMENSIONS'
10860 include 'COMMON.GEO'
10861 include 'COMMON.VAR'
10862 include 'COMMON.LOCAL'
10863 include 'COMMON.CHAIN'
10864 include 'COMMON.DERIV'
10865 include 'COMMON.NAMES'
10866 include 'COMMON.INTERACT'
10867 include 'COMMON.IOUNITS'
10868 include 'COMMON.CALC'
10869 include 'COMMON.CONTROL'
10870 include 'COMMON.SPLITELE'
10871 include 'COMMON.SBRIDGE'
10872 C this is done by Adasko
10873 C print *,"wchodze"
10874 C structure of box:
10876 C--bordliptop-- buffore starts
10877 C--bufliptop--- here true lipid starts
10879 C--buflipbot--- lipid ends buffore starts
10880 C--bordlipbot--buffore ends
10882 do i=ilip_start,ilip_end
10884 if (itype(i).eq.ntyp1) cycle
10886 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10887 if (positi.le.0) positi=positi+boxzsize
10889 C first for peptide groups
10890 c for each residue check if it is in lipid or lipid water border area
10891 if ((positi.gt.bordlipbot)
10892 &.and.(positi.lt.bordliptop)) then
10893 C the energy transfer exist
10894 if (positi.lt.buflipbot) then
10895 C what fraction I am in
10897 & ((positi-bordlipbot)/lipbufthick)
10898 C lipbufthick is thickenes of lipid buffore
10899 sslip=sscalelip(fracinbuf)
10900 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10901 eliptran=eliptran+sslip*pepliptran
10902 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10903 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10904 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10906 C print *,"doing sccale for lower part"
10907 C print *,i,sslip,fracinbuf,ssgradlip
10908 elseif (positi.gt.bufliptop) then
10909 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10910 sslip=sscalelip(fracinbuf)
10911 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10912 eliptran=eliptran+sslip*pepliptran
10913 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10914 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10915 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10916 C print *, "doing sscalefor top part"
10917 C print *,i,sslip,fracinbuf,ssgradlip
10919 eliptran=eliptran+pepliptran
10920 C print *,"I am in true lipid"
10923 C eliptran=elpitran+0.0 ! I am in water
10926 C print *, "nic nie bylo w lipidzie?"
10927 C now multiply all by the peptide group transfer factor
10928 C eliptran=eliptran*pepliptran
10929 C now the same for side chains
10931 do i=ilip_start,ilip_end
10932 if (itype(i).eq.ntyp1) cycle
10933 positi=(mod(c(3,i+nres),boxzsize))
10934 if (positi.le.0) positi=positi+boxzsize
10935 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10936 c for each residue check if it is in lipid or lipid water border area
10937 C respos=mod(c(3,i+nres),boxzsize)
10938 C print *,positi,bordlipbot,buflipbot
10939 if ((positi.gt.bordlipbot)
10940 & .and.(positi.lt.bordliptop)) then
10941 C the energy transfer exist
10942 if (positi.lt.buflipbot) then
10944 & ((positi-bordlipbot)/lipbufthick)
10945 C lipbufthick is thickenes of lipid buffore
10946 sslip=sscalelip(fracinbuf)
10947 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10948 eliptran=eliptran+sslip*liptranene(itype(i))
10949 gliptranx(3,i)=gliptranx(3,i)
10950 &+ssgradlip*liptranene(itype(i))
10951 gliptranc(3,i-1)= gliptranc(3,i-1)
10952 &+ssgradlip*liptranene(itype(i))
10953 C print *,"doing sccale for lower part"
10954 elseif (positi.gt.bufliptop) then
10956 &((bordliptop-positi)/lipbufthick)
10957 sslip=sscalelip(fracinbuf)
10958 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10959 eliptran=eliptran+sslip*liptranene(itype(i))
10960 gliptranx(3,i)=gliptranx(3,i)
10961 &+ssgradlip*liptranene(itype(i))
10962 gliptranc(3,i-1)= gliptranc(3,i-1)
10963 &+ssgradlip*liptranene(itype(i))
10964 C print *, "doing sscalefor top part",sslip,fracinbuf
10966 eliptran=eliptran+liptranene(itype(i))
10967 C print *,"I am in true lipid"
10969 endif ! if in lipid or buffor
10971 C eliptran=elpitran+0.0 ! I am in water
10975 C---------------------------------------------------------
10976 C AFM soubroutine for constant force
10977 subroutine AFMforce(Eafmforce)
10978 implicit real*8 (a-h,o-z)
10979 include 'DIMENSIONS'
10980 include 'COMMON.GEO'
10981 include 'COMMON.VAR'
10982 include 'COMMON.LOCAL'
10983 include 'COMMON.CHAIN'
10984 include 'COMMON.DERIV'
10985 include 'COMMON.NAMES'
10986 include 'COMMON.INTERACT'
10987 include 'COMMON.IOUNITS'
10988 include 'COMMON.CALC'
10989 include 'COMMON.CONTROL'
10990 include 'COMMON.SPLITELE'
10991 include 'COMMON.SBRIDGE'
10996 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10997 dist=dist+diffafm(i)**2
11000 Eafmforce=-forceAFMconst*(dist-distafminit)
11002 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
11003 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
11005 C print *,'AFM',Eafmforce
11008 C---------------------------------------------------------
11009 C AFM subroutine with pseudoconstant velocity
11010 subroutine AFMvel(Eafmforce)
11011 implicit real*8 (a-h,o-z)
11012 include 'DIMENSIONS'
11013 include 'COMMON.GEO'
11014 include 'COMMON.VAR'
11015 include 'COMMON.LOCAL'
11016 include 'COMMON.CHAIN'
11017 include 'COMMON.DERIV'
11018 include 'COMMON.NAMES'
11019 include 'COMMON.INTERACT'
11020 include 'COMMON.IOUNITS'
11021 include 'COMMON.CALC'
11022 include 'COMMON.CONTROL'
11023 include 'COMMON.SPLITELE'
11024 include 'COMMON.SBRIDGE'
11026 C Only for check grad COMMENT if not used for checkgrad
11028 C--------------------------------------------------------
11029 C print *,"wchodze"
11033 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11034 dist=dist+diffafm(i)**2
11037 Eafmforce=0.5d0*forceAFMconst
11038 & *(distafminit+totTafm*velAFMconst-dist)**2
11039 C Eafmforce=-forceAFMconst*(dist-distafminit)
11041 gradafm(i,afmend-1)=-forceAFMconst*
11042 &(distafminit+totTafm*velAFMconst-dist)
11044 gradafm(i,afmbeg-1)=forceAFMconst*
11045 &(distafminit+totTafm*velAFMconst-dist)
11048 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
11052 c----------------------------------------------------------------------------
11053 double precision function sscale2(r,r_cut,rlamb)
11054 double precision r,gamm
11055 if(r.lt.r_cut-rlamb) then
11057 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
11058 gamm=(r-(r_cut-rlamb))/rlamb
11059 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
11065 C-----------------------------------------------------------------------
11066 double precision function sscalgrad2(r,r_cut,rlamb)
11067 double precision r,gamm
11068 if(r.lt.r_cut-rlamb) then
11070 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
11071 gamm=(r-(r_cut-rlamb))/rlamb
11072 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
11078 c----------------------------------------------------------------------------
11079 subroutine e_saxs(Esaxs_constr)
11081 include 'DIMENSIONS'
11084 include "COMMON.SETUP"
11087 include 'COMMON.SBRIDGE'
11088 include 'COMMON.CHAIN'
11089 include 'COMMON.GEO'
11090 include 'COMMON.DERIV'
11091 include 'COMMON.LOCAL'
11092 include 'COMMON.INTERACT'
11093 include 'COMMON.VAR'
11094 include 'COMMON.IOUNITS'
11095 include 'COMMON.MD'
11096 include 'COMMON.CONTROL'
11097 include 'COMMON.NAMES'
11098 include 'COMMON.TIME1'
11099 include 'COMMON.FFIELD'
11101 double precision Esaxs_constr
11102 integer i,iint,j,k,l
11103 double precision PgradC(maxSAXS,3,maxres),
11104 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
11106 double precision PgradC_(maxSAXS,3,maxres),
11107 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
11109 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
11110 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
11111 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
11112 & auxX,auxX1,CACAgrad,Cnorm
11113 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
11114 double precision dist
11116 c SAXS restraint penalty function
11118 write(iout,*) "------- SAXS penalty function start -------"
11119 write (iout,*) "nsaxs",nsaxs
11120 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
11121 write (iout,*) "Psaxs"
11123 write (iout,'(i5,e15.5)') i, Psaxs(i)
11126 Esaxs_constr = 0.0d0
11131 PgradC(k,l,j)=0.0d0
11132 PgradX(k,l,j)=0.0d0
11136 do i=iatsc_s,iatsc_e
11137 if (itype(i).eq.ntyp1) cycle
11138 do iint=1,nint_gr(i)
11139 do j=istart(i,iint),iend(i,iint)
11140 if (itype(j).eq.ntyp1) cycle
11143 dijCASC=dist(i,j+nres)
11144 dijSCCA=dist(i+nres,j)
11145 dijSCSC=dist(i+nres,j+nres)
11146 sigma2CACA=2.0d0/(pstok**2)
11147 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
11148 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
11149 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
11152 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
11153 if (itype(j).ne.10) then
11154 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
11158 if (itype(i).ne.10) then
11159 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
11163 if (itype(i).ne.10 .and. itype(j).ne.10) then
11164 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
11168 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
11170 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
11172 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
11173 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
11174 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
11175 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
11178 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
11179 PgradC(k,l,i) = PgradC(k,l,i)-aux
11180 PgradC(k,l,j) = PgradC(k,l,j)+aux
11182 if (itype(j).ne.10) then
11183 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
11184 PgradC(k,l,i) = PgradC(k,l,i)-aux
11185 PgradC(k,l,j) = PgradC(k,l,j)+aux
11186 PgradX(k,l,j) = PgradX(k,l,j)+aux
11189 if (itype(i).ne.10) then
11190 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
11191 PgradX(k,l,i) = PgradX(k,l,i)-aux
11192 PgradC(k,l,i) = PgradC(k,l,i)-aux
11193 PgradC(k,l,j) = PgradC(k,l,j)+aux
11196 if (itype(i).ne.10 .and. itype(j).ne.10) then
11197 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
11198 PgradC(k,l,i) = PgradC(k,l,i)-aux
11199 PgradC(k,l,j) = PgradC(k,l,j)+aux
11200 PgradX(k,l,i) = PgradX(k,l,i)-aux
11201 PgradX(k,l,j) = PgradX(k,l,j)+aux
11207 sigma2CACA=scal_rad**2*0.25d0/
11208 & (restok(itype(j))**2+restok(itype(i))**2)
11209 rrr = 2.0d0/dsqrt(sigma2CACA)
11210 sss2 = sscale2(dijCACA,rrr,0.3d0)
11211 if (sss2.ne.0.0d0) then
11212 ssgrad2 = sscalgrad2(dijCACA,rrr,0.3d0)
11215 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
11216 Pcalc(k) = Pcalc(k)+expCACA
11218 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
11220 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA+
11221 & ssgrad2*expCACA/sss2
11224 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
11225 PgradC(k,l,i) = PgradC(k,l,i)-aux
11226 PgradC(k,l,j) = PgradC(k,l,j)+aux
11235 if (nfgtasks.gt.1) then
11236 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
11237 & MPI_SUM,king,FG_COMM,IERR)
11238 if (fg_rank.eq.king) then
11240 Pcalc(k) = Pcalc_(k)
11243 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
11244 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11245 if (fg_rank.eq.king) then
11249 PgradC(k,l,i) = PgradC_(k,l,i)
11255 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
11256 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11257 if (fg_rank.eq.king) then
11261 PgradX(k,l,i) = PgradX_(k,l,i)
11270 if (fg_rank.eq.king) then
11274 Cnorm = Cnorm + Pcalc(k)
11276 Esaxs_constr = dlog(Cnorm)
11278 Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
11280 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
11284 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
11293 auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
11294 auxC1 = auxC1+PgradC(k,l,i)
11296 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
11297 auxX1 = auxX1+PgradX(k,l,i)
11300 gsaxsC(l,i) = auxC - auxC1/Cnorm
11302 gsaxsX(l,i) = auxX - auxX1/Cnorm
11304 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
11305 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
11313 c----------------------------------------------------------------------------
11314 subroutine e_saxsC(Esaxs_constr)
11316 include 'DIMENSIONS'
11319 include "COMMON.SETUP"
11322 include 'COMMON.SBRIDGE'
11323 include 'COMMON.CHAIN'
11324 include 'COMMON.GEO'
11325 include 'COMMON.DERIV'
11326 include 'COMMON.LOCAL'
11327 include 'COMMON.INTERACT'
11328 include 'COMMON.VAR'
11329 include 'COMMON.IOUNITS'
11330 include 'COMMON.MD'
11331 include 'COMMON.CONTROL'
11332 include 'COMMON.NAMES'
11333 include 'COMMON.TIME1'
11334 include 'COMMON.FFIELD'
11336 double precision Esaxs_constr
11337 integer i,iint,j,k,l
11338 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
11340 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
11342 double precision dk,dijCASPH,dijSCSPH,
11343 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
11344 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
11346 c SAXS restraint penalty function
11348 write(iout,*) "------- SAXS penalty function start -------"
11349 write (iout,*) "nsaxs",nsaxs
11352 print *,MyRank,"C",i,(C(j,i),j=1,3)
11355 print *,MyRank,"CSaxs",i,(Csaxs(j,i),j=1,3)
11358 Esaxs_constr = 0.0d0
11360 do j=isaxs_start,isaxs_end
11369 if (itype(i).eq.ntyp1) cycle
11373 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
11375 if (itype(i).ne.10) then
11377 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
11380 sigma2CA=2.0d0/pstok**2
11381 sigma2SC=4.0d0/restok(itype(i))**2
11382 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
11383 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
11384 Pcalc = Pcalc+expCASPH+expSCSPH
11386 write(*,*) "processor i j Pcalc",
11387 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
11389 CASPHgrad = sigma2CA*expCASPH
11390 SCSPHgrad = sigma2SC*expSCSPH
11392 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
11393 PgradX(l,i) = PgradX(l,i) + aux
11394 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
11399 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
11400 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
11403 logPtot = logPtot - dlog(Pcalc)
11404 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
11405 c & " logPtot",logPtot
11408 if (nfgtasks.gt.1) then
11409 c write (iout,*) "logPtot before reduction",logPtot
11410 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
11411 & MPI_SUM,king,FG_COMM,IERR)
11413 c write (iout,*) "logPtot after reduction",logPtot
11414 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
11415 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11416 if (fg_rank.eq.king) then
11419 gsaxsC(l,i) = gsaxsC_(l,i)
11423 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
11424 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11425 if (fg_rank.eq.king) then
11428 gsaxsX(l,i) = gsaxsX_(l,i)
11434 Esaxs_constr = logPtot