1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
27 include 'COMMON.SPLITELE'
29 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
30 c & " nfgtasks",nfgtasks
31 if (nfgtasks.gt.1) then
33 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
34 if (fg_rank.eq.0) then
35 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
36 c print *,"Processor",myrank," BROADCAST iorder"
37 C FG master sets up the WEIGHTS_ array which will be broadcast to the
38 C FG slaves as WEIGHTS array.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
85 time_Bcast=time_Bcast+MPI_Wtime()-time00
86 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
87 c call chainbuild_cart
89 c print *,'Processor',myrank,' calling etotal ipot=',ipot
90 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
92 c if (modecalc.eq.12.or.modecalc.eq.14) then
93 c call int_from_cart1(.false.)
100 C Compute the side-chain and electrostatic interaction energy
103 goto (101,102,103,104,105,106) ipot
104 C Lennard-Jones potential.
106 cd print '(a)','Exit ELJ'
108 C Lennard-Jones-Kihara potential (shifted).
111 C Berne-Pechukas potential (dilated LJ, angular dependence).
114 C Gay-Berne potential (shifted LJ, angular dependence).
116 C print *,"bylem w egb"
118 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
121 C Soft-sphere potential
122 106 call e_softsphere(evdw)
124 C Calculate electrostatic (H-bonding) energy of the main chain.
128 cmc Sep-06: egb takes care of dynamic ss bonds too
130 c if (dyn_ss) call dyn_set_nss
132 c print *,"Processor",myrank," computed USCSC"
138 time_vec=time_vec+MPI_Wtime()-time01
140 c print *,"Processor",myrank," left VEC_AND_DERIV"
143 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
144 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
145 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
146 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
148 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
149 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
150 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
151 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
153 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
162 write (iout,*) "Soft-spheer ELEC potential"
163 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
166 c print *,"Processor",myrank," computed UELEC"
168 C Calculate excluded-volume interaction energy between peptide groups
173 call escp(evdw2,evdw2_14)
179 c write (iout,*) "Soft-sphere SCP potential"
180 call escp_soft_sphere(evdw2,evdw2_14)
183 c Calculate the bond-stretching energy
187 C Calculate the disulfide-bridge and other energy and the contributions
188 C from other distance constraints.
189 cd print *,'Calling EHPB'
191 cd print *,'EHPB exitted succesfully.'
193 C Calculate the virtual-bond-angle energy.
195 if (wang.gt.0d0) then
200 c print *,"Processor",myrank," computed UB"
202 C Calculate the SC local energy.
204 C print *,"TU DOCHODZE?"
206 c print *,"Processor",myrank," computed USC"
208 C Calculate the virtual-bond torsional energy.
210 cd print *,'nterm=',nterm
212 call etor(etors,edihcnstr)
218 if (constr_homology.ge.1) then
219 call e_modeller(ehomology_constr)
220 c print *,'iset=',iset,'me=',me,ehomology_constr,
221 c & 'Processor',fg_rank,' CG group',kolor,
222 c & ' absolute rank',MyRank
224 ehomology_constr=0.0d0
228 c write(iout,*) ehomology_constr
229 c print *,"Processor",myrank," computed Utor"
231 C 6/23/01 Calculate double-torsional energy
233 if (wtor_d.gt.0) then
238 c print *,"Processor",myrank," computed Utord"
240 C 21/5/07 Calculate local sicdechain correlation energy
242 if (wsccor.gt.0.0d0) then
243 call eback_sc_corr(esccor)
247 C print *,"PRZED MULIt"
248 c print *,"Processor",myrank," computed Usccorr"
250 C 12/1/95 Multi-body terms
254 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
255 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
256 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
257 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
258 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
265 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
266 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
267 cd write (iout,*) "multibody_hb ecorr",ecorr
269 c print *,"Processor",myrank," computed Ucorr"
271 C If performing constraint dynamics, call the constraint energy
272 C after the equilibration time
273 if(usampl.and.totT.gt.eq_time) then
280 C 01/27/2015 added by adasko
281 C the energy component below is energy transfer into lipid environment
282 C based on partition function
283 C print *,"przed lipidami"
284 if (wliptran.gt.0) then
285 call Eliptransfer(eliptran)
287 C print *,"za lipidami"
288 if (AFMlog.gt.0) then
289 call AFMforce(Eafmforce)
290 else if (selfguide.gt.0) then
291 call AFMvel(Eafmforce)
294 time_enecalc=time_enecalc+MPI_Wtime()-time00
296 c print *,"Processor",myrank," computed Uconstr"
305 energia(2)=evdw2-evdw2_14
322 energia(8)=eello_turn3
323 energia(9)=eello_turn4
330 energia(19)=edihcnstr
332 energia(20)=Uconst+Uconst_back
335 energia(23)=Eafmforce
336 energia(24)=ehomology_constr
337 c Here are the energies showed per procesor if the are more processors
338 c per molecule then we sum it up in sum_energy subroutine
339 c print *," Processor",myrank," calls SUM_ENERGY"
340 call sum_energy(energia,.true.)
341 if (dyn_ss) call dyn_set_nss
342 c print *," Processor",myrank," left SUM_ENERGY"
344 time_sumene=time_sumene+MPI_Wtime()-time00
348 c-------------------------------------------------------------------------------
349 subroutine sum_energy(energia,reduce)
350 implicit real*8 (a-h,o-z)
355 cMS$ATTRIBUTES C :: proc_proc
361 include 'COMMON.SETUP'
362 include 'COMMON.IOUNITS'
363 double precision energia(0:n_ene),enebuff(0:n_ene+1)
364 include 'COMMON.FFIELD'
365 include 'COMMON.DERIV'
366 include 'COMMON.INTERACT'
367 include 'COMMON.SBRIDGE'
368 include 'COMMON.CHAIN'
370 include 'COMMON.CONTROL'
371 include 'COMMON.TIME1'
374 if (nfgtasks.gt.1 .and. reduce) then
376 write (iout,*) "energies before REDUCE"
377 call enerprint(energia)
381 enebuff(i)=energia(i)
384 call MPI_Barrier(FG_COMM,IERR)
385 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
387 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
388 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
390 write (iout,*) "energies after REDUCE"
391 call enerprint(energia)
394 time_Reduce=time_Reduce+MPI_Wtime()-time00
396 if (fg_rank.eq.0) then
400 evdw2=energia(2)+energia(18)
416 eello_turn3=energia(8)
417 eello_turn4=energia(9)
424 edihcnstr=energia(19)
429 Eafmforce=energia(23)
430 ehomology_constr=energia(24)
432 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
433 & +wang*ebe+wtor*etors+wscloc*escloc
434 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
435 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
436 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
437 & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
438 & +wliptran*eliptran+Eafmforce
440 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
441 & +wang*ebe+wtor*etors+wscloc*escloc
442 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
443 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
444 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
445 & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
453 if (isnan(etot).ne.0) energia(0)=1.0d+99
455 if (isnan(etot)) energia(0)=1.0d+99
460 idumm=proc_proc(etot,i)
462 call proc_proc(etot,i)
464 if(i.eq.1)energia(0)=1.0d+99
471 c-------------------------------------------------------------------------------
472 subroutine sum_gradient
473 implicit real*8 (a-h,o-z)
478 cMS$ATTRIBUTES C :: proc_proc
484 double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
485 & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
486 & ,gloc_scbuf(3,-1:maxres)
487 include 'COMMON.SETUP'
488 include 'COMMON.IOUNITS'
489 include 'COMMON.FFIELD'
490 include 'COMMON.DERIV'
491 include 'COMMON.INTERACT'
492 include 'COMMON.SBRIDGE'
493 include 'COMMON.CHAIN'
495 include 'COMMON.CONTROL'
496 include 'COMMON.TIME1'
497 include 'COMMON.MAXGRAD'
498 include 'COMMON.SCCOR'
504 write (iout,*) "sum_gradient gvdwc, gvdwx"
506 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
507 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
512 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
513 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
514 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
517 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
518 C in virtual-bond-vector coordinates
521 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
523 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
524 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
526 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
528 c write (iout,'(i5,3f10.5,2x,f10.5)')
529 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
531 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
533 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
534 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
542 gradbufc(j,i)=wsc*gvdwc(j,i)+
543 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
544 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
545 & wel_loc*gel_loc_long(j,i)+
546 & wcorr*gradcorr_long(j,i)+
547 & wcorr5*gradcorr5_long(j,i)+
548 & wcorr6*gradcorr6_long(j,i)+
549 & wturn6*gcorr6_turn_long(j,i)+
551 & +wliptran*gliptranc(j,i)
559 gradbufc(j,i)=wsc*gvdwc(j,i)+
560 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
561 & welec*gelc_long(j,i)+
563 & wel_loc*gel_loc_long(j,i)+
564 & wcorr*gradcorr_long(j,i)+
565 & wcorr5*gradcorr5_long(j,i)+
566 & wcorr6*gradcorr6_long(j,i)+
567 & wturn6*gcorr6_turn_long(j,i)+
569 & +wliptran*gliptranc(j,i)
576 if (nfgtasks.gt.1) then
579 write (iout,*) "gradbufc before allreduce"
581 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
587 gradbufc_sum(j,i)=gradbufc(j,i)
590 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
591 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
592 c time_reduce=time_reduce+MPI_Wtime()-time00
594 c write (iout,*) "gradbufc_sum after allreduce"
596 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
601 c time_allreduce=time_allreduce+MPI_Wtime()-time00
609 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
610 write (iout,*) (i," jgrad_start",jgrad_start(i),
611 & " jgrad_end ",jgrad_end(i),
612 & i=igrad_start,igrad_end)
615 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
616 c do not parallelize this part.
618 c do i=igrad_start,igrad_end
619 c do j=jgrad_start(i),jgrad_end(i)
621 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
626 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
630 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
634 write (iout,*) "gradbufc after summing"
636 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
643 write (iout,*) "gradbufc"
645 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
651 gradbufc_sum(j,i)=gradbufc(j,i)
656 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
660 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
665 c gradbufc(k,i)=0.0d0
669 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
674 write (iout,*) "gradbufc after summing"
676 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
684 gradbufc(k,nres)=0.0d0
689 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
690 & wel_loc*gel_loc(j,i)+
691 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
692 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
693 & wel_loc*gel_loc_long(j,i)+
694 & wcorr*gradcorr_long(j,i)+
695 & wcorr5*gradcorr5_long(j,i)+
696 & wcorr6*gradcorr6_long(j,i)+
697 & wturn6*gcorr6_turn_long(j,i))+
699 & wcorr*gradcorr(j,i)+
700 & wturn3*gcorr3_turn(j,i)+
701 & wturn4*gcorr4_turn(j,i)+
702 & wcorr5*gradcorr5(j,i)+
703 & wcorr6*gradcorr6(j,i)+
704 & wturn6*gcorr6_turn(j,i)+
705 & wsccor*gsccorc(j,i)
706 & +wscloc*gscloc(j,i)
707 & +wliptran*gliptranc(j,i)
710 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
711 & wel_loc*gel_loc(j,i)+
712 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
713 & welec*gelc_long(j,i) +
714 & wel_loc*gel_loc_long(j,i)+
715 & wcorr*gcorr_long(j,i)+
716 & wcorr5*gradcorr5_long(j,i)+
717 & wcorr6*gradcorr6_long(j,i)+
718 & wturn6*gcorr6_turn_long(j,i))+
720 & wcorr*gradcorr(j,i)+
721 & wturn3*gcorr3_turn(j,i)+
722 & wturn4*gcorr4_turn(j,i)+
723 & wcorr5*gradcorr5(j,i)+
724 & wcorr6*gradcorr6(j,i)+
725 & wturn6*gcorr6_turn(j,i)+
726 & wsccor*gsccorc(j,i)
727 & +wscloc*gscloc(j,i)
728 & +wliptran*gliptranc(j,i)
732 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
734 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
735 & wsccor*gsccorx(j,i)
736 & +wscloc*gsclocx(j,i)
737 & +wliptran*gliptranx(j,i)
740 if (constr_homology.gt.0) then
743 gradc(j,i,icg)=gradc(j,i,icg)+duscdiff(j,i)
744 gradx(j,i,icg)=gradx(j,i,icg)+duscdiffx(j,i)
749 write (iout,*) "gloc before adding corr"
751 write (iout,*) i,gloc(i,icg)
755 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
756 & +wcorr5*g_corr5_loc(i)
757 & +wcorr6*g_corr6_loc(i)
758 & +wturn4*gel_loc_turn4(i)
759 & +wturn3*gel_loc_turn3(i)
760 & +wturn6*gel_loc_turn6(i)
761 & +wel_loc*gel_loc_loc(i)
764 write (iout,*) "gloc after adding corr"
766 write (iout,*) i,gloc(i,icg)
770 if (nfgtasks.gt.1) then
773 gradbufc(j,i)=gradc(j,i,icg)
774 gradbufx(j,i)=gradx(j,i,icg)
778 glocbuf(i)=gloc(i,icg)
782 write (iout,*) "gloc_sc before reduce"
785 write (iout,*) i,j,gloc_sc(j,i,icg)
792 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
796 call MPI_Barrier(FG_COMM,IERR)
797 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
799 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
800 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
801 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
802 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
803 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
804 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
805 time_reduce=time_reduce+MPI_Wtime()-time00
806 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
807 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
808 time_reduce=time_reduce+MPI_Wtime()-time00
811 write (iout,*) "gloc_sc after reduce"
814 write (iout,*) i,j,gloc_sc(j,i,icg)
820 write (iout,*) "gloc after reduce"
822 write (iout,*) i,gloc(i,icg)
827 if (gnorm_check) then
829 c Compute the maximum elements of the gradient
839 gcorr3_turn_max=0.0d0
840 gcorr4_turn_max=0.0d0
843 gcorr6_turn_max=0.0d0
853 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
854 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
855 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
856 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
857 & gvdwc_scp_max=gvdwc_scp_norm
858 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
859 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
860 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
861 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
862 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
863 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
864 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
865 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
866 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
867 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
868 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
869 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
870 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
872 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
873 & gcorr3_turn_max=gcorr3_turn_norm
874 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
876 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
877 & gcorr4_turn_max=gcorr4_turn_norm
878 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
879 if (gradcorr5_norm.gt.gradcorr5_max)
880 & gradcorr5_max=gradcorr5_norm
881 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
882 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
883 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
885 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
886 & gcorr6_turn_max=gcorr6_turn_norm
887 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
888 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
889 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
890 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
891 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
892 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
893 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
894 if (gradx_scp_norm.gt.gradx_scp_max)
895 & gradx_scp_max=gradx_scp_norm
896 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
897 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
898 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
899 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
900 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
901 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
902 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
903 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
907 open(istat,file=statname,position="append")
909 open(istat,file=statname,access="append")
911 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
912 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
913 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
914 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
915 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
916 & gsccorx_max,gsclocx_max
918 if (gvdwc_max.gt.1.0d4) then
919 write (iout,*) "gvdwc gvdwx gradb gradbx"
921 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
922 & gradb(j,i),gradbx(j,i),j=1,3)
924 call pdbout(0.0d0,'cipiszcze',iout)
930 write (iout,*) "gradc gradx gloc"
932 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
933 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
937 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
941 c-------------------------------------------------------------------------------
942 subroutine rescale_weights(t_bath)
943 implicit real*8 (a-h,o-z)
945 include 'COMMON.IOUNITS'
946 include 'COMMON.FFIELD'
947 include 'COMMON.SBRIDGE'
948 double precision kfac /2.4d0/
949 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
951 c facT=2*temp0/(t_bath+temp0)
952 if (rescale_mode.eq.0) then
958 else if (rescale_mode.eq.1) then
959 facT=kfac/(kfac-1.0d0+t_bath/temp0)
960 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
961 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
962 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
963 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
964 else if (rescale_mode.eq.2) then
970 facT=licznik/dlog(dexp(x)+dexp(-x))
971 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
972 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
973 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
974 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
976 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
977 write (*,*) "Wrong RESCALE_MODE",rescale_mode
979 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
983 welec=weights(3)*fact
984 wcorr=weights(4)*fact3
985 wcorr5=weights(5)*fact4
986 wcorr6=weights(6)*fact5
987 wel_loc=weights(7)*fact2
988 wturn3=weights(8)*fact2
989 wturn4=weights(9)*fact3
990 wturn6=weights(10)*fact5
991 wtor=weights(13)*fact
992 wtor_d=weights(14)*fact2
993 wsccor=weights(21)*fact
997 C------------------------------------------------------------------------
998 subroutine enerprint(energia)
999 implicit real*8 (a-h,o-z)
1000 include 'DIMENSIONS'
1001 include 'COMMON.IOUNITS'
1002 include 'COMMON.FFIELD'
1003 include 'COMMON.SBRIDGE'
1005 double precision energia(0:n_ene)
1010 evdw2=energia(2)+energia(18)
1022 eello_turn3=energia(8)
1023 eello_turn4=energia(9)
1024 eello_turn6=energia(10)
1030 edihcnstr=energia(19)
1034 ehomology_constr=energia(24)
1035 eliptran=energia(22)
1036 Eafmforce=energia(23)
1038 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1039 & estr,wbond,ebe,wang,
1040 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1042 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1043 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1044 & edihcnstr,ehomology_constr, ebr*nss,
1045 & Uconst,eliptran,wliptran,Eafmforce,etot
1046 10 format (/'Virtual-chain energies:'//
1047 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1048 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1049 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1050 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1051 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1052 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1053 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1054 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1055 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1056 & 'EHPB= ',1pE16.6,' WEIGHT=',1pD16.6,
1057 & ' (SS bridges & dist. cnstr.)'/
1058 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1059 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1060 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1061 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1062 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1063 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1064 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1065 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1066 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1067 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1068 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1069 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1070 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1071 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1072 & 'ETOT= ',1pE16.6,' (total)')
1075 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1076 & estr,wbond,ebe,wang,
1077 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1079 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1080 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1081 & ehomology_constr,ebr*nss,Uconst,
1082 & eliptran,wliptran,Eafmforc,
1084 10 format (/'Virtual-chain energies:'//
1085 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1086 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1087 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1088 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1089 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1090 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1091 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1092 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1093 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1094 & ' (SS bridges & dist. cnstr.)'/
1095 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1096 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1097 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1098 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1099 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1100 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1101 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1102 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1103 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1104 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1105 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1106 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1107 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1108 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1109 & 'ETOT= ',1pE16.6,' (total)')
1113 C-----------------------------------------------------------------------
1114 subroutine elj(evdw)
1116 C This subroutine calculates the interaction energy of nonbonded side chains
1117 C assuming the LJ potential of interaction.
1119 implicit real*8 (a-h,o-z)
1120 include 'DIMENSIONS'
1121 parameter (accur=1.0d-10)
1122 include 'COMMON.GEO'
1123 include 'COMMON.VAR'
1124 include 'COMMON.LOCAL'
1125 include 'COMMON.CHAIN'
1126 include 'COMMON.DERIV'
1127 include 'COMMON.INTERACT'
1128 include 'COMMON.TORSION'
1129 include 'COMMON.SBRIDGE'
1130 include 'COMMON.NAMES'
1131 include 'COMMON.IOUNITS'
1132 include 'COMMON.CONTACTS'
1134 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1136 do i=iatsc_s,iatsc_e
1137 itypi=iabs(itype(i))
1138 if (itypi.eq.ntyp1) cycle
1139 itypi1=iabs(itype(i+1))
1146 C Calculate SC interaction energy.
1148 do iint=1,nint_gr(i)
1149 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1150 cd & 'iend=',iend(i,iint)
1151 do j=istart(i,iint),iend(i,iint)
1152 itypj=iabs(itype(j))
1153 if (itypj.eq.ntyp1) cycle
1157 C Change 12/1/95 to calculate four-body interactions
1158 rij=xj*xj+yj*yj+zj*zj
1160 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1161 eps0ij=eps(itypi,itypj)
1163 C have you changed here?
1167 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1168 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1169 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1170 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1171 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1172 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1175 C Calculate the components of the gradient in DC and X
1177 fac=-rrij*(e1+evdwij)
1182 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1183 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1184 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1185 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1189 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1193 C 12/1/95, revised on 5/20/97
1195 C Calculate the contact function. The ith column of the array JCONT will
1196 C contain the numbers of atoms that make contacts with the atom I (of numbers
1197 C greater than I). The arrays FACONT and GACONT will contain the values of
1198 C the contact function and its derivative.
1200 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1201 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1202 C Uncomment next line, if the correlation interactions are contact function only
1203 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1205 sigij=sigma(itypi,itypj)
1206 r0ij=rs0(itypi,itypj)
1208 C Check whether the SC's are not too far to make a contact.
1211 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1212 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1214 if (fcont.gt.0.0D0) then
1215 C If the SC-SC distance if close to sigma, apply spline.
1216 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1217 cAdam & fcont1,fprimcont1)
1218 cAdam fcont1=1.0d0-fcont1
1219 cAdam if (fcont1.gt.0.0d0) then
1220 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1221 cAdam fcont=fcont*fcont1
1223 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1224 cga eps0ij=1.0d0/dsqrt(eps0ij)
1226 cga gg(k)=gg(k)*eps0ij
1228 cga eps0ij=-evdwij*eps0ij
1229 C Uncomment for AL's type of SC correlation interactions.
1230 cadam eps0ij=-evdwij
1231 num_conti=num_conti+1
1232 jcont(num_conti,i)=j
1233 facont(num_conti,i)=fcont*eps0ij
1234 fprimcont=eps0ij*fprimcont/rij
1236 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1237 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1238 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1239 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1240 gacont(1,num_conti,i)=-fprimcont*xj
1241 gacont(2,num_conti,i)=-fprimcont*yj
1242 gacont(3,num_conti,i)=-fprimcont*zj
1243 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1244 cd write (iout,'(2i3,3f10.5)')
1245 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1251 num_cont(i)=num_conti
1255 gvdwc(j,i)=expon*gvdwc(j,i)
1256 gvdwx(j,i)=expon*gvdwx(j,i)
1259 C******************************************************************************
1263 C To save time, the factor of EXPON has been extracted from ALL components
1264 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1267 C******************************************************************************
1270 C-----------------------------------------------------------------------------
1271 subroutine eljk(evdw)
1273 C This subroutine calculates the interaction energy of nonbonded side chains
1274 C assuming the LJK potential of interaction.
1276 implicit real*8 (a-h,o-z)
1277 include 'DIMENSIONS'
1278 include 'COMMON.GEO'
1279 include 'COMMON.VAR'
1280 include 'COMMON.LOCAL'
1281 include 'COMMON.CHAIN'
1282 include 'COMMON.DERIV'
1283 include 'COMMON.INTERACT'
1284 include 'COMMON.IOUNITS'
1285 include 'COMMON.NAMES'
1288 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1290 do i=iatsc_s,iatsc_e
1291 itypi=iabs(itype(i))
1292 if (itypi.eq.ntyp1) cycle
1293 itypi1=iabs(itype(i+1))
1298 C Calculate SC interaction energy.
1300 do iint=1,nint_gr(i)
1301 do j=istart(i,iint),iend(i,iint)
1302 itypj=iabs(itype(j))
1303 if (itypj.eq.ntyp1) cycle
1307 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1308 fac_augm=rrij**expon
1309 e_augm=augm(itypi,itypj)*fac_augm
1310 r_inv_ij=dsqrt(rrij)
1312 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1313 fac=r_shift_inv**expon
1314 C have you changed here?
1318 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1319 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1320 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1321 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1322 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1323 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1324 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1327 C Calculate the components of the gradient in DC and X
1329 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1334 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1335 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1336 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1337 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1341 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1349 gvdwc(j,i)=expon*gvdwc(j,i)
1350 gvdwx(j,i)=expon*gvdwx(j,i)
1355 C-----------------------------------------------------------------------------
1356 subroutine ebp(evdw)
1358 C This subroutine calculates the interaction energy of nonbonded side chains
1359 C assuming the Berne-Pechukas potential of interaction.
1361 implicit real*8 (a-h,o-z)
1362 include 'DIMENSIONS'
1363 include 'COMMON.GEO'
1364 include 'COMMON.VAR'
1365 include 'COMMON.LOCAL'
1366 include 'COMMON.CHAIN'
1367 include 'COMMON.DERIV'
1368 include 'COMMON.NAMES'
1369 include 'COMMON.INTERACT'
1370 include 'COMMON.IOUNITS'
1371 include 'COMMON.CALC'
1372 common /srutu/ icall
1373 c double precision rrsave(maxdim)
1376 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1378 c if (icall.eq.0) then
1384 do i=iatsc_s,iatsc_e
1385 itypi=iabs(itype(i))
1386 if (itypi.eq.ntyp1) cycle
1387 itypi1=iabs(itype(i+1))
1391 dxi=dc_norm(1,nres+i)
1392 dyi=dc_norm(2,nres+i)
1393 dzi=dc_norm(3,nres+i)
1394 c dsci_inv=dsc_inv(itypi)
1395 dsci_inv=vbld_inv(i+nres)
1397 C Calculate SC interaction energy.
1399 do iint=1,nint_gr(i)
1400 do j=istart(i,iint),iend(i,iint)
1402 itypj=iabs(itype(j))
1403 if (itypj.eq.ntyp1) cycle
1404 c dscj_inv=dsc_inv(itypj)
1405 dscj_inv=vbld_inv(j+nres)
1406 chi1=chi(itypi,itypj)
1407 chi2=chi(itypj,itypi)
1414 alf12=0.5D0*(alf1+alf2)
1415 C For diagnostics only!!!
1428 dxj=dc_norm(1,nres+j)
1429 dyj=dc_norm(2,nres+j)
1430 dzj=dc_norm(3,nres+j)
1431 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1432 cd if (icall.eq.0) then
1438 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1440 C Calculate whole angle-dependent part of epsilon and contributions
1441 C to its derivatives
1442 C have you changed here?
1443 fac=(rrij*sigsq)**expon2
1446 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1447 eps2der=evdwij*eps3rt
1448 eps3der=evdwij*eps2rt
1449 evdwij=evdwij*eps2rt*eps3rt
1452 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1454 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1455 cd & restyp(itypi),i,restyp(itypj),j,
1456 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1457 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1458 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1461 C Calculate gradient components.
1462 e1=e1*eps1*eps2rt**2*eps3rt**2
1463 fac=-expon*(e1+evdwij)
1466 C Calculate radial part of the gradient
1470 C Calculate the angular part of the gradient and sum add the contributions
1471 C to the appropriate components of the Cartesian gradient.
1479 C-----------------------------------------------------------------------------
1480 subroutine egb(evdw)
1482 C This subroutine calculates the interaction energy of nonbonded side chains
1483 C assuming the Gay-Berne potential of interaction.
1485 implicit real*8 (a-h,o-z)
1486 include 'DIMENSIONS'
1487 include 'COMMON.GEO'
1488 include 'COMMON.VAR'
1489 include 'COMMON.LOCAL'
1490 include 'COMMON.CHAIN'
1491 include 'COMMON.DERIV'
1492 include 'COMMON.NAMES'
1493 include 'COMMON.INTERACT'
1494 include 'COMMON.IOUNITS'
1495 include 'COMMON.CALC'
1496 include 'COMMON.CONTROL'
1497 include 'COMMON.SPLITELE'
1498 include 'COMMON.SBRIDGE'
1500 integer xshift,yshift,zshift
1502 ccccc energy_dec=.false.
1503 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1506 c if (icall.eq.0) lprn=.false.
1508 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1509 C we have the original box)
1513 do i=iatsc_s,iatsc_e
1514 itypi=iabs(itype(i))
1515 if (itypi.eq.ntyp1) cycle
1516 itypi1=iabs(itype(i+1))
1520 C Return atom into box, boxxsize is size of box in x dimension
1522 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1523 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1524 C Condition for being inside the proper box
1525 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1526 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1530 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1531 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1532 C Condition for being inside the proper box
1533 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1534 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1538 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1539 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1540 C Condition for being inside the proper box
1541 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1542 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1546 if (xi.lt.0) xi=xi+boxxsize
1548 if (yi.lt.0) yi=yi+boxysize
1550 if (zi.lt.0) zi=zi+boxzsize
1551 C define scaling factor for lipids
1553 C if (positi.le.0) positi=positi+boxzsize
1555 C first for peptide groups
1556 c for each residue check if it is in lipid or lipid water border area
1557 if ((zi.gt.bordlipbot)
1558 &.and.(zi.lt.bordliptop)) then
1559 C the energy transfer exist
1560 if (zi.lt.buflipbot) then
1561 C what fraction I am in
1563 & ((zi-bordlipbot)/lipbufthick)
1564 C lipbufthick is thickenes of lipid buffore
1565 sslipi=sscalelip(fracinbuf)
1566 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1567 elseif (zi.gt.bufliptop) then
1568 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1569 sslipi=sscalelip(fracinbuf)
1570 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1580 C xi=xi+xshift*boxxsize
1581 C yi=yi+yshift*boxysize
1582 C zi=zi+zshift*boxzsize
1584 dxi=dc_norm(1,nres+i)
1585 dyi=dc_norm(2,nres+i)
1586 dzi=dc_norm(3,nres+i)
1587 c dsci_inv=dsc_inv(itypi)
1588 dsci_inv=vbld_inv(i+nres)
1589 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1590 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1592 C Calculate SC interaction energy.
1594 do iint=1,nint_gr(i)
1595 do j=istart(i,iint),iend(i,iint)
1596 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1597 call dyn_ssbond_ene(i,j,evdwij)
1599 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1600 & 'evdw',i,j,evdwij,' ss'
1603 itypj=iabs(itype(j))
1604 if (itypj.eq.ntyp1) cycle
1605 c dscj_inv=dsc_inv(itypj)
1606 dscj_inv=vbld_inv(j+nres)
1607 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1608 c & 1.0d0/vbld(j+nres)
1609 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1610 sig0ij=sigma(itypi,itypj)
1611 chi1=chi(itypi,itypj)
1612 chi2=chi(itypj,itypi)
1619 alf12=0.5D0*(alf1+alf2)
1620 C For diagnostics only!!!
1633 C Return atom J into box the original box
1635 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1636 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1637 C Condition for being inside the proper box
1638 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1639 c & (xj.lt.((-0.5d0)*boxxsize))) then
1643 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1644 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1645 C Condition for being inside the proper box
1646 c if ((yj.gt.((0.5d0)*boxysize)).or.
1647 c & (yj.lt.((-0.5d0)*boxysize))) then
1651 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1652 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1653 C Condition for being inside the proper box
1654 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1655 c & (zj.lt.((-0.5d0)*boxzsize))) then
1659 if (xj.lt.0) xj=xj+boxxsize
1661 if (yj.lt.0) yj=yj+boxysize
1663 if (zj.lt.0) zj=zj+boxzsize
1664 if ((zj.gt.bordlipbot)
1665 &.and.(zj.lt.bordliptop)) then
1666 C the energy transfer exist
1667 if (zj.lt.buflipbot) then
1668 C what fraction I am in
1670 & ((zj-bordlipbot)/lipbufthick)
1671 C lipbufthick is thickenes of lipid buffore
1672 sslipj=sscalelip(fracinbuf)
1673 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1674 elseif (zj.gt.bufliptop) then
1675 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1676 sslipj=sscalelip(fracinbuf)
1677 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1686 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1687 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1688 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1689 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1690 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1691 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1692 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1693 C print *,sslipi,sslipj,bordlipbot,zi,zj
1694 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1702 xj=xj_safe+xshift*boxxsize
1703 yj=yj_safe+yshift*boxysize
1704 zj=zj_safe+zshift*boxzsize
1705 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1706 if(dist_temp.lt.dist_init) then
1716 if (subchap.eq.1) then
1725 dxj=dc_norm(1,nres+j)
1726 dyj=dc_norm(2,nres+j)
1727 dzj=dc_norm(3,nres+j)
1731 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1732 c write (iout,*) "j",j," dc_norm",
1733 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1734 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1736 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1737 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1739 c write (iout,'(a7,4f8.3)')
1740 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1741 if (sss.gt.0.0d0) then
1742 C Calculate angle-dependent terms of energy and contributions to their
1746 sig=sig0ij*dsqrt(sigsq)
1747 rij_shift=1.0D0/rij-sig+sig0ij
1748 c for diagnostics; uncomment
1749 c rij_shift=1.2*sig0ij
1750 C I hate to put IF's in the loops, but here don't have another choice!!!!
1751 if (rij_shift.le.0.0D0) then
1753 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1754 cd & restyp(itypi),i,restyp(itypj),j,
1755 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1759 c---------------------------------------------------------------
1760 rij_shift=1.0D0/rij_shift
1761 fac=rij_shift**expon
1762 C here to start with
1767 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1768 eps2der=evdwij*eps3rt
1769 eps3der=evdwij*eps2rt
1770 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1771 C &((sslipi+sslipj)/2.0d0+
1772 C &(2.0d0-sslipi-sslipj)/2.0d0)
1773 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1774 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1775 evdwij=evdwij*eps2rt*eps3rt
1776 evdw=evdw+evdwij*sss
1778 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1780 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1781 & restyp(itypi),i,restyp(itypj),j,
1782 & epsi,sigm,chi1,chi2,chip1,chip2,
1783 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1784 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1788 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1791 C Calculate gradient components.
1792 e1=e1*eps1*eps2rt**2*eps3rt**2
1793 fac=-expon*(e1+evdwij)*rij_shift
1796 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1797 c & evdwij,fac,sigma(itypi,itypj),expon
1798 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1800 C Calculate the radial part of the gradient
1801 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1802 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1803 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1804 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1805 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1806 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1812 C Calculate angular part of the gradient.
1822 c write (iout,*) "Number of loop steps in EGB:",ind
1823 cccc energy_dec=.false.
1826 C-----------------------------------------------------------------------------
1827 subroutine egbv(evdw)
1829 C This subroutine calculates the interaction energy of nonbonded side chains
1830 C assuming the Gay-Berne-Vorobjev potential of interaction.
1832 implicit real*8 (a-h,o-z)
1833 include 'DIMENSIONS'
1834 include 'COMMON.GEO'
1835 include 'COMMON.VAR'
1836 include 'COMMON.LOCAL'
1837 include 'COMMON.CHAIN'
1838 include 'COMMON.DERIV'
1839 include 'COMMON.NAMES'
1840 include 'COMMON.INTERACT'
1841 include 'COMMON.IOUNITS'
1842 include 'COMMON.CALC'
1843 common /srutu/ icall
1846 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1849 c if (icall.eq.0) lprn=.true.
1851 do i=iatsc_s,iatsc_e
1852 itypi=iabs(itype(i))
1853 if (itypi.eq.ntyp1) cycle
1854 itypi1=iabs(itype(i+1))
1859 if (xi.lt.0) xi=xi+boxxsize
1861 if (yi.lt.0) yi=yi+boxysize
1863 if (zi.lt.0) zi=zi+boxzsize
1864 C define scaling factor for lipids
1866 C if (positi.le.0) positi=positi+boxzsize
1868 C first for peptide groups
1869 c for each residue check if it is in lipid or lipid water border area
1870 if ((zi.gt.bordlipbot)
1871 &.and.(zi.lt.bordliptop)) then
1872 C the energy transfer exist
1873 if (zi.lt.buflipbot) then
1874 C what fraction I am in
1876 & ((zi-bordlipbot)/lipbufthick)
1877 C lipbufthick is thickenes of lipid buffore
1878 sslipi=sscalelip(fracinbuf)
1879 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1880 elseif (zi.gt.bufliptop) then
1881 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1882 sslipi=sscalelip(fracinbuf)
1883 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1893 dxi=dc_norm(1,nres+i)
1894 dyi=dc_norm(2,nres+i)
1895 dzi=dc_norm(3,nres+i)
1896 c dsci_inv=dsc_inv(itypi)
1897 dsci_inv=vbld_inv(i+nres)
1899 C Calculate SC interaction energy.
1901 do iint=1,nint_gr(i)
1902 do j=istart(i,iint),iend(i,iint)
1904 itypj=iabs(itype(j))
1905 if (itypj.eq.ntyp1) cycle
1906 c dscj_inv=dsc_inv(itypj)
1907 dscj_inv=vbld_inv(j+nres)
1908 sig0ij=sigma(itypi,itypj)
1909 r0ij=r0(itypi,itypj)
1910 chi1=chi(itypi,itypj)
1911 chi2=chi(itypj,itypi)
1918 alf12=0.5D0*(alf1+alf2)
1919 C For diagnostics only!!!
1933 if (xj.lt.0) xj=xj+boxxsize
1935 if (yj.lt.0) yj=yj+boxysize
1937 if (zj.lt.0) zj=zj+boxzsize
1938 if ((zj.gt.bordlipbot)
1939 &.and.(zj.lt.bordliptop)) then
1940 C the energy transfer exist
1941 if (zj.lt.buflipbot) then
1942 C what fraction I am in
1944 & ((zj-bordlipbot)/lipbufthick)
1945 C lipbufthick is thickenes of lipid buffore
1946 sslipj=sscalelip(fracinbuf)
1947 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1948 elseif (zj.gt.bufliptop) then
1949 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1950 sslipj=sscalelip(fracinbuf)
1951 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1960 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1961 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1962 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1963 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1964 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
1965 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1966 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1974 xj=xj_safe+xshift*boxxsize
1975 yj=yj_safe+yshift*boxysize
1976 zj=zj_safe+zshift*boxzsize
1977 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1978 if(dist_temp.lt.dist_init) then
1988 if (subchap.eq.1) then
1997 dxj=dc_norm(1,nres+j)
1998 dyj=dc_norm(2,nres+j)
1999 dzj=dc_norm(3,nres+j)
2000 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2002 C Calculate angle-dependent terms of energy and contributions to their
2006 sig=sig0ij*dsqrt(sigsq)
2007 rij_shift=1.0D0/rij-sig+r0ij
2008 C I hate to put IF's in the loops, but here don't have another choice!!!!
2009 if (rij_shift.le.0.0D0) then
2014 c---------------------------------------------------------------
2015 rij_shift=1.0D0/rij_shift
2016 fac=rij_shift**expon
2019 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2020 eps2der=evdwij*eps3rt
2021 eps3der=evdwij*eps2rt
2022 fac_augm=rrij**expon
2023 e_augm=augm(itypi,itypj)*fac_augm
2024 evdwij=evdwij*eps2rt*eps3rt
2025 evdw=evdw+evdwij+e_augm
2027 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2029 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2030 & restyp(itypi),i,restyp(itypj),j,
2031 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2032 & chi1,chi2,chip1,chip2,
2033 & eps1,eps2rt**2,eps3rt**2,
2034 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2037 C Calculate gradient components.
2038 e1=e1*eps1*eps2rt**2*eps3rt**2
2039 fac=-expon*(e1+evdwij)*rij_shift
2041 fac=rij*fac-2*expon*rrij*e_augm
2042 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2043 C Calculate the radial part of the gradient
2047 C Calculate angular part of the gradient.
2053 C-----------------------------------------------------------------------------
2054 subroutine sc_angular
2055 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2056 C om12. Called by ebp, egb, and egbv.
2058 include 'COMMON.CALC'
2059 include 'COMMON.IOUNITS'
2063 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2064 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2065 om12=dxi*dxj+dyi*dyj+dzi*dzj
2067 C Calculate eps1(om12) and its derivative in om12
2068 faceps1=1.0D0-om12*chiom12
2069 faceps1_inv=1.0D0/faceps1
2070 eps1=dsqrt(faceps1_inv)
2071 C Following variable is eps1*deps1/dom12
2072 eps1_om12=faceps1_inv*chiom12
2077 c write (iout,*) "om12",om12," eps1",eps1
2078 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2083 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2084 sigsq=1.0D0-facsig*faceps1_inv
2085 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2086 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2087 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2093 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2094 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2096 C Calculate eps2 and its derivatives in om1, om2, and om12.
2099 chipom12=chip12*om12
2100 facp=1.0D0-om12*chipom12
2102 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2103 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2104 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2105 C Following variable is the square root of eps2
2106 eps2rt=1.0D0-facp1*facp_inv
2107 C Following three variables are the derivatives of the square root of eps
2108 C in om1, om2, and om12.
2109 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2110 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2111 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2112 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2113 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2114 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2115 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2116 c & " eps2rt_om12",eps2rt_om12
2117 C Calculate whole angle-dependent part of epsilon and contributions
2118 C to its derivatives
2121 C----------------------------------------------------------------------------
2123 implicit real*8 (a-h,o-z)
2124 include 'DIMENSIONS'
2125 include 'COMMON.CHAIN'
2126 include 'COMMON.DERIV'
2127 include 'COMMON.CALC'
2128 include 'COMMON.IOUNITS'
2129 double precision dcosom1(3),dcosom2(3)
2130 cc print *,'sss=',sss
2131 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2132 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2133 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2134 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2138 c eom12=evdwij*eps1_om12
2140 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2141 c & " sigder",sigder
2142 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2143 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2145 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2146 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2149 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2151 c write (iout,*) "gg",(gg(k),k=1,3)
2153 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2154 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2155 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2156 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2157 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2158 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2159 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2160 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2161 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2162 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2165 C Calculate the components of the gradient in DC and X
2169 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2173 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2174 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2178 C-----------------------------------------------------------------------
2179 subroutine e_softsphere(evdw)
2181 C This subroutine calculates the interaction energy of nonbonded side chains
2182 C assuming the LJ potential of interaction.
2184 implicit real*8 (a-h,o-z)
2185 include 'DIMENSIONS'
2186 parameter (accur=1.0d-10)
2187 include 'COMMON.GEO'
2188 include 'COMMON.VAR'
2189 include 'COMMON.LOCAL'
2190 include 'COMMON.CHAIN'
2191 include 'COMMON.DERIV'
2192 include 'COMMON.INTERACT'
2193 include 'COMMON.TORSION'
2194 include 'COMMON.SBRIDGE'
2195 include 'COMMON.NAMES'
2196 include 'COMMON.IOUNITS'
2197 include 'COMMON.CONTACTS'
2199 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2201 do i=iatsc_s,iatsc_e
2202 itypi=iabs(itype(i))
2203 if (itypi.eq.ntyp1) cycle
2204 itypi1=iabs(itype(i+1))
2209 C Calculate SC interaction energy.
2211 do iint=1,nint_gr(i)
2212 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2213 cd & 'iend=',iend(i,iint)
2214 do j=istart(i,iint),iend(i,iint)
2215 itypj=iabs(itype(j))
2216 if (itypj.eq.ntyp1) cycle
2220 rij=xj*xj+yj*yj+zj*zj
2221 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2222 r0ij=r0(itypi,itypj)
2224 c print *,i,j,r0ij,dsqrt(rij)
2225 if (rij.lt.r0ijsq) then
2226 evdwij=0.25d0*(rij-r0ijsq)**2
2234 C Calculate the components of the gradient in DC and X
2240 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2241 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2242 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2243 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2247 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2255 C--------------------------------------------------------------------------
2256 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2259 C Soft-sphere potential of p-p interaction
2261 implicit real*8 (a-h,o-z)
2262 include 'DIMENSIONS'
2263 include 'COMMON.CONTROL'
2264 include 'COMMON.IOUNITS'
2265 include 'COMMON.GEO'
2266 include 'COMMON.VAR'
2267 include 'COMMON.LOCAL'
2268 include 'COMMON.CHAIN'
2269 include 'COMMON.DERIV'
2270 include 'COMMON.INTERACT'
2271 include 'COMMON.CONTACTS'
2272 include 'COMMON.TORSION'
2273 include 'COMMON.VECTORS'
2274 include 'COMMON.FFIELD'
2276 C write(iout,*) 'In EELEC_soft_sphere'
2283 do i=iatel_s,iatel_e
2284 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2288 xmedi=c(1,i)+0.5d0*dxi
2289 ymedi=c(2,i)+0.5d0*dyi
2290 zmedi=c(3,i)+0.5d0*dzi
2291 xmedi=mod(xmedi,boxxsize)
2292 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2293 ymedi=mod(ymedi,boxysize)
2294 if (ymedi.lt.0) ymedi=ymedi+boxysize
2295 zmedi=mod(zmedi,boxzsize)
2296 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2298 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2299 do j=ielstart(i),ielend(i)
2300 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2304 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2305 r0ij=rpp(iteli,itelj)
2314 if (xj.lt.0) xj=xj+boxxsize
2316 if (yj.lt.0) yj=yj+boxysize
2318 if (zj.lt.0) zj=zj+boxzsize
2319 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2327 xj=xj_safe+xshift*boxxsize
2328 yj=yj_safe+yshift*boxysize
2329 zj=zj_safe+zshift*boxzsize
2330 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2331 if(dist_temp.lt.dist_init) then
2341 if (isubchap.eq.1) then
2350 rij=xj*xj+yj*yj+zj*zj
2351 sss=sscale(sqrt(rij))
2352 sssgrad=sscagrad(sqrt(rij))
2353 if (rij.lt.r0ijsq) then
2354 evdw1ij=0.25d0*(rij-r0ijsq)**2
2360 evdw1=evdw1+evdw1ij*sss
2362 C Calculate contributions to the Cartesian gradient.
2364 ggg(1)=fac*xj*sssgrad
2365 ggg(2)=fac*yj*sssgrad
2366 ggg(3)=fac*zj*sssgrad
2368 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2369 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2372 * Loop over residues i+1 thru j-1.
2376 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2381 cgrad do i=nnt,nct-1
2383 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2385 cgrad do j=i+1,nct-1
2387 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2393 c------------------------------------------------------------------------------
2394 subroutine vec_and_deriv
2395 implicit real*8 (a-h,o-z)
2396 include 'DIMENSIONS'
2400 include 'COMMON.IOUNITS'
2401 include 'COMMON.GEO'
2402 include 'COMMON.VAR'
2403 include 'COMMON.LOCAL'
2404 include 'COMMON.CHAIN'
2405 include 'COMMON.VECTORS'
2406 include 'COMMON.SETUP'
2407 include 'COMMON.TIME1'
2408 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2409 C Compute the local reference systems. For reference system (i), the
2410 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2411 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2413 do i=ivec_start,ivec_end
2417 if (i.eq.nres-1) then
2418 C Case of the last full residue
2419 C Compute the Z-axis
2420 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2421 costh=dcos(pi-theta(nres))
2422 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2426 C Compute the derivatives of uz
2428 uzder(2,1,1)=-dc_norm(3,i-1)
2429 uzder(3,1,1)= dc_norm(2,i-1)
2430 uzder(1,2,1)= dc_norm(3,i-1)
2432 uzder(3,2,1)=-dc_norm(1,i-1)
2433 uzder(1,3,1)=-dc_norm(2,i-1)
2434 uzder(2,3,1)= dc_norm(1,i-1)
2437 uzder(2,1,2)= dc_norm(3,i)
2438 uzder(3,1,2)=-dc_norm(2,i)
2439 uzder(1,2,2)=-dc_norm(3,i)
2441 uzder(3,2,2)= dc_norm(1,i)
2442 uzder(1,3,2)= dc_norm(2,i)
2443 uzder(2,3,2)=-dc_norm(1,i)
2445 C Compute the Y-axis
2448 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2450 C Compute the derivatives of uy
2453 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2454 & -dc_norm(k,i)*dc_norm(j,i-1)
2455 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2457 uyder(j,j,1)=uyder(j,j,1)-costh
2458 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2463 uygrad(l,k,j,i)=uyder(l,k,j)
2464 uzgrad(l,k,j,i)=uzder(l,k,j)
2468 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2469 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2470 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2471 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2474 C Compute the Z-axis
2475 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2476 costh=dcos(pi-theta(i+2))
2477 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2481 C Compute the derivatives of uz
2483 uzder(2,1,1)=-dc_norm(3,i+1)
2484 uzder(3,1,1)= dc_norm(2,i+1)
2485 uzder(1,2,1)= dc_norm(3,i+1)
2487 uzder(3,2,1)=-dc_norm(1,i+1)
2488 uzder(1,3,1)=-dc_norm(2,i+1)
2489 uzder(2,3,1)= dc_norm(1,i+1)
2492 uzder(2,1,2)= dc_norm(3,i)
2493 uzder(3,1,2)=-dc_norm(2,i)
2494 uzder(1,2,2)=-dc_norm(3,i)
2496 uzder(3,2,2)= dc_norm(1,i)
2497 uzder(1,3,2)= dc_norm(2,i)
2498 uzder(2,3,2)=-dc_norm(1,i)
2500 C Compute the Y-axis
2503 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2505 C Compute the derivatives of uy
2508 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2509 & -dc_norm(k,i)*dc_norm(j,i+1)
2510 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2512 uyder(j,j,1)=uyder(j,j,1)-costh
2513 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2518 uygrad(l,k,j,i)=uyder(l,k,j)
2519 uzgrad(l,k,j,i)=uzder(l,k,j)
2523 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2524 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2525 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2526 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2530 vbld_inv_temp(1)=vbld_inv(i+1)
2531 if (i.lt.nres-1) then
2532 vbld_inv_temp(2)=vbld_inv(i+2)
2534 vbld_inv_temp(2)=vbld_inv(i)
2539 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2540 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2545 #if defined(PARVEC) && defined(MPI)
2546 if (nfgtasks1.gt.1) then
2548 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2549 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2550 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2551 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2552 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2554 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2555 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2557 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2558 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2559 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2560 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2561 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2562 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2563 time_gather=time_gather+MPI_Wtime()-time00
2565 c if (fg_rank.eq.0) then
2566 c write (iout,*) "Arrays UY and UZ"
2568 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2575 C-----------------------------------------------------------------------------
2576 subroutine check_vecgrad
2577 implicit real*8 (a-h,o-z)
2578 include 'DIMENSIONS'
2579 include 'COMMON.IOUNITS'
2580 include 'COMMON.GEO'
2581 include 'COMMON.VAR'
2582 include 'COMMON.LOCAL'
2583 include 'COMMON.CHAIN'
2584 include 'COMMON.VECTORS'
2585 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2586 dimension uyt(3,maxres),uzt(3,maxres)
2587 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2588 double precision delta /1.0d-7/
2591 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2592 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2593 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2594 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2595 cd & (dc_norm(if90,i),if90=1,3)
2596 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2597 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2598 cd write(iout,'(a)')
2604 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2605 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2618 cd write (iout,*) 'i=',i
2620 erij(k)=dc_norm(k,i)
2624 dc_norm(k,i)=erij(k)
2626 dc_norm(j,i)=dc_norm(j,i)+delta
2627 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2629 c dc_norm(k,i)=dc_norm(k,i)/fac
2631 c write (iout,*) (dc_norm(k,i),k=1,3)
2632 c write (iout,*) (erij(k),k=1,3)
2635 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2636 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2637 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2638 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2640 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2641 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2642 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2645 dc_norm(k,i)=erij(k)
2648 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2649 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2650 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2651 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2652 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2653 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2654 cd write (iout,'(a)')
2659 C--------------------------------------------------------------------------
2660 subroutine set_matrices
2661 implicit real*8 (a-h,o-z)
2662 include 'DIMENSIONS'
2665 include "COMMON.SETUP"
2667 integer status(MPI_STATUS_SIZE)
2669 include 'COMMON.IOUNITS'
2670 include 'COMMON.GEO'
2671 include 'COMMON.VAR'
2672 include 'COMMON.LOCAL'
2673 include 'COMMON.CHAIN'
2674 include 'COMMON.DERIV'
2675 include 'COMMON.INTERACT'
2676 include 'COMMON.CONTACTS'
2677 include 'COMMON.TORSION'
2678 include 'COMMON.VECTORS'
2679 include 'COMMON.FFIELD'
2680 double precision auxvec(2),auxmat(2,2)
2682 C Compute the virtual-bond-torsional-angle dependent quantities needed
2683 C to calculate the el-loc multibody terms of various order.
2685 c write(iout,*) 'nphi=',nphi,nres
2687 do i=ivec_start+2,ivec_end+2
2692 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2693 iti = itortyp(itype(i-2))
2697 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2698 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2699 iti1 = itortyp(itype(i-1))
2704 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2705 & +bnew1(2,1,iti)*dsin(theta(i-1))
2706 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2707 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2708 & +bnew1(2,1,iti)*dcos(theta(i-1))
2709 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2710 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2711 c &*(cos(theta(i)/2.0)
2712 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2713 & +bnew2(2,1,iti)*dsin(theta(i-1))
2714 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2715 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2716 c &*(cos(theta(i)/2.0)
2717 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2718 & +bnew2(2,1,iti)*dcos(theta(i-1))
2719 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2720 c if (ggb1(1,i).eq.0.0d0) then
2721 c write(iout,*) 'i=',i,ggb1(1,i),
2722 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2723 c &bnew1(2,1,iti)*cos(theta(i)),
2724 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2726 b1(2,i-2)=bnew1(1,2,iti)
2728 b2(2,i-2)=bnew2(1,2,iti)
2730 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2731 EE(1,2,i-2)=eeold(1,2,iti)
2732 EE(2,1,i-2)=eeold(2,1,iti)
2733 EE(2,2,i-2)=eeold(2,2,iti)
2734 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2739 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2740 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2741 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2742 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2743 b1tilde(1,i-2)=b1(1,i-2)
2744 b1tilde(2,i-2)=-b1(2,i-2)
2745 b2tilde(1,i-2)=b2(1,i-2)
2746 b2tilde(2,i-2)=-b2(2,i-2)
2747 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2748 c write(iout,*) 'b1=',b1(1,i-2)
2749 c write (iout,*) 'theta=', theta(i-1)
2752 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2753 iti = itortyp(itype(i-2))
2757 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2758 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2759 iti1 = itortyp(itype(i-1))
2767 b1tilde(1,i-2)=b1(1,i-2)
2768 b1tilde(2,i-2)=-b1(2,i-2)
2769 b2tilde(1,i-2)=b2(1,i-2)
2770 b2tilde(2,i-2)=-b2(2,i-2)
2771 EE(1,2,i-2)=eeold(1,2,iti)
2772 EE(2,1,i-2)=eeold(2,1,iti)
2773 EE(2,2,i-2)=eeold(2,2,iti)
2774 EE(1,1,i-2)=eeold(1,1,iti)
2778 do i=ivec_start+2,ivec_end+2
2782 if (i .lt. nres+1) then
2819 if (i .gt. 3 .and. i .lt. nres+1) then
2820 obrot_der(1,i-2)=-sin1
2821 obrot_der(2,i-2)= cos1
2822 Ugder(1,1,i-2)= sin1
2823 Ugder(1,2,i-2)=-cos1
2824 Ugder(2,1,i-2)=-cos1
2825 Ugder(2,2,i-2)=-sin1
2828 obrot2_der(1,i-2)=-dwasin2
2829 obrot2_der(2,i-2)= dwacos2
2830 Ug2der(1,1,i-2)= dwasin2
2831 Ug2der(1,2,i-2)=-dwacos2
2832 Ug2der(2,1,i-2)=-dwacos2
2833 Ug2der(2,2,i-2)=-dwasin2
2835 obrot_der(1,i-2)=0.0d0
2836 obrot_der(2,i-2)=0.0d0
2837 Ugder(1,1,i-2)=0.0d0
2838 Ugder(1,2,i-2)=0.0d0
2839 Ugder(2,1,i-2)=0.0d0
2840 Ugder(2,2,i-2)=0.0d0
2841 obrot2_der(1,i-2)=0.0d0
2842 obrot2_der(2,i-2)=0.0d0
2843 Ug2der(1,1,i-2)=0.0d0
2844 Ug2der(1,2,i-2)=0.0d0
2845 Ug2der(2,1,i-2)=0.0d0
2846 Ug2der(2,2,i-2)=0.0d0
2848 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2849 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2850 iti = itortyp(itype(i-2))
2854 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2855 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2856 iti1 = itortyp(itype(i-1))
2860 cd write (iout,*) '*******i',i,' iti1',iti
2861 cd write (iout,*) 'b1',b1(:,iti)
2862 cd write (iout,*) 'b2',b2(:,iti)
2863 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2864 c if (i .gt. iatel_s+2) then
2865 if (i .gt. nnt+2) then
2866 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2868 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2869 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2871 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2872 c & EE(1,2,iti),EE(2,2,iti)
2873 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2874 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2875 c write(iout,*) "Macierz EUG",
2876 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2878 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2880 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2881 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2882 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2883 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2884 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2895 DtUg2(l,k,i-2)=0.0d0
2899 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2900 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2902 muder(k,i-2)=Ub2der(k,i-2)
2904 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2905 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2906 if (itype(i-1).le.ntyp) then
2907 iti1 = itortyp(itype(i-1))
2915 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2917 C write (iout,*) 'mumu',i,b1(1,i-1),Ub2(1,i-2)
2918 c write (iout,*) 'mu ',mu(:,i-2),i-2
2919 cd write (iout,*) 'mu1',mu1(:,i-2)
2920 cd write (iout,*) 'mu2',mu2(:,i-2)
2921 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2923 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2924 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2925 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2926 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2927 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2928 C Vectors and matrices dependent on a single virtual-bond dihedral.
2929 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2930 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2931 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2932 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2933 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2934 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2935 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2936 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2937 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2940 C Matrices dependent on two consecutive virtual-bond dihedrals.
2941 C The order of matrices is from left to right.
2942 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2944 c do i=max0(ivec_start,2),ivec_end
2946 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2947 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2948 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2949 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2950 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2951 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2952 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2953 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2956 #if defined(MPI) && defined(PARMAT)
2958 c if (fg_rank.eq.0) then
2959 write (iout,*) "Arrays UG and UGDER before GATHER"
2961 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2962 & ((ug(l,k,i),l=1,2),k=1,2),
2963 & ((ugder(l,k,i),l=1,2),k=1,2)
2965 write (iout,*) "Arrays UG2 and UG2DER"
2967 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2968 & ((ug2(l,k,i),l=1,2),k=1,2),
2969 & ((ug2der(l,k,i),l=1,2),k=1,2)
2971 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2973 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2974 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2975 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2977 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2979 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2980 & costab(i),sintab(i),costab2(i),sintab2(i)
2982 write (iout,*) "Array MUDER"
2984 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2988 if (nfgtasks.gt.1) then
2990 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2991 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2992 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2994 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2995 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2997 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2998 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3000 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
3001 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3003 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
3004 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3006 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
3007 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3009 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
3010 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3012 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
3013 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
3014 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3015 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
3016 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
3017 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3018 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
3019 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
3020 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3021 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
3022 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
3023 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3024 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3026 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
3027 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3029 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
3030 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3032 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
3033 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3035 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3036 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3038 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3039 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3041 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3042 & ivec_count(fg_rank1),
3043 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3045 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3046 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3048 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3049 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3051 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3052 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3054 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3055 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3057 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3058 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3060 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3061 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3063 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3064 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3066 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3067 & ivec_count(fg_rank1),
3068 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3070 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3071 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3073 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3074 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3076 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3077 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3079 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3080 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3082 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3083 & ivec_count(fg_rank1),
3084 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3086 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3087 & ivec_count(fg_rank1),
3088 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3090 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3091 & ivec_count(fg_rank1),
3092 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3093 & MPI_MAT2,FG_COMM1,IERR)
3094 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3095 & ivec_count(fg_rank1),
3096 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3097 & MPI_MAT2,FG_COMM1,IERR)
3100 c Passes matrix info through the ring
3103 if (irecv.lt.0) irecv=nfgtasks1-1
3106 if (inext.ge.nfgtasks1) inext=0
3108 c write (iout,*) "isend",isend," irecv",irecv
3110 lensend=lentyp(isend)
3111 lenrecv=lentyp(irecv)
3112 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3113 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3114 c & MPI_ROTAT1(lensend),inext,2200+isend,
3115 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3116 c & iprev,2200+irecv,FG_COMM,status,IERR)
3117 c write (iout,*) "Gather ROTAT1"
3119 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3120 c & MPI_ROTAT2(lensend),inext,3300+isend,
3121 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3122 c & iprev,3300+irecv,FG_COMM,status,IERR)
3123 c write (iout,*) "Gather ROTAT2"
3125 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3126 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3127 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3128 & iprev,4400+irecv,FG_COMM,status,IERR)
3129 c write (iout,*) "Gather ROTAT_OLD"
3131 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3132 & MPI_PRECOMP11(lensend),inext,5500+isend,
3133 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3134 & iprev,5500+irecv,FG_COMM,status,IERR)
3135 c write (iout,*) "Gather PRECOMP11"
3137 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3138 & MPI_PRECOMP12(lensend),inext,6600+isend,
3139 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3140 & iprev,6600+irecv,FG_COMM,status,IERR)
3141 c write (iout,*) "Gather PRECOMP12"
3143 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3145 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3146 & MPI_ROTAT2(lensend),inext,7700+isend,
3147 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3148 & iprev,7700+irecv,FG_COMM,status,IERR)
3149 c write (iout,*) "Gather PRECOMP21"
3151 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3152 & MPI_PRECOMP22(lensend),inext,8800+isend,
3153 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3154 & iprev,8800+irecv,FG_COMM,status,IERR)
3155 c write (iout,*) "Gather PRECOMP22"
3157 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3158 & MPI_PRECOMP23(lensend),inext,9900+isend,
3159 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3160 & MPI_PRECOMP23(lenrecv),
3161 & iprev,9900+irecv,FG_COMM,status,IERR)
3162 c write (iout,*) "Gather PRECOMP23"
3167 if (irecv.lt.0) irecv=nfgtasks1-1
3170 time_gather=time_gather+MPI_Wtime()-time00
3173 c if (fg_rank.eq.0) then
3174 write (iout,*) "Arrays UG and UGDER"
3176 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3177 & ((ug(l,k,i),l=1,2),k=1,2),
3178 & ((ugder(l,k,i),l=1,2),k=1,2)
3180 write (iout,*) "Arrays UG2 and UG2DER"
3182 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3183 & ((ug2(l,k,i),l=1,2),k=1,2),
3184 & ((ug2der(l,k,i),l=1,2),k=1,2)
3186 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3188 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3189 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3190 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3192 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3194 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3195 & costab(i),sintab(i),costab2(i),sintab2(i)
3197 write (iout,*) "Array MUDER"
3199 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3205 cd iti = itortyp(itype(i))
3208 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3209 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3214 C--------------------------------------------------------------------------
3215 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3217 C This subroutine calculates the average interaction energy and its gradient
3218 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3219 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3220 C The potential depends both on the distance of peptide-group centers and on
3221 C the orientation of the CA-CA virtual bonds.
3223 implicit real*8 (a-h,o-z)
3227 include 'DIMENSIONS'
3228 include 'COMMON.CONTROL'
3229 include 'COMMON.SETUP'
3230 include 'COMMON.IOUNITS'
3231 include 'COMMON.GEO'
3232 include 'COMMON.VAR'
3233 include 'COMMON.LOCAL'
3234 include 'COMMON.CHAIN'
3235 include 'COMMON.DERIV'
3236 include 'COMMON.INTERACT'
3237 include 'COMMON.CONTACTS'
3238 include 'COMMON.TORSION'
3239 include 'COMMON.VECTORS'
3240 include 'COMMON.FFIELD'
3241 include 'COMMON.TIME1'
3242 include 'COMMON.SPLITELE'
3243 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3244 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3245 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3246 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3247 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3248 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3250 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3252 double precision scal_el /1.0d0/
3254 double precision scal_el /0.5d0/
3257 C 13-go grudnia roku pamietnego...
3258 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3259 & 0.0d0,1.0d0,0.0d0,
3260 & 0.0d0,0.0d0,1.0d0/
3261 cd write(iout,*) 'In EELEC'
3263 cd write(iout,*) 'Type',i
3264 cd write(iout,*) 'B1',B1(:,i)
3265 cd write(iout,*) 'B2',B2(:,i)
3266 cd write(iout,*) 'CC',CC(:,:,i)
3267 cd write(iout,*) 'DD',DD(:,:,i)
3268 cd write(iout,*) 'EE',EE(:,:,i)
3270 cd call check_vecgrad
3272 if (icheckgrad.eq.1) then
3274 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3276 dc_norm(k,i)=dc(k,i)*fac
3278 c write (iout,*) 'i',i,' fac',fac
3281 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3282 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3283 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3284 c call vec_and_deriv
3290 time_mat=time_mat+MPI_Wtime()-time01
3294 cd write (iout,*) 'i=',i
3296 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3299 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3300 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3313 cd print '(a)','Enter EELEC'
3314 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3316 gel_loc_loc(i)=0.0d0
3321 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3323 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3325 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3326 do i=iturn3_start,iturn3_end
3328 C write(iout,*) "tu jest i",i
3329 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3330 C changes suggested by Ana to avoid out of bounds
3331 & .or.((i+4).gt.nres)
3333 C end of changes by Ana
3334 & .or. itype(i+2).eq.ntyp1
3335 & .or. itype(i+3).eq.ntyp1) cycle
3337 if(itype(i-1).eq.ntyp1)cycle
3340 if (itype(i+4).eq.ntyp1) cycle
3345 dx_normi=dc_norm(1,i)
3346 dy_normi=dc_norm(2,i)
3347 dz_normi=dc_norm(3,i)
3348 xmedi=c(1,i)+0.5d0*dxi
3349 ymedi=c(2,i)+0.5d0*dyi
3350 zmedi=c(3,i)+0.5d0*dzi
3351 xmedi=mod(xmedi,boxxsize)
3352 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3353 ymedi=mod(ymedi,boxysize)
3354 if (ymedi.lt.0) ymedi=ymedi+boxysize
3355 zmedi=mod(zmedi,boxzsize)
3356 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3358 call eelecij(i,i+2,ees,evdw1,eel_loc)
3359 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3360 num_cont_hb(i)=num_conti
3362 do i=iturn4_start,iturn4_end
3364 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3365 C changes suggested by Ana to avoid out of bounds
3366 & .or.((i+5).gt.nres)
3368 C end of changes suggested by Ana
3369 & .or. itype(i+3).eq.ntyp1
3370 & .or. itype(i+4).eq.ntyp1
3371 & .or. itype(i+5).eq.ntyp1
3372 & .or. itype(i).eq.ntyp1
3373 & .or. itype(i-1).eq.ntyp1
3378 dx_normi=dc_norm(1,i)
3379 dy_normi=dc_norm(2,i)
3380 dz_normi=dc_norm(3,i)
3381 xmedi=c(1,i)+0.5d0*dxi
3382 ymedi=c(2,i)+0.5d0*dyi
3383 zmedi=c(3,i)+0.5d0*dzi
3384 C Return atom into box, boxxsize is size of box in x dimension
3386 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3387 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3388 C Condition for being inside the proper box
3389 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3390 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3394 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3395 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3396 C Condition for being inside the proper box
3397 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3398 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3402 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3403 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3404 C Condition for being inside the proper box
3405 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3406 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3409 xmedi=mod(xmedi,boxxsize)
3410 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3411 ymedi=mod(ymedi,boxysize)
3412 if (ymedi.lt.0) ymedi=ymedi+boxysize
3413 zmedi=mod(zmedi,boxzsize)
3414 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3416 num_conti=num_cont_hb(i)
3417 c write(iout,*) "JESTEM W PETLI"
3418 call eelecij(i,i+3,ees,evdw1,eel_loc)
3419 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3420 & call eturn4(i,eello_turn4)
3421 num_cont_hb(i)=num_conti
3423 C Loop over all neighbouring boxes
3428 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3430 do i=iatel_s,iatel_e
3432 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3433 C changes suggested by Ana to avoid out of bounds
3434 & .or.((i+2).gt.nres)
3436 C end of changes by Ana
3437 & .or. itype(i+2).eq.ntyp1
3438 & .or. itype(i-1).eq.ntyp1
3443 dx_normi=dc_norm(1,i)
3444 dy_normi=dc_norm(2,i)
3445 dz_normi=dc_norm(3,i)
3446 xmedi=c(1,i)+0.5d0*dxi
3447 ymedi=c(2,i)+0.5d0*dyi
3448 zmedi=c(3,i)+0.5d0*dzi
3449 xmedi=mod(xmedi,boxxsize)
3450 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3451 ymedi=mod(ymedi,boxysize)
3452 if (ymedi.lt.0) ymedi=ymedi+boxysize
3453 zmedi=mod(zmedi,boxzsize)
3454 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3455 C xmedi=xmedi+xshift*boxxsize
3456 C ymedi=ymedi+yshift*boxysize
3457 C zmedi=zmedi+zshift*boxzsize
3459 C Return tom into box, boxxsize is size of box in x dimension
3461 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3462 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3463 C Condition for being inside the proper box
3464 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3465 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3469 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3470 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3471 C Condition for being inside the proper box
3472 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3473 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3477 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3478 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3479 cC Condition for being inside the proper box
3480 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3481 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3485 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3486 num_conti=num_cont_hb(i)
3487 do j=ielstart(i),ielend(i)
3488 C write (iout,*) i,j
3490 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3491 C changes suggested by Ana to avoid out of bounds
3492 & .or.((j+2).gt.nres)
3494 C end of changes by Ana
3495 & .or.itype(j+2).eq.ntyp1
3496 & .or.itype(j-1).eq.ntyp1
3498 call eelecij(i,j,ees,evdw1,eel_loc)
3500 num_cont_hb(i)=num_conti
3506 c write (iout,*) "Number of loop steps in EELEC:",ind
3508 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3509 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3511 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3512 ccc eel_loc=eel_loc+eello_turn3
3513 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3516 C-------------------------------------------------------------------------------
3517 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3518 implicit real*8 (a-h,o-z)
3519 include 'DIMENSIONS'
3523 include 'COMMON.CONTROL'
3524 include 'COMMON.IOUNITS'
3525 include 'COMMON.GEO'
3526 include 'COMMON.VAR'
3527 include 'COMMON.LOCAL'
3528 include 'COMMON.CHAIN'
3529 include 'COMMON.DERIV'
3530 include 'COMMON.INTERACT'
3531 include 'COMMON.CONTACTS'
3532 include 'COMMON.TORSION'
3533 include 'COMMON.VECTORS'
3534 include 'COMMON.FFIELD'
3535 include 'COMMON.TIME1'
3536 include 'COMMON.SPLITELE'
3537 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3538 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3539 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3540 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3541 & gmuij2(4),gmuji2(4)
3542 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3543 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3545 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3547 double precision scal_el /1.0d0/
3549 double precision scal_el /0.5d0/
3552 C 13-go grudnia roku pamietnego...
3553 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3554 & 0.0d0,1.0d0,0.0d0,
3555 & 0.0d0,0.0d0,1.0d0/
3556 c time00=MPI_Wtime()
3557 cd write (iout,*) "eelecij",i,j
3561 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3562 aaa=app(iteli,itelj)
3563 bbb=bpp(iteli,itelj)
3564 ael6i=ael6(iteli,itelj)
3565 ael3i=ael3(iteli,itelj)
3569 dx_normj=dc_norm(1,j)
3570 dy_normj=dc_norm(2,j)
3571 dz_normj=dc_norm(3,j)
3572 C xj=c(1,j)+0.5D0*dxj-xmedi
3573 C yj=c(2,j)+0.5D0*dyj-ymedi
3574 C zj=c(3,j)+0.5D0*dzj-zmedi
3579 if (xj.lt.0) xj=xj+boxxsize
3581 if (yj.lt.0) yj=yj+boxysize
3583 if (zj.lt.0) zj=zj+boxzsize
3584 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3585 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3593 xj=xj_safe+xshift*boxxsize
3594 yj=yj_safe+yshift*boxysize
3595 zj=zj_safe+zshift*boxzsize
3596 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3597 if(dist_temp.lt.dist_init) then
3607 if (isubchap.eq.1) then
3616 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3618 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3619 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3620 C Condition for being inside the proper box
3621 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3622 c & (xj.lt.((-0.5d0)*boxxsize))) then
3626 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3627 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3628 C Condition for being inside the proper box
3629 c if ((yj.gt.((0.5d0)*boxysize)).or.
3630 c & (yj.lt.((-0.5d0)*boxysize))) then
3634 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3635 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3636 C Condition for being inside the proper box
3637 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3638 c & (zj.lt.((-0.5d0)*boxzsize))) then
3641 C endif !endPBC condintion
3645 rij=xj*xj+yj*yj+zj*zj
3647 sss=sscale(sqrt(rij))
3648 sssgrad=sscagrad(sqrt(rij))
3649 c if (sss.gt.0.0d0) then
3655 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3656 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3657 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3658 fac=cosa-3.0D0*cosb*cosg
3660 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3661 if (j.eq.i+2) ev1=scal_el*ev1
3666 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3670 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3671 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3673 evdw1=evdw1+evdwij*sss
3674 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3675 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3676 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3677 cd & xmedi,ymedi,zmedi,xj,yj,zj
3679 if (energy_dec) then
3680 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3682 c &,iteli,itelj,aaa,evdw1
3683 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3687 C Calculate contributions to the Cartesian gradient.
3690 facvdw=-6*rrmij*(ev1+evdwij)*sss
3691 facel=-3*rrmij*(el1+eesij)
3697 * Radial derivatives. First process both termini of the fragment (i,j)
3703 c ghalf=0.5D0*ggg(k)
3704 c gelc(k,i)=gelc(k,i)+ghalf
3705 c gelc(k,j)=gelc(k,j)+ghalf
3707 c 9/28/08 AL Gradient compotents will be summed only at the end
3709 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3710 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3713 * Loop over residues i+1 thru j-1.
3717 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3720 if (sss.gt.0.0) then
3721 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3722 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3723 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3730 c ghalf=0.5D0*ggg(k)
3731 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3732 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3734 c 9/28/08 AL Gradient compotents will be summed only at the end
3736 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3737 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3740 * Loop over residues i+1 thru j-1.
3744 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3749 facvdw=(ev1+evdwij)*sss
3752 fac=-3*rrmij*(facvdw+facvdw+facel)
3757 * Radial derivatives. First process both termini of the fragment (i,j)
3763 c ghalf=0.5D0*ggg(k)
3764 c gelc(k,i)=gelc(k,i)+ghalf
3765 c gelc(k,j)=gelc(k,j)+ghalf
3767 c 9/28/08 AL Gradient compotents will be summed only at the end
3769 gelc_long(k,j)=gelc(k,j)+ggg(k)
3770 gelc_long(k,i)=gelc(k,i)-ggg(k)
3773 * Loop over residues i+1 thru j-1.
3777 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3780 c 9/28/08 AL Gradient compotents will be summed only at the end
3781 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3782 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3783 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3785 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3786 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3792 ecosa=2.0D0*fac3*fac1+fac4
3795 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3796 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3798 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3799 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3801 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3802 cd & (dcosg(k),k=1,3)
3804 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3807 c ghalf=0.5D0*ggg(k)
3808 c gelc(k,i)=gelc(k,i)+ghalf
3809 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3810 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3811 c gelc(k,j)=gelc(k,j)+ghalf
3812 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3813 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3817 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3822 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3823 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3825 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3826 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3827 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3828 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3832 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3833 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3834 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3836 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3837 C energy of a peptide unit is assumed in the form of a second-order
3838 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3839 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3840 C are computed for EVERY pair of non-contiguous peptide groups.
3843 if (j.lt.nres-1) then
3855 muij(kkk)=mu(k,i)*mu(l,j)
3856 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3858 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3859 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3860 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3861 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3862 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3863 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3867 cd write (iout,*) 'EELEC: i',i,' j',j
3868 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3869 cd write(iout,*) 'muij',muij
3870 ury=scalar(uy(1,i),erij)
3871 urz=scalar(uz(1,i),erij)
3872 vry=scalar(uy(1,j),erij)
3873 vrz=scalar(uz(1,j),erij)
3874 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3875 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3876 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3877 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3878 fac=dsqrt(-ael6i)*r3ij
3883 cd write (iout,'(4i5,4f10.5)')
3884 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3885 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3886 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3887 cd & uy(:,j),uz(:,j)
3888 cd write (iout,'(4f10.5)')
3889 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3890 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3891 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3892 cd write (iout,'(9f10.5/)')
3893 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3894 C Derivatives of the elements of A in virtual-bond vectors
3895 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3897 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3898 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3899 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3900 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3901 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3902 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3903 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3904 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3905 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3906 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3907 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3908 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3910 C Compute radial contributions to the gradient
3928 C Add the contributions coming from er
3931 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3932 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3933 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3934 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3937 C Derivatives in DC(i)
3938 cgrad ghalf1=0.5d0*agg(k,1)
3939 cgrad ghalf2=0.5d0*agg(k,2)
3940 cgrad ghalf3=0.5d0*agg(k,3)
3941 cgrad ghalf4=0.5d0*agg(k,4)
3942 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3943 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3944 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3945 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3946 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3947 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3948 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3949 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3950 C Derivatives in DC(i+1)
3951 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3952 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3953 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3954 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3955 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3956 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3957 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3958 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3959 C Derivatives in DC(j)
3960 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3961 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3962 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3963 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3964 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3965 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3966 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3967 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3968 C Derivatives in DC(j+1) or DC(nres-1)
3969 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3970 & -3.0d0*vryg(k,3)*ury)
3971 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3972 & -3.0d0*vrzg(k,3)*ury)
3973 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3974 & -3.0d0*vryg(k,3)*urz)
3975 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3976 & -3.0d0*vrzg(k,3)*urz)
3977 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3979 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3992 aggi(k,l)=-aggi(k,l)
3993 aggi1(k,l)=-aggi1(k,l)
3994 aggj(k,l)=-aggj(k,l)
3995 aggj1(k,l)=-aggj1(k,l)
3998 if (j.lt.nres-1) then
4004 aggi(k,l)=-aggi(k,l)
4005 aggi1(k,l)=-aggi1(k,l)
4006 aggj(k,l)=-aggj(k,l)
4007 aggj1(k,l)=-aggj1(k,l)
4018 aggi(k,l)=-aggi(k,l)
4019 aggi1(k,l)=-aggi1(k,l)
4020 aggj(k,l)=-aggj(k,l)
4021 aggj1(k,l)=-aggj1(k,l)
4026 IF (wel_loc.gt.0.0d0) THEN
4027 C Contribution to the local-electrostatic energy coming from the i-j pair
4028 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4030 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4031 c & ' eel_loc_ij',eel_loc_ij
4032 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4033 C Calculate patrial derivative for theta angle
4035 geel_loc_ij=a22*gmuij1(1)
4039 c write(iout,*) "derivative over thatai"
4040 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4042 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4043 & geel_loc_ij*wel_loc
4044 c write(iout,*) "derivative over thatai-1"
4045 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4052 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4053 & geel_loc_ij*wel_loc
4054 c Derivative over j residue
4055 geel_loc_ji=a22*gmuji1(1)
4059 c write(iout,*) "derivative over thataj"
4060 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4063 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4064 & geel_loc_ji*wel_loc
4070 c write(iout,*) "derivative over thataj-1"
4071 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4073 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4074 & geel_loc_ji*wel_loc
4076 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4078 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4079 & 'eelloc',i,j,eel_loc_ij
4080 c if (eel_loc_ij.ne.0)
4081 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4082 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4084 eel_loc=eel_loc+eel_loc_ij
4085 C Partial derivatives in virtual-bond dihedral angles gamma
4087 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4088 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4089 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
4090 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4091 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4092 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
4093 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4095 ggg(l)=agg(l,1)*muij(1)+
4096 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
4097 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4098 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4099 cgrad ghalf=0.5d0*ggg(l)
4100 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4101 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4105 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4108 C Remaining derivatives of eello
4110 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4111 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4112 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4113 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4114 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4115 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4116 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4117 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4120 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4121 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4122 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4123 & .and. num_conti.le.maxconts) then
4124 c write (iout,*) i,j," entered corr"
4126 C Calculate the contact function. The ith column of the array JCONT will
4127 C contain the numbers of atoms that make contacts with the atom I (of numbers
4128 C greater than I). The arrays FACONT and GACONT will contain the values of
4129 C the contact function and its derivative.
4130 c r0ij=1.02D0*rpp(iteli,itelj)
4131 c r0ij=1.11D0*rpp(iteli,itelj)
4132 r0ij=2.20D0*rpp(iteli,itelj)
4133 c r0ij=1.55D0*rpp(iteli,itelj)
4134 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4135 if (fcont.gt.0.0D0) then
4136 num_conti=num_conti+1
4137 if (num_conti.gt.maxconts) then
4138 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4139 & ' will skip next contacts for this conf.'
4141 jcont_hb(num_conti,i)=j
4142 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4143 cd & " jcont_hb",jcont_hb(num_conti,i)
4144 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4145 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4146 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4148 d_cont(num_conti,i)=rij
4149 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4150 C --- Electrostatic-interaction matrix ---
4151 a_chuj(1,1,num_conti,i)=a22
4152 a_chuj(1,2,num_conti,i)=a23
4153 a_chuj(2,1,num_conti,i)=a32
4154 a_chuj(2,2,num_conti,i)=a33
4155 C --- Gradient of rij
4157 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4164 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4165 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4166 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4167 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4168 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4173 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4174 C Calculate contact energies
4176 wij=cosa-3.0D0*cosb*cosg
4179 c fac3=dsqrt(-ael6i)/r0ij**3
4180 fac3=dsqrt(-ael6i)*r3ij
4181 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4182 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4183 if (ees0tmp.gt.0) then
4184 ees0pij=dsqrt(ees0tmp)
4188 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4189 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4190 if (ees0tmp.gt.0) then
4191 ees0mij=dsqrt(ees0tmp)
4196 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4197 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4198 C Diagnostics. Comment out or remove after debugging!
4199 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4200 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4201 c ees0m(num_conti,i)=0.0D0
4203 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4204 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4205 C Angular derivatives of the contact function
4206 ees0pij1=fac3/ees0pij
4207 ees0mij1=fac3/ees0mij
4208 fac3p=-3.0D0*fac3*rrmij
4209 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4210 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4212 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4213 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4214 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4215 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4216 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4217 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4218 ecosap=ecosa1+ecosa2
4219 ecosbp=ecosb1+ecosb2
4220 ecosgp=ecosg1+ecosg2
4221 ecosam=ecosa1-ecosa2
4222 ecosbm=ecosb1-ecosb2
4223 ecosgm=ecosg1-ecosg2
4232 facont_hb(num_conti,i)=fcont
4233 fprimcont=fprimcont/rij
4234 cd facont_hb(num_conti,i)=1.0D0
4235 C Following line is for diagnostics.
4238 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4239 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4242 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4243 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4245 gggp(1)=gggp(1)+ees0pijp*xj
4246 gggp(2)=gggp(2)+ees0pijp*yj
4247 gggp(3)=gggp(3)+ees0pijp*zj
4248 gggm(1)=gggm(1)+ees0mijp*xj
4249 gggm(2)=gggm(2)+ees0mijp*yj
4250 gggm(3)=gggm(3)+ees0mijp*zj
4251 C Derivatives due to the contact function
4252 gacont_hbr(1,num_conti,i)=fprimcont*xj
4253 gacont_hbr(2,num_conti,i)=fprimcont*yj
4254 gacont_hbr(3,num_conti,i)=fprimcont*zj
4257 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4258 c following the change of gradient-summation algorithm.
4260 cgrad ghalfp=0.5D0*gggp(k)
4261 cgrad ghalfm=0.5D0*gggm(k)
4262 gacontp_hb1(k,num_conti,i)=!ghalfp
4263 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4264 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4265 gacontp_hb2(k,num_conti,i)=!ghalfp
4266 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4267 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4268 gacontp_hb3(k,num_conti,i)=gggp(k)
4269 gacontm_hb1(k,num_conti,i)=!ghalfm
4270 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4271 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4272 gacontm_hb2(k,num_conti,i)=!ghalfm
4273 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4274 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4275 gacontm_hb3(k,num_conti,i)=gggm(k)
4277 C Diagnostics. Comment out or remove after debugging!
4279 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4280 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4281 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4282 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4283 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4284 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4287 endif ! num_conti.le.maxconts
4290 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4293 ghalf=0.5d0*agg(l,k)
4294 aggi(l,k)=aggi(l,k)+ghalf
4295 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4296 aggj(l,k)=aggj(l,k)+ghalf
4299 if (j.eq.nres-1 .and. i.lt.j-2) then
4302 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4307 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4310 C-----------------------------------------------------------------------------
4311 subroutine eturn3(i,eello_turn3)
4312 C Third- and fourth-order contributions from turns
4313 implicit real*8 (a-h,o-z)
4314 include 'DIMENSIONS'
4315 include 'COMMON.IOUNITS'
4316 include 'COMMON.GEO'
4317 include 'COMMON.VAR'
4318 include 'COMMON.LOCAL'
4319 include 'COMMON.CHAIN'
4320 include 'COMMON.DERIV'
4321 include 'COMMON.INTERACT'
4322 include 'COMMON.CONTACTS'
4323 include 'COMMON.TORSION'
4324 include 'COMMON.VECTORS'
4325 include 'COMMON.FFIELD'
4326 include 'COMMON.CONTROL'
4328 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4329 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4330 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4331 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4332 & auxgmat2(2,2),auxgmatt2(2,2)
4333 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4334 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4335 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4336 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4339 c write (iout,*) "eturn3",i,j,j1,j2
4344 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4346 C Third-order contributions
4353 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4354 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4355 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4356 c auxalary matices for theta gradient
4357 c auxalary matrix for i+1 and constant i+2
4358 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4359 c auxalary matrix for i+2 and constant i+1
4360 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4361 call transpose2(auxmat(1,1),auxmat1(1,1))
4362 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4363 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4364 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4365 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4366 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4367 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4368 C Derivatives in theta
4369 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4370 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4371 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4372 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4374 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4375 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4376 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4377 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4378 cd & ' eello_turn3_num',4*eello_turn3_num
4379 C Derivatives in gamma(i)
4380 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4381 call transpose2(auxmat2(1,1),auxmat3(1,1))
4382 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4383 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4384 C Derivatives in gamma(i+1)
4385 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4386 call transpose2(auxmat2(1,1),auxmat3(1,1))
4387 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4388 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4389 & +0.5d0*(pizda(1,1)+pizda(2,2))
4390 C Cartesian derivatives
4392 c ghalf1=0.5d0*agg(l,1)
4393 c ghalf2=0.5d0*agg(l,2)
4394 c ghalf3=0.5d0*agg(l,3)
4395 c ghalf4=0.5d0*agg(l,4)
4396 a_temp(1,1)=aggi(l,1)!+ghalf1
4397 a_temp(1,2)=aggi(l,2)!+ghalf2
4398 a_temp(2,1)=aggi(l,3)!+ghalf3
4399 a_temp(2,2)=aggi(l,4)!+ghalf4
4400 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4401 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4402 & +0.5d0*(pizda(1,1)+pizda(2,2))
4403 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4404 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4405 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4406 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4407 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4408 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4409 & +0.5d0*(pizda(1,1)+pizda(2,2))
4410 a_temp(1,1)=aggj(l,1)!+ghalf1
4411 a_temp(1,2)=aggj(l,2)!+ghalf2
4412 a_temp(2,1)=aggj(l,3)!+ghalf3
4413 a_temp(2,2)=aggj(l,4)!+ghalf4
4414 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4415 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4416 & +0.5d0*(pizda(1,1)+pizda(2,2))
4417 a_temp(1,1)=aggj1(l,1)
4418 a_temp(1,2)=aggj1(l,2)
4419 a_temp(2,1)=aggj1(l,3)
4420 a_temp(2,2)=aggj1(l,4)
4421 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4422 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4423 & +0.5d0*(pizda(1,1)+pizda(2,2))
4427 C-------------------------------------------------------------------------------
4428 subroutine eturn4(i,eello_turn4)
4429 C Third- and fourth-order contributions from turns
4430 implicit real*8 (a-h,o-z)
4431 include 'DIMENSIONS'
4432 include 'COMMON.IOUNITS'
4433 include 'COMMON.GEO'
4434 include 'COMMON.VAR'
4435 include 'COMMON.LOCAL'
4436 include 'COMMON.CHAIN'
4437 include 'COMMON.DERIV'
4438 include 'COMMON.INTERACT'
4439 include 'COMMON.CONTACTS'
4440 include 'COMMON.TORSION'
4441 include 'COMMON.VECTORS'
4442 include 'COMMON.FFIELD'
4443 include 'COMMON.CONTROL'
4445 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4446 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4447 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4448 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4449 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4450 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4451 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4452 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4453 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4454 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4455 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4458 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4460 C Fourth-order contributions
4468 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4469 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4470 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4471 c write(iout,*)"WCHODZE W PROGRAM"
4476 iti1=itortyp(itype(i+1))
4477 iti2=itortyp(itype(i+2))
4478 iti3=itortyp(itype(i+3))
4479 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4480 call transpose2(EUg(1,1,i+1),e1t(1,1))
4481 call transpose2(Eug(1,1,i+2),e2t(1,1))
4482 call transpose2(Eug(1,1,i+3),e3t(1,1))
4483 C Ematrix derivative in theta
4484 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4485 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4486 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4487 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4488 c eta1 in derivative theta
4489 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4490 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4491 c auxgvec is derivative of Ub2 so i+3 theta
4492 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4493 c auxalary matrix of E i+1
4494 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4497 s1=scalar2(b1(1,i+2),auxvec(1))
4498 c derivative of theta i+2 with constant i+3
4499 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4500 c derivative of theta i+2 with constant i+2
4501 gs32=scalar2(b1(1,i+2),auxgvec(1))
4502 c derivative of E matix in theta of i+1
4503 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4505 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4506 c ea31 in derivative theta
4507 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4508 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4509 c auxilary matrix auxgvec of Ub2 with constant E matirx
4510 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4511 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4512 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4516 s2=scalar2(b1(1,i+1),auxvec(1))
4517 c derivative of theta i+1 with constant i+3
4518 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4519 c derivative of theta i+2 with constant i+1
4520 gs21=scalar2(b1(1,i+1),auxgvec(1))
4521 c derivative of theta i+3 with constant i+1
4522 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4523 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4525 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4526 c two derivatives over diffetent matrices
4527 c gtae3e2 is derivative over i+3
4528 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4529 c ae3gte2 is derivative over i+2
4530 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4531 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4532 c three possible derivative over theta E matices
4534 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4536 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4538 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4539 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4541 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4542 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4543 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4545 eello_turn4=eello_turn4-(s1+s2+s3)
4546 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4547 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4548 c & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4549 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4550 cd & ' eello_turn4_num',8*eello_turn4_num
4552 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4553 & -(gs13+gsE13+gsEE1)*wturn4
4554 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4555 & -(gs23+gs21+gsEE2)*wturn4
4556 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4557 & -(gs32+gsE31+gsEE3)*wturn4
4558 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4561 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4562 & 'eturn4',i,j,-(s1+s2+s3)
4563 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4564 c & ' eello_turn4_num',8*eello_turn4_num
4565 C Derivatives in gamma(i)
4566 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4567 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4568 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4569 s1=scalar2(b1(1,i+2),auxvec(1))
4570 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4571 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4572 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4573 C Derivatives in gamma(i+1)
4574 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4575 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4576 s2=scalar2(b1(1,i+1),auxvec(1))
4577 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4578 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4579 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4580 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4581 C Derivatives in gamma(i+2)
4582 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4583 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4584 s1=scalar2(b1(1,i+2),auxvec(1))
4585 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4586 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4587 s2=scalar2(b1(1,i+1),auxvec(1))
4588 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4589 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4590 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4591 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4592 C Cartesian derivatives
4593 C Derivatives of this turn contributions in DC(i+2)
4594 if (j.lt.nres-1) then
4596 a_temp(1,1)=agg(l,1)
4597 a_temp(1,2)=agg(l,2)
4598 a_temp(2,1)=agg(l,3)
4599 a_temp(2,2)=agg(l,4)
4600 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4601 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4602 s1=scalar2(b1(1,i+2),auxvec(1))
4603 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4604 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4605 s2=scalar2(b1(1,i+1),auxvec(1))
4606 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4607 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4608 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4610 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4613 C Remaining derivatives of this turn contribution
4615 a_temp(1,1)=aggi(l,1)
4616 a_temp(1,2)=aggi(l,2)
4617 a_temp(2,1)=aggi(l,3)
4618 a_temp(2,2)=aggi(l,4)
4619 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4620 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4621 s1=scalar2(b1(1,i+2),auxvec(1))
4622 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4623 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4624 s2=scalar2(b1(1,i+1),auxvec(1))
4625 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4626 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4627 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4628 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4629 a_temp(1,1)=aggi1(l,1)
4630 a_temp(1,2)=aggi1(l,2)
4631 a_temp(2,1)=aggi1(l,3)
4632 a_temp(2,2)=aggi1(l,4)
4633 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4634 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4635 s1=scalar2(b1(1,i+2),auxvec(1))
4636 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4637 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4638 s2=scalar2(b1(1,i+1),auxvec(1))
4639 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4640 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4641 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4642 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4643 a_temp(1,1)=aggj(l,1)
4644 a_temp(1,2)=aggj(l,2)
4645 a_temp(2,1)=aggj(l,3)
4646 a_temp(2,2)=aggj(l,4)
4647 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4648 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4649 s1=scalar2(b1(1,i+2),auxvec(1))
4650 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4651 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4652 s2=scalar2(b1(1,i+1),auxvec(1))
4653 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4654 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4655 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4656 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4657 a_temp(1,1)=aggj1(l,1)
4658 a_temp(1,2)=aggj1(l,2)
4659 a_temp(2,1)=aggj1(l,3)
4660 a_temp(2,2)=aggj1(l,4)
4661 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4662 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4663 s1=scalar2(b1(1,i+2),auxvec(1))
4664 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4665 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4666 s2=scalar2(b1(1,i+1),auxvec(1))
4667 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4668 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4669 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4670 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4671 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4675 C-----------------------------------------------------------------------------
4676 subroutine vecpr(u,v,w)
4677 implicit real*8(a-h,o-z)
4678 dimension u(3),v(3),w(3)
4679 w(1)=u(2)*v(3)-u(3)*v(2)
4680 w(2)=-u(1)*v(3)+u(3)*v(1)
4681 w(3)=u(1)*v(2)-u(2)*v(1)
4684 C-----------------------------------------------------------------------------
4685 subroutine unormderiv(u,ugrad,unorm,ungrad)
4686 C This subroutine computes the derivatives of a normalized vector u, given
4687 C the derivatives computed without normalization conditions, ugrad. Returns
4690 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4691 double precision vec(3)
4692 double precision scalar
4694 c write (2,*) 'ugrad',ugrad
4697 vec(i)=scalar(ugrad(1,i),u(1))
4699 c write (2,*) 'vec',vec
4702 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4705 c write (2,*) 'ungrad',ungrad
4708 C-----------------------------------------------------------------------------
4709 subroutine escp_soft_sphere(evdw2,evdw2_14)
4711 C This subroutine calculates the excluded-volume interaction energy between
4712 C peptide-group centers and side chains and its gradient in virtual-bond and
4713 C side-chain vectors.
4715 implicit real*8 (a-h,o-z)
4716 include 'DIMENSIONS'
4717 include 'COMMON.GEO'
4718 include 'COMMON.VAR'
4719 include 'COMMON.LOCAL'
4720 include 'COMMON.CHAIN'
4721 include 'COMMON.DERIV'
4722 include 'COMMON.INTERACT'
4723 include 'COMMON.FFIELD'
4724 include 'COMMON.IOUNITS'
4725 include 'COMMON.CONTROL'
4730 cd print '(a)','Enter ESCP'
4731 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4735 do i=iatscp_s,iatscp_e
4736 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4738 xi=0.5D0*(c(1,i)+c(1,i+1))
4739 yi=0.5D0*(c(2,i)+c(2,i+1))
4740 zi=0.5D0*(c(3,i)+c(3,i+1))
4741 C Return atom into box, boxxsize is size of box in x dimension
4743 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4744 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4745 C Condition for being inside the proper box
4746 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4747 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4751 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4752 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4753 C Condition for being inside the proper box
4754 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4755 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4759 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4760 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4761 cC Condition for being inside the proper box
4762 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4763 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4767 if (xi.lt.0) xi=xi+boxxsize
4769 if (yi.lt.0) yi=yi+boxysize
4771 if (zi.lt.0) zi=zi+boxzsize
4772 C xi=xi+xshift*boxxsize
4773 C yi=yi+yshift*boxysize
4774 C zi=zi+zshift*boxzsize
4775 do iint=1,nscp_gr(i)
4777 do j=iscpstart(i,iint),iscpend(i,iint)
4778 if (itype(j).eq.ntyp1) cycle
4779 itypj=iabs(itype(j))
4780 C Uncomment following three lines for SC-p interactions
4784 C Uncomment following three lines for Ca-p interactions
4789 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4790 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4791 C Condition for being inside the proper box
4792 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4793 c & (xj.lt.((-0.5d0)*boxxsize))) then
4797 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4798 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4799 cC Condition for being inside the proper box
4800 c if ((yj.gt.((0.5d0)*boxysize)).or.
4801 c & (yj.lt.((-0.5d0)*boxysize))) then
4805 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4806 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4807 C Condition for being inside the proper box
4808 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4809 c & (zj.lt.((-0.5d0)*boxzsize))) then
4812 if (xj.lt.0) xj=xj+boxxsize
4814 if (yj.lt.0) yj=yj+boxysize
4816 if (zj.lt.0) zj=zj+boxzsize
4817 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4825 xj=xj_safe+xshift*boxxsize
4826 yj=yj_safe+yshift*boxysize
4827 zj=zj_safe+zshift*boxzsize
4828 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4829 if(dist_temp.lt.dist_init) then
4839 if (subchap.eq.1) then
4852 rij=xj*xj+yj*yj+zj*zj
4856 if (rij.lt.r0ijsq) then
4857 evdwij=0.25d0*(rij-r0ijsq)**2
4865 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4870 cgrad if (j.lt.i) then
4871 cd write (iout,*) 'j<i'
4872 C Uncomment following three lines for SC-p interactions
4874 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4877 cd write (iout,*) 'j>i'
4879 cgrad ggg(k)=-ggg(k)
4880 C Uncomment following line for SC-p interactions
4881 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4885 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4887 cgrad kstart=min0(i+1,j)
4888 cgrad kend=max0(i-1,j-1)
4889 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4890 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4891 cgrad do k=kstart,kend
4893 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4897 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4898 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4909 C-----------------------------------------------------------------------------
4910 subroutine escp(evdw2,evdw2_14)
4912 C This subroutine calculates the excluded-volume interaction energy between
4913 C peptide-group centers and side chains and its gradient in virtual-bond and
4914 C side-chain vectors.
4916 implicit real*8 (a-h,o-z)
4917 include 'DIMENSIONS'
4918 include 'COMMON.GEO'
4919 include 'COMMON.VAR'
4920 include 'COMMON.LOCAL'
4921 include 'COMMON.CHAIN'
4922 include 'COMMON.DERIV'
4923 include 'COMMON.INTERACT'
4924 include 'COMMON.FFIELD'
4925 include 'COMMON.IOUNITS'
4926 include 'COMMON.CONTROL'
4927 include 'COMMON.SPLITELE'
4931 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4932 cd print '(a)','Enter ESCP'
4933 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4937 do i=iatscp_s,iatscp_e
4938 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4940 xi=0.5D0*(c(1,i)+c(1,i+1))
4941 yi=0.5D0*(c(2,i)+c(2,i+1))
4942 zi=0.5D0*(c(3,i)+c(3,i+1))
4944 if (xi.lt.0) xi=xi+boxxsize
4946 if (yi.lt.0) yi=yi+boxysize
4948 if (zi.lt.0) zi=zi+boxzsize
4949 c xi=xi+xshift*boxxsize
4950 c yi=yi+yshift*boxysize
4951 c zi=zi+zshift*boxzsize
4952 c print *,xi,yi,zi,'polozenie i'
4953 C Return atom into box, boxxsize is size of box in x dimension
4955 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4956 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4957 C Condition for being inside the proper box
4958 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4959 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4963 c print *,xi,boxxsize,"pierwszy"
4965 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4966 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4967 C Condition for being inside the proper box
4968 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4969 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4973 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4974 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4975 C Condition for being inside the proper box
4976 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4977 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4980 do iint=1,nscp_gr(i)
4982 do j=iscpstart(i,iint),iscpend(i,iint)
4983 itypj=iabs(itype(j))
4984 if (itypj.eq.ntyp1) cycle
4985 C Uncomment following three lines for SC-p interactions
4989 C Uncomment following three lines for Ca-p interactions
4994 if (xj.lt.0) xj=xj+boxxsize
4996 if (yj.lt.0) yj=yj+boxysize
4998 if (zj.lt.0) zj=zj+boxzsize
5000 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5001 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5002 C Condition for being inside the proper box
5003 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5004 c & (xj.lt.((-0.5d0)*boxxsize))) then
5008 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5009 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5010 cC Condition for being inside the proper box
5011 c if ((yj.gt.((0.5d0)*boxysize)).or.
5012 c & (yj.lt.((-0.5d0)*boxysize))) then
5016 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5017 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5018 C Condition for being inside the proper box
5019 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5020 c & (zj.lt.((-0.5d0)*boxzsize))) then
5023 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5024 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5032 xj=xj_safe+xshift*boxxsize
5033 yj=yj_safe+yshift*boxysize
5034 zj=zj_safe+zshift*boxzsize
5035 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5036 if(dist_temp.lt.dist_init) then
5046 if (subchap.eq.1) then
5055 c print *,xj,yj,zj,'polozenie j'
5056 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5058 sss=sscale(1.0d0/(dsqrt(rrij)))
5059 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5060 c if (sss.eq.0) print *,'czasem jest OK'
5061 if (sss.le.0.0d0) cycle
5062 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5064 e1=fac*fac*aad(itypj,iteli)
5065 e2=fac*bad(itypj,iteli)
5066 if (iabs(j-i) .le. 2) then
5069 evdw2_14=evdw2_14+(e1+e2)*sss
5072 evdw2=evdw2+evdwij*sss
5073 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5074 & 'evdw2',i,j,evdwij
5075 c & ,iteli,itypj,fac,aad(itypj,iteli),bad(itypj,iteli)
5077 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5079 fac=-(evdwij+e1)*rrij*sss
5080 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5084 cgrad if (j.lt.i) then
5085 cd write (iout,*) 'j<i'
5086 C Uncomment following three lines for SC-p interactions
5088 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5091 cd write (iout,*) 'j>i'
5093 cgrad ggg(k)=-ggg(k)
5094 C Uncomment following line for SC-p interactions
5095 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5096 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5100 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5102 cgrad kstart=min0(i+1,j)
5103 cgrad kend=max0(i-1,j-1)
5104 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5105 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5106 cgrad do k=kstart,kend
5108 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5112 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5113 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5115 c endif !endif for sscale cutoff
5125 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5126 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5127 gradx_scp(j,i)=expon*gradx_scp(j,i)
5130 C******************************************************************************
5134 C To save time the factor EXPON has been extracted from ALL components
5135 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5138 C******************************************************************************
5141 C--------------------------------------------------------------------------
5142 subroutine edis(ehpb)
5144 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5146 implicit real*8 (a-h,o-z)
5147 include 'DIMENSIONS'
5148 include 'COMMON.SBRIDGE'
5149 include 'COMMON.CHAIN'
5150 include 'COMMON.DERIV'
5151 include 'COMMON.VAR'
5152 include 'COMMON.INTERACT'
5153 include 'COMMON.IOUNITS'
5156 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5157 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5158 if (link_end.eq.0) return
5159 do i=link_start,link_end
5160 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5161 C CA-CA distance used in regularization of structure.
5164 C iii and jjj point to the residues for which the distance is assigned.
5165 if (ii.gt.nres) then
5172 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5173 c & dhpb(i),dhpb1(i),forcon(i)
5174 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5175 C distance and angle dependent SS bond potential.
5176 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5177 C & iabs(itype(jjj)).eq.1) then
5178 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5179 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5180 if (.not.dyn_ss .and. i.le.nss) then
5181 C 15/02/13 CC dynamic SSbond - additional check
5183 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5184 call ssbond_ene(iii,jjj,eij)
5187 cd write (iout,*) "eij",eij
5189 C Calculate the distance between the two points and its difference from the
5193 C Get the force constant corresponding to this distance.
5195 C Calculate the contribution to energy.
5196 ehpb=ehpb+waga*rdis*rdis
5198 C Evaluate gradient.
5201 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
5202 cd & ' waga=',waga,' fac=',fac
5204 ggg(j)=fac*(c(j,jj)-c(j,ii))
5206 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5207 C If this is a SC-SC distance, we need to calculate the contributions to the
5208 C Cartesian gradient in the SC vectors (ghpbx).
5211 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5212 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5215 cgrad do j=iii,jjj-1
5217 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5221 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5222 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5229 C--------------------------------------------------------------------------
5230 subroutine ssbond_ene(i,j,eij)
5232 C Calculate the distance and angle dependent SS-bond potential energy
5233 C using a free-energy function derived based on RHF/6-31G** ab initio
5234 C calculations of diethyl disulfide.
5236 C A. Liwo and U. Kozlowska, 11/24/03
5238 implicit real*8 (a-h,o-z)
5239 include 'DIMENSIONS'
5240 include 'COMMON.SBRIDGE'
5241 include 'COMMON.CHAIN'
5242 include 'COMMON.DERIV'
5243 include 'COMMON.LOCAL'
5244 include 'COMMON.INTERACT'
5245 include 'COMMON.VAR'
5246 include 'COMMON.IOUNITS'
5247 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5248 itypi=iabs(itype(i))
5252 dxi=dc_norm(1,nres+i)
5253 dyi=dc_norm(2,nres+i)
5254 dzi=dc_norm(3,nres+i)
5255 c dsci_inv=dsc_inv(itypi)
5256 dsci_inv=vbld_inv(nres+i)
5257 itypj=iabs(itype(j))
5258 c dscj_inv=dsc_inv(itypj)
5259 dscj_inv=vbld_inv(nres+j)
5263 dxj=dc_norm(1,nres+j)
5264 dyj=dc_norm(2,nres+j)
5265 dzj=dc_norm(3,nres+j)
5266 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5271 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5272 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5273 om12=dxi*dxj+dyi*dyj+dzi*dzj
5275 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5276 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5282 deltat12=om2-om1+2.0d0
5284 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5285 & +akct*deltad*deltat12
5286 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5287 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5288 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5289 c & " deltat12",deltat12," eij",eij
5290 ed=2*akcm*deltad+akct*deltat12
5292 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5293 eom1=-2*akth*deltat1-pom1-om2*pom2
5294 eom2= 2*akth*deltat2+pom1-om1*pom2
5297 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5298 ghpbx(k,i)=ghpbx(k,i)-ggk
5299 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5300 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5301 ghpbx(k,j)=ghpbx(k,j)+ggk
5302 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5303 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5304 ghpbc(k,i)=ghpbc(k,i)-ggk
5305 ghpbc(k,j)=ghpbc(k,j)+ggk
5308 C Calculate the components of the gradient in DC and X
5312 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5317 C--------------------------------------------------------------------------
5318 subroutine ebond(estr)
5320 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5322 implicit real*8 (a-h,o-z)
5323 include 'DIMENSIONS'
5324 include 'COMMON.LOCAL'
5325 include 'COMMON.GEO'
5326 include 'COMMON.INTERACT'
5327 include 'COMMON.DERIV'
5328 include 'COMMON.VAR'
5329 include 'COMMON.CHAIN'
5330 include 'COMMON.IOUNITS'
5331 include 'COMMON.NAMES'
5332 include 'COMMON.FFIELD'
5333 include 'COMMON.CONTROL'
5334 include 'COMMON.SETUP'
5335 double precision u(3),ud(3)
5338 do i=ibondp_start,ibondp_end
5339 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5340 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5342 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5343 c & *dc(j,i-1)/vbld(i)
5345 c if (energy_dec) write(iout,*)
5346 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5348 C Checking if it involves dummy (NH3+ or COO-) group
5349 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5350 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5351 diff = vbld(i)-vbldpDUM
5353 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5354 diff = vbld(i)-vbldp0
5356 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5357 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5360 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5362 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5365 estr=0.5d0*AKP*estr+estr1
5367 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5369 do i=ibond_start,ibond_end
5371 if (iti.ne.10 .and. iti.ne.ntyp1) then
5374 diff=vbld(i+nres)-vbldsc0(1,iti)
5375 if (energy_dec) write (iout,*)
5376 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5377 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5378 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5380 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5384 diff=vbld(i+nres)-vbldsc0(j,iti)
5385 ud(j)=aksc(j,iti)*diff
5386 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5400 uprod2=uprod2*u(k)*u(k)
5404 usumsqder=usumsqder+ud(j)*uprod2
5406 estr=estr+uprod/usum
5408 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5416 C--------------------------------------------------------------------------
5417 subroutine ebend(etheta)
5419 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5420 C angles gamma and its derivatives in consecutive thetas and gammas.
5422 implicit real*8 (a-h,o-z)
5423 include 'DIMENSIONS'
5424 include 'COMMON.LOCAL'
5425 include 'COMMON.GEO'
5426 include 'COMMON.INTERACT'
5427 include 'COMMON.DERIV'
5428 include 'COMMON.VAR'
5429 include 'COMMON.CHAIN'
5430 include 'COMMON.IOUNITS'
5431 include 'COMMON.NAMES'
5432 include 'COMMON.FFIELD'
5433 include 'COMMON.CONTROL'
5434 common /calcthet/ term1,term2,termm,diffak,ratak,
5435 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5436 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5437 double precision y(2),z(2)
5439 c time11=dexp(-2*time)
5442 c write (*,'(a,i2)') 'EBEND ICG=',icg
5443 do i=ithet_start,ithet_end
5444 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5445 & .or.itype(i).eq.ntyp1) cycle
5446 C Zero the energy function and its derivative at 0 or pi.
5447 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5449 ichir1=isign(1,itype(i-2))
5450 ichir2=isign(1,itype(i))
5451 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5452 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5453 if (itype(i-1).eq.10) then
5454 itype1=isign(10,itype(i-2))
5455 ichir11=isign(1,itype(i-2))
5456 ichir12=isign(1,itype(i-2))
5457 itype2=isign(10,itype(i))
5458 ichir21=isign(1,itype(i))
5459 ichir22=isign(1,itype(i))
5462 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5465 if (phii.ne.phii) phii=150.0
5475 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5478 if (phii1.ne.phii1) phii1=150.0
5490 C Calculate the "mean" value of theta from the part of the distribution
5491 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5492 C In following comments this theta will be referred to as t_c.
5493 thet_pred_mean=0.0d0
5495 athetk=athet(k,it,ichir1,ichir2)
5496 bthetk=bthet(k,it,ichir1,ichir2)
5498 athetk=athet(k,itype1,ichir11,ichir12)
5499 bthetk=bthet(k,itype2,ichir21,ichir22)
5501 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5502 c write(iout,*) 'chuj tu', y(k),z(k)
5504 dthett=thet_pred_mean*ssd
5505 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5506 C Derivatives of the "mean" values in gamma1 and gamma2.
5507 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5508 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5509 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5510 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5512 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5513 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5514 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5515 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5517 if (theta(i).gt.pi-delta) then
5518 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5520 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5521 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5522 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5524 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5526 else if (theta(i).lt.delta) then
5527 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5528 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5529 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5531 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5532 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5535 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5538 etheta=etheta+ethetai
5539 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5540 & 'ebend',i,ethetai,theta(i),itype(i)
5541 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5542 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5543 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5545 C Ufff.... We've done all this!!!
5548 C---------------------------------------------------------------------------
5549 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5551 implicit real*8 (a-h,o-z)
5552 include 'DIMENSIONS'
5553 include 'COMMON.LOCAL'
5554 include 'COMMON.IOUNITS'
5555 common /calcthet/ term1,term2,termm,diffak,ratak,
5556 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5557 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5558 C Calculate the contributions to both Gaussian lobes.
5559 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5560 C The "polynomial part" of the "standard deviation" of this part of
5561 C the distributioni.
5562 ccc write (iout,*) thetai,thet_pred_mean
5565 sig=sig*thet_pred_mean+polthet(j,it)
5567 C Derivative of the "interior part" of the "standard deviation of the"
5568 C gamma-dependent Gaussian lobe in t_c.
5569 sigtc=3*polthet(3,it)
5571 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5574 C Set the parameters of both Gaussian lobes of the distribution.
5575 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5576 fac=sig*sig+sigc0(it)
5579 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5580 sigsqtc=-4.0D0*sigcsq*sigtc
5581 c print *,i,sig,sigtc,sigsqtc
5582 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5583 sigtc=-sigtc/(fac*fac)
5584 C Following variable is sigma(t_c)**(-2)
5585 sigcsq=sigcsq*sigcsq
5587 sig0inv=1.0D0/sig0i**2
5588 delthec=thetai-thet_pred_mean
5589 delthe0=thetai-theta0i
5590 term1=-0.5D0*sigcsq*delthec*delthec
5591 term2=-0.5D0*sig0inv*delthe0*delthe0
5592 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5593 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5594 C NaNs in taking the logarithm. We extract the largest exponent which is added
5595 C to the energy (this being the log of the distribution) at the end of energy
5596 C term evaluation for this virtual-bond angle.
5597 if (term1.gt.term2) then
5599 term2=dexp(term2-termm)
5603 term1=dexp(term1-termm)
5606 C The ratio between the gamma-independent and gamma-dependent lobes of
5607 C the distribution is a Gaussian function of thet_pred_mean too.
5608 diffak=gthet(2,it)-thet_pred_mean
5609 ratak=diffak/gthet(3,it)**2
5610 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5611 C Let's differentiate it in thet_pred_mean NOW.
5613 C Now put together the distribution terms to make complete distribution.
5614 termexp=term1+ak*term2
5615 termpre=sigc+ak*sig0i
5616 C Contribution of the bending energy from this theta is just the -log of
5617 C the sum of the contributions from the two lobes and the pre-exponential
5618 C factor. Simple enough, isn't it?
5619 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5620 C write (iout,*) 'termexp',termexp,termm,termpre,i
5621 C NOW the derivatives!!!
5622 C 6/6/97 Take into account the deformation.
5623 E_theta=(delthec*sigcsq*term1
5624 & +ak*delthe0*sig0inv*term2)/termexp
5625 E_tc=((sigtc+aktc*sig0i)/termpre
5626 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5627 & aktc*term2)/termexp)
5630 c-----------------------------------------------------------------------------
5631 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5632 implicit real*8 (a-h,o-z)
5633 include 'DIMENSIONS'
5634 include 'COMMON.LOCAL'
5635 include 'COMMON.IOUNITS'
5636 common /calcthet/ term1,term2,termm,diffak,ratak,
5637 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5638 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5639 delthec=thetai-thet_pred_mean
5640 delthe0=thetai-theta0i
5641 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5642 t3 = thetai-thet_pred_mean
5646 t14 = t12+t6*sigsqtc
5648 t21 = thetai-theta0i
5654 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5655 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5656 & *(-t12*t9-ak*sig0inv*t27)
5660 C--------------------------------------------------------------------------
5661 subroutine ebend(etheta)
5663 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5664 C angles gamma and its derivatives in consecutive thetas and gammas.
5665 C ab initio-derived potentials from
5666 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5668 implicit real*8 (a-h,o-z)
5669 include 'DIMENSIONS'
5670 include 'COMMON.LOCAL'
5671 include 'COMMON.GEO'
5672 include 'COMMON.INTERACT'
5673 include 'COMMON.DERIV'
5674 include 'COMMON.VAR'
5675 include 'COMMON.CHAIN'
5676 include 'COMMON.IOUNITS'
5677 include 'COMMON.NAMES'
5678 include 'COMMON.FFIELD'
5679 include 'COMMON.CONTROL'
5680 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5681 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5682 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5683 & sinph1ph2(maxdouble,maxdouble)
5684 logical lprn /.false./, lprn1 /.false./
5686 do i=ithet_start,ithet_end
5688 c print *,i,itype(i-1),itype(i),itype(i-2)
5689 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1)
5690 & .or.(itype(i).eq.ntyp1)) cycle
5691 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5693 if (iabs(itype(i+1)).eq.20) iblock=2
5694 if (iabs(itype(i+1)).ne.20) iblock=1
5698 theti2=0.5d0*theta(i)
5699 ityp2=ithetyp((itype(i-1)))
5701 coskt(k)=dcos(k*theti2)
5702 sinkt(k)=dsin(k*theti2)
5704 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5707 if (phii.ne.phii) phii=150.0
5711 ityp1=ithetyp((itype(i-2)))
5712 C propagation of chirality for glycine type
5714 cosph1(k)=dcos(k*phii)
5715 sinph1(k)=dsin(k*phii)
5725 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5728 if (phii1.ne.phii1) phii1=150.0
5733 ityp3=ithetyp((itype(i)))
5735 cosph2(k)=dcos(k*phii1)
5736 sinph2(k)=dsin(k*phii1)
5746 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5749 ccl=cosph1(l)*cosph2(k-l)
5750 ssl=sinph1(l)*sinph2(k-l)
5751 scl=sinph1(l)*cosph2(k-l)
5752 csl=cosph1(l)*sinph2(k-l)
5753 cosph1ph2(l,k)=ccl-ssl
5754 cosph1ph2(k,l)=ccl+ssl
5755 sinph1ph2(l,k)=scl+csl
5756 sinph1ph2(k,l)=scl-csl
5760 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5761 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5762 write (iout,*) "coskt and sinkt"
5764 write (iout,*) k,coskt(k),sinkt(k)
5768 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5769 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5772 & write (iout,*) "k",k,"
5773 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5774 & " ethetai",ethetai
5777 write (iout,*) "cosph and sinph"
5779 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5781 write (iout,*) "cosph1ph2 and sinph2ph2"
5784 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5785 & sinph1ph2(l,k),sinph1ph2(k,l)
5788 write(iout,*) "ethetai",ethetai
5792 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5793 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5794 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5795 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5796 ethetai=ethetai+sinkt(m)*aux
5797 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5798 dephii=dephii+k*sinkt(m)*(
5799 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5800 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5801 dephii1=dephii1+k*sinkt(m)*(
5802 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5803 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5805 & write (iout,*) "m",m," k",k," bbthet",
5806 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5807 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5808 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5809 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5813 & write(iout,*) "ethetai",ethetai
5817 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5818 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5819 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5820 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5821 ethetai=ethetai+sinkt(m)*aux
5822 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5823 dephii=dephii+l*sinkt(m)*(
5824 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5825 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5826 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5827 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5828 dephii1=dephii1+(k-l)*sinkt(m)*(
5829 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5830 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5831 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5832 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5834 write (iout,*) "m",m," k",k," l",l," ffthet",
5835 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5836 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5837 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5838 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5839 & " ethetai",ethetai
5840 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5841 & cosph1ph2(k,l)*sinkt(m),
5842 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5850 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5851 & i,theta(i)*rad2deg,phii*rad2deg,
5852 & phii1*rad2deg,ethetai
5854 etheta=etheta+ethetai
5855 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5857 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5858 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5859 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
5865 c-----------------------------------------------------------------------------
5866 subroutine esc(escloc)
5867 C Calculate the local energy of a side chain and its derivatives in the
5868 C corresponding virtual-bond valence angles THETA and the spherical angles
5870 implicit real*8 (a-h,o-z)
5871 include 'DIMENSIONS'
5872 include 'COMMON.GEO'
5873 include 'COMMON.LOCAL'
5874 include 'COMMON.VAR'
5875 include 'COMMON.INTERACT'
5876 include 'COMMON.DERIV'
5877 include 'COMMON.CHAIN'
5878 include 'COMMON.IOUNITS'
5879 include 'COMMON.NAMES'
5880 include 'COMMON.FFIELD'
5881 include 'COMMON.CONTROL'
5882 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5883 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5884 common /sccalc/ time11,time12,time112,theti,it,nlobit
5887 c write (iout,'(a)') 'ESC'
5888 do i=loc_start,loc_end
5890 if (it.eq.ntyp1) cycle
5891 if (it.eq.10) goto 1
5892 nlobit=nlob(iabs(it))
5893 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5894 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5895 theti=theta(i+1)-pipol
5900 if (x(2).gt.pi-delta) then
5904 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5906 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5907 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5909 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5910 & ddersc0(1),dersc(1))
5911 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5912 & ddersc0(3),dersc(3))
5914 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5916 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5917 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5918 & dersc0(2),esclocbi,dersc02)
5919 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5921 call splinthet(x(2),0.5d0*delta,ss,ssd)
5926 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5928 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5929 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5931 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5933 c write (iout,*) escloci
5934 else if (x(2).lt.delta) then
5938 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5940 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5941 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5943 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5944 & ddersc0(1),dersc(1))
5945 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5946 & ddersc0(3),dersc(3))
5948 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5950 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5951 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5952 & dersc0(2),esclocbi,dersc02)
5953 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5958 call splinthet(x(2),0.5d0*delta,ss,ssd)
5960 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5962 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5963 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5965 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5966 c write (iout,*) escloci
5968 call enesc(x,escloci,dersc,ddummy,.false.)
5971 escloc=escloc+escloci
5972 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5973 & 'escloc',i,escloci
5974 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5976 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5978 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5979 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5984 C---------------------------------------------------------------------------
5985 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5986 implicit real*8 (a-h,o-z)
5987 include 'DIMENSIONS'
5988 include 'COMMON.GEO'
5989 include 'COMMON.LOCAL'
5990 include 'COMMON.IOUNITS'
5991 common /sccalc/ time11,time12,time112,theti,it,nlobit
5992 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5993 double precision contr(maxlob,-1:1)
5995 c write (iout,*) 'it=',it,' nlobit=',nlobit
5999 if (mixed) ddersc(j)=0.0d0
6003 C Because of periodicity of the dependence of the SC energy in omega we have
6004 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6005 C To avoid underflows, first compute & store the exponents.
6013 z(k)=x(k)-censc(k,j,it)
6018 Axk=Axk+gaussc(l,k,j,it)*z(l)
6024 expfac=expfac+Ax(k,j,iii)*z(k)
6032 C As in the case of ebend, we want to avoid underflows in exponentiation and
6033 C subsequent NaNs and INFs in energy calculation.
6034 C Find the largest exponent
6038 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6042 cd print *,'it=',it,' emin=',emin
6044 C Compute the contribution to SC energy and derivatives
6049 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6050 if(adexp.ne.adexp) adexp=1.0
6053 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6055 cd print *,'j=',j,' expfac=',expfac
6056 escloc_i=escloc_i+expfac
6058 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6062 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6063 & +gaussc(k,2,j,it))*expfac
6070 dersc(1)=dersc(1)/cos(theti)**2
6071 ddersc(1)=ddersc(1)/cos(theti)**2
6074 escloci=-(dlog(escloc_i)-emin)
6076 dersc(j)=dersc(j)/escloc_i
6080 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6085 C------------------------------------------------------------------------------
6086 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6087 implicit real*8 (a-h,o-z)
6088 include 'DIMENSIONS'
6089 include 'COMMON.GEO'
6090 include 'COMMON.LOCAL'
6091 include 'COMMON.IOUNITS'
6092 common /sccalc/ time11,time12,time112,theti,it,nlobit
6093 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6094 double precision contr(maxlob)
6105 z(k)=x(k)-censc(k,j,it)
6111 Axk=Axk+gaussc(l,k,j,it)*z(l)
6117 expfac=expfac+Ax(k,j)*z(k)
6122 C As in the case of ebend, we want to avoid underflows in exponentiation and
6123 C subsequent NaNs and INFs in energy calculation.
6124 C Find the largest exponent
6127 if (emin.gt.contr(j)) emin=contr(j)
6131 C Compute the contribution to SC energy and derivatives
6135 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6136 escloc_i=escloc_i+expfac
6138 dersc(k)=dersc(k)+Ax(k,j)*expfac
6140 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6141 & +gaussc(1,2,j,it))*expfac
6145 dersc(1)=dersc(1)/cos(theti)**2
6146 dersc12=dersc12/cos(theti)**2
6147 escloci=-(dlog(escloc_i)-emin)
6149 dersc(j)=dersc(j)/escloc_i
6151 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6155 c----------------------------------------------------------------------------------
6156 subroutine esc(escloc)
6157 C Calculate the local energy of a side chain and its derivatives in the
6158 C corresponding virtual-bond valence angles THETA and the spherical angles
6159 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6160 C added by Urszula Kozlowska. 07/11/2007
6162 implicit real*8 (a-h,o-z)
6163 include 'DIMENSIONS'
6164 include 'COMMON.GEO'
6165 include 'COMMON.LOCAL'
6166 include 'COMMON.VAR'
6167 include 'COMMON.SCROT'
6168 include 'COMMON.INTERACT'
6169 include 'COMMON.DERIV'
6170 include 'COMMON.CHAIN'
6171 include 'COMMON.IOUNITS'
6172 include 'COMMON.NAMES'
6173 include 'COMMON.FFIELD'
6174 include 'COMMON.CONTROL'
6175 include 'COMMON.VECTORS'
6176 double precision x_prime(3),y_prime(3),z_prime(3)
6177 & , sumene,dsc_i,dp2_i,x(65),
6178 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6179 & de_dxx,de_dyy,de_dzz,de_dt
6180 double precision s1_t,s1_6_t,s2_t,s2_6_t
6182 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6183 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6184 & dt_dCi(3),dt_dCi1(3)
6185 common /sccalc/ time11,time12,time112,theti,it,nlobit
6188 do i=loc_start,loc_end
6189 if (itype(i).eq.ntyp1) cycle
6190 costtab(i+1) =dcos(theta(i+1))
6191 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6192 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6193 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6194 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6195 cosfac=dsqrt(cosfac2)
6196 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6197 sinfac=dsqrt(sinfac2)
6199 if (it.eq.10) goto 1
6201 C Compute the axes of tghe local cartesian coordinates system; store in
6202 c x_prime, y_prime and z_prime
6209 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6210 C & dc_norm(3,i+nres)
6212 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6213 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6216 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6219 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6220 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6221 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6222 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6223 c & " xy",scalar(x_prime(1),y_prime(1)),
6224 c & " xz",scalar(x_prime(1),z_prime(1)),
6225 c & " yy",scalar(y_prime(1),y_prime(1)),
6226 c & " yz",scalar(y_prime(1),z_prime(1)),
6227 c & " zz",scalar(z_prime(1),z_prime(1))
6229 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6230 C to local coordinate system. Store in xx, yy, zz.
6236 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6237 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6238 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6245 C Compute the energy of the ith side cbain
6247 c write (2,*) "xx",xx," yy",yy," zz",zz
6250 x(j) = sc_parmin(j,it)
6253 Cc diagnostics - remove later
6255 yy1 = dsin(alph(2))*dcos(omeg(2))
6256 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6257 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6258 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6260 C," --- ", xx_w,yy_w,zz_w
6263 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6264 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6266 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6267 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6269 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6270 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6271 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6272 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6273 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6275 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6276 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6277 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6278 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6279 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6281 dsc_i = 0.743d0+x(61)
6283 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6284 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6285 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6286 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6287 s1=(1+x(63))/(0.1d0 + dscp1)
6288 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6289 s2=(1+x(65))/(0.1d0 + dscp2)
6290 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6291 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6292 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6293 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6295 c & dscp1,dscp2,sumene
6296 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6297 escloc = escloc + sumene
6298 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6303 C This section to check the numerical derivatives of the energy of ith side
6304 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6305 C #define DEBUG in the code to turn it on.
6307 write (2,*) "sumene =",sumene
6311 write (2,*) xx,yy,zz
6312 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6313 de_dxx_num=(sumenep-sumene)/aincr
6315 write (2,*) "xx+ sumene from enesc=",sumenep
6318 write (2,*) xx,yy,zz
6319 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6320 de_dyy_num=(sumenep-sumene)/aincr
6322 write (2,*) "yy+ sumene from enesc=",sumenep
6325 write (2,*) xx,yy,zz
6326 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6327 de_dzz_num=(sumenep-sumene)/aincr
6329 write (2,*) "zz+ sumene from enesc=",sumenep
6330 costsave=cost2tab(i+1)
6331 sintsave=sint2tab(i+1)
6332 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6333 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6334 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6335 de_dt_num=(sumenep-sumene)/aincr
6336 write (2,*) " t+ sumene from enesc=",sumenep
6337 cost2tab(i+1)=costsave
6338 sint2tab(i+1)=sintsave
6339 C End of diagnostics section.
6342 C Compute the gradient of esc
6344 c zz=zz*dsign(1.0,dfloat(itype(i)))
6345 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6346 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6347 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6348 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6349 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6350 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6351 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6352 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6353 pom1=(sumene3*sint2tab(i+1)+sumene1)
6354 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6355 pom2=(sumene4*cost2tab(i+1)+sumene2)
6356 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6357 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6358 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6359 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6361 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6362 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6363 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6365 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6366 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6367 & +(pom1+pom2)*pom_dx
6369 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6372 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6373 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6374 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6376 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6377 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6378 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6379 & +x(59)*zz**2 +x(60)*xx*zz
6380 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6381 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6382 & +(pom1-pom2)*pom_dy
6384 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6387 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6388 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6389 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6390 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6391 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6392 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6393 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6394 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6396 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6399 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6400 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6401 & +pom1*pom_dt1+pom2*pom_dt2
6403 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6408 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6409 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6410 cosfac2xx=cosfac2*xx
6411 sinfac2yy=sinfac2*yy
6413 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6415 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6417 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6418 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6419 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6420 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6421 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6422 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6423 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6424 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6425 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6426 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6430 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6431 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6432 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6433 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6436 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6437 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6438 dZZ_XYZ(k)=vbld_inv(i+nres)*
6439 & (z_prime(k)-zz*dC_norm(k,i+nres))
6441 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6442 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6446 dXX_Ctab(k,i)=dXX_Ci(k)
6447 dXX_C1tab(k,i)=dXX_Ci1(k)
6448 dYY_Ctab(k,i)=dYY_Ci(k)
6449 dYY_C1tab(k,i)=dYY_Ci1(k)
6450 dZZ_Ctab(k,i)=dZZ_Ci(k)
6451 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6452 dXX_XYZtab(k,i)=dXX_XYZ(k)
6453 dYY_XYZtab(k,i)=dYY_XYZ(k)
6454 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6458 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6459 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6460 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6461 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6462 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6464 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6465 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6466 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6467 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6468 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6469 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6470 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6471 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6473 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6474 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6476 C to check gradient call subroutine check_grad
6482 c------------------------------------------------------------------------------
6483 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6485 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6486 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6487 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6488 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6490 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6491 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6493 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6494 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6495 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6496 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6497 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6499 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6500 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6501 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6502 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6503 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6505 dsc_i = 0.743d0+x(61)
6507 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6508 & *(xx*cost2+yy*sint2))
6509 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6510 & *(xx*cost2-yy*sint2))
6511 s1=(1+x(63))/(0.1d0 + dscp1)
6512 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6513 s2=(1+x(65))/(0.1d0 + dscp2)
6514 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6515 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6516 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6521 c------------------------------------------------------------------------------
6522 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6524 C This procedure calculates two-body contact function g(rij) and its derivative:
6527 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6530 C where x=(rij-r0ij)/delta
6532 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6535 double precision rij,r0ij,eps0ij,fcont,fprimcont
6536 double precision x,x2,x4,delta
6540 if (x.lt.-1.0D0) then
6543 else if (x.le.1.0D0) then
6546 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6547 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6554 c------------------------------------------------------------------------------
6555 subroutine splinthet(theti,delta,ss,ssder)
6556 implicit real*8 (a-h,o-z)
6557 include 'DIMENSIONS'
6558 include 'COMMON.VAR'
6559 include 'COMMON.GEO'
6562 if (theti.gt.pipol) then
6563 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6565 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6570 c------------------------------------------------------------------------------
6571 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6573 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6574 double precision ksi,ksi2,ksi3,a1,a2,a3
6575 a1=fprim0*delta/(f1-f0)
6581 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6582 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6585 c------------------------------------------------------------------------------
6586 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6588 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6589 double precision ksi,ksi2,ksi3,a1,a2,a3
6594 a2=3*(f1x-f0x)-2*fprim0x*delta
6595 a3=fprim0x*delta-2*(f1x-f0x)
6596 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6599 C-----------------------------------------------------------------------------
6601 C-----------------------------------------------------------------------------
6602 subroutine etor(etors,edihcnstr)
6603 implicit real*8 (a-h,o-z)
6604 include 'DIMENSIONS'
6605 include 'COMMON.VAR'
6606 include 'COMMON.GEO'
6607 include 'COMMON.LOCAL'
6608 include 'COMMON.TORSION'
6609 include 'COMMON.INTERACT'
6610 include 'COMMON.DERIV'
6611 include 'COMMON.CHAIN'
6612 include 'COMMON.NAMES'
6613 include 'COMMON.IOUNITS'
6614 include 'COMMON.FFIELD'
6615 include 'COMMON.TORCNSTR'
6616 include 'COMMON.CONTROL'
6618 C Set lprn=.true. for debugging
6622 do i=iphi_start,iphi_end
6624 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6625 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6626 itori=itortyp(itype(i-2))
6627 itori1=itortyp(itype(i-1))
6630 C Proline-Proline pair is a special case...
6631 if (itori.eq.3 .and. itori1.eq.3) then
6632 if (phii.gt.-dwapi3) then
6634 fac=1.0D0/(1.0D0-cosphi)
6635 etorsi=v1(1,3,3)*fac
6636 etorsi=etorsi+etorsi
6637 etors=etors+etorsi-v1(1,3,3)
6638 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6639 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6642 v1ij=v1(j+1,itori,itori1)
6643 v2ij=v2(j+1,itori,itori1)
6646 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6647 if (energy_dec) etors_ii=etors_ii+
6648 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6649 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6653 v1ij=v1(j,itori,itori1)
6654 v2ij=v2(j,itori,itori1)
6657 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6658 if (energy_dec) etors_ii=etors_ii+
6659 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6660 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6663 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6666 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6667 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6668 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6669 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6670 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6672 ! 6/20/98 - dihedral angle constraints
6675 itori=idih_constr(i)
6678 if (difi.gt.drange(i)) then
6680 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6681 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6682 else if (difi.lt.-drange(i)) then
6684 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6685 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6687 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6688 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6690 ! write (iout,*) 'edihcnstr',edihcnstr
6693 c------------------------------------------------------------------------------
6694 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
6695 subroutine e_modeller(ehomology_constr)
6696 ehomology_constr=0.0d0
6697 write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
6700 C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
6702 c------------------------------------------------------------------------------
6703 subroutine etor_d(etors_d)
6707 c----------------------------------------------------------------------------
6709 subroutine etor(etors,edihcnstr)
6710 implicit real*8 (a-h,o-z)
6711 include 'DIMENSIONS'
6712 include 'COMMON.VAR'
6713 include 'COMMON.GEO'
6714 include 'COMMON.LOCAL'
6715 include 'COMMON.TORSION'
6716 include 'COMMON.INTERACT'
6717 include 'COMMON.DERIV'
6718 include 'COMMON.CHAIN'
6719 include 'COMMON.NAMES'
6720 include 'COMMON.IOUNITS'
6721 include 'COMMON.FFIELD'
6722 include 'COMMON.TORCNSTR'
6723 include 'COMMON.CONTROL'
6725 C Set lprn=.true. for debugging
6729 do i=iphi_start,iphi_end
6730 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6731 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6732 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6733 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6734 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6735 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6736 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6737 C For introducing the NH3+ and COO- group please check the etor_d for reference
6740 if (iabs(itype(i)).eq.20) then
6745 itori=itortyp(itype(i-2))
6746 itori1=itortyp(itype(i-1))
6749 C Regular cosine and sine terms
6750 do j=1,nterm(itori,itori1,iblock)
6751 v1ij=v1(j,itori,itori1,iblock)
6752 v2ij=v2(j,itori,itori1,iblock)
6755 etors=etors+v1ij*cosphi+v2ij*sinphi
6756 if (energy_dec) etors_ii=etors_ii+
6757 & v1ij*cosphi+v2ij*sinphi
6758 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6762 C E = SUM ----------------------------------- - v1
6763 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6765 cosphi=dcos(0.5d0*phii)
6766 sinphi=dsin(0.5d0*phii)
6767 do j=1,nlor(itori,itori1,iblock)
6768 vl1ij=vlor1(j,itori,itori1)
6769 vl2ij=vlor2(j,itori,itori1)
6770 vl3ij=vlor3(j,itori,itori1)
6771 pom=vl2ij*cosphi+vl3ij*sinphi
6772 pom1=1.0d0/(pom*pom+1.0d0)
6773 etors=etors+vl1ij*pom1
6774 if (energy_dec) etors_ii=etors_ii+
6777 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6779 C Subtract the constant term
6780 etors=etors-v0(itori,itori1,iblock)
6781 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6782 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6784 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6785 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6786 & (v1(j,itori,itori1,iblock),j=1,6),
6787 & (v2(j,itori,itori1,iblock),j=1,6)
6788 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6789 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6791 ! 6/20/98 - dihedral angle constraints
6793 c do i=1,ndih_constr
6794 do i=idihconstr_start,idihconstr_end
6795 itori=idih_constr(i)
6797 difi=pinorm(phii-phi0(i))
6798 if (difi.gt.drange(i)) then
6800 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6801 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6802 else if (difi.lt.-drange(i)) then
6804 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6805 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6809 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6810 cd & rad2deg*phi0(i), rad2deg*drange(i),
6811 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6813 cd write (iout,*) 'edihcnstr',edihcnstr
6816 c----------------------------------------------------------------------------
6817 c MODELLER restraint function
6818 subroutine e_modeller(ehomology_constr)
6819 implicit real*8 (a-h,o-z)
6820 include 'DIMENSIONS'
6822 integer nnn, i, j, k, ki, irec, l
6823 integer katy, odleglosci, test7
6824 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
6826 real*8 distance(max_template),distancek(max_template),
6827 & min_odl,godl(max_template),dih_diff(max_template)
6830 c FP - 30/10/2014 Temporary specifications for homology restraints
6832 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
6834 double precision, dimension (maxres) :: guscdiff,usc_diff
6835 double precision, dimension (max_template) ::
6836 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
6840 include 'COMMON.SBRIDGE'
6841 include 'COMMON.CHAIN'
6842 include 'COMMON.GEO'
6843 include 'COMMON.DERIV'
6844 include 'COMMON.LOCAL'
6845 include 'COMMON.INTERACT'
6846 include 'COMMON.VAR'
6847 include 'COMMON.IOUNITS'
6849 include 'COMMON.CONTROL'
6851 c From subroutine Econstr_back
6853 include 'COMMON.NAMES'
6854 include 'COMMON.TIME1'
6859 distancek(i)=9999999.9
6865 c Pseudo-energy and gradient from homology restraints (MODELLER-like
6867 C AL 5/2/14 - Introduce list of restraints
6868 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
6870 write(iout,*) "------- dist restrs start -------"
6872 do ii = link_start_homo,link_end_homo
6876 c write (iout,*) "dij(",i,j,") =",dij
6877 do k=1,constr_homology
6878 c write(iout,*) ii,k,i,j,l_homo(k,ii),dij,odl(k,ii)
6879 if(.not.l_homo(k,ii)) cycle
6880 distance(k)=odl(k,ii)-dij
6881 c write (iout,*) "distance(",k,") =",distance(k)
6883 c For Gaussian-type Urestr
6885 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
6886 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
6887 c write (iout,*) "distancek(",k,") =",distancek(k)
6888 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
6890 c For Lorentzian-type Urestr
6892 if (waga_dist.lt.0.0d0) then
6893 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
6894 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
6895 & (distance(k)**2+sigma_odlir(k,ii)**2))
6899 c min_odl=minval(distancek)
6900 do kk=1,constr_homology
6901 if(l_homo(kk,ii)) then
6902 min_odl=distancek(kk)
6906 do kk=1,constr_homology
6907 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
6908 & min_odl=distancek(kk)
6911 c write (iout,* )"min_odl",min_odl
6913 write (iout,*) "ij dij",i,j,dij
6914 write (iout,*) "distance",(distance(k),k=1,constr_homology)
6915 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
6916 write (iout,* )"min_odl",min_odl
6919 do k=1,constr_homology
6920 c Nie wiem po co to liczycie jeszcze raz!
6921 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
6922 c & (2*(sigma_odl(i,j,k))**2))
6923 if(.not.l_homo(k,ii)) cycle
6924 if (waga_dist.ge.0.0d0) then
6926 c For Gaussian-type Urestr
6928 godl(k)=dexp(-distancek(k)+min_odl)
6929 odleg2=odleg2+godl(k)
6931 c For Lorentzian-type Urestr
6934 odleg2=odleg2+distancek(k)
6937 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
6938 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
6939 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
6940 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
6943 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6944 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6946 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6947 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6949 if (waga_dist.ge.0.0d0) then
6951 c For Gaussian-type Urestr
6953 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
6955 c For Lorentzian-type Urestr
6958 odleg=odleg+odleg2/constr_homology
6961 c write (iout,*) "odleg",odleg ! sum of -ln-s
6964 c For Gaussian-type Urestr
6966 if (waga_dist.ge.0.0d0) sum_godl=odleg2
6968 do k=1,constr_homology
6969 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6970 c & *waga_dist)+min_odl
6971 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
6973 if(.not.l_homo(k,ii)) cycle
6974 if (waga_dist.ge.0.0d0) then
6975 c For Gaussian-type Urestr
6977 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
6979 c For Lorentzian-type Urestr
6982 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
6983 & sigma_odlir(k,ii)**2)**2)
6985 sum_sgodl=sum_sgodl+sgodl
6987 c sgodl2=sgodl2+sgodl
6988 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
6989 c write(iout,*) "constr_homology=",constr_homology
6990 c write(iout,*) i, j, k, "TEST K"
6992 if (waga_dist.ge.0.0d0) then
6994 c For Gaussian-type Urestr
6996 grad_odl3=waga_homology(iset)*waga_dist
6997 & *sum_sgodl/(sum_godl*dij)
6999 c For Lorentzian-type Urestr
7002 c Original grad expr modified by analogy w Gaussian-type Urestr grad
7003 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
7004 grad_odl3=-waga_homology(iset)*waga_dist*
7005 & sum_sgodl/(constr_homology*dij)
7008 c grad_odl3=sum_sgodl/(sum_godl*dij)
7011 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
7012 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
7013 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
7015 ccc write(iout,*) godl, sgodl, grad_odl3
7017 c grad_odl=grad_odl+grad_odl3
7020 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
7021 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
7022 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
7023 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
7024 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
7025 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
7026 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
7027 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
7028 c if (i.eq.25.and.j.eq.27) then
7029 c write(iout,*) "jik",jik,"i",i,"j",j
7030 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
7031 c write(iout,*) "grad_odl3",grad_odl3
7032 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
7033 c write(iout,*) "ggodl",ggodl
7034 c write(iout,*) "ghpbc(",jik,i,")",
7035 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
7039 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
7040 ccc & dLOG(odleg2),"-odleg=", -odleg
7042 enddo ! ii-loop for dist
7044 write(iout,*) "------- dist restrs end -------"
7045 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
7046 c & waga_d.eq.1.0d0) call sum_gradient
7048 c Pseudo-energy and gradient from dihedral-angle restraints from
7049 c homology templates
7050 c write (iout,*) "End of distance loop"
7053 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
7055 write(iout,*) "------- dih restrs start -------"
7056 do i=idihconstr_start_homo,idihconstr_end_homo
7057 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
7060 do i=idihconstr_start_homo,idihconstr_end_homo
7062 c betai=beta(i,i+1,i+2,i+3)
7064 c write (iout,*) "betai =",betai
7065 do k=1,constr_homology
7066 dih_diff(k)=pinorm(dih(k,i)-betai)
7067 cd write (iout,'(a8,2i4,2f15.8)') "dih_diff",i,k,dih_diff(k)
7068 cd & ,sigma_dih(k,i)
7069 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
7070 c & -(6.28318-dih_diff(i,k))
7071 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
7072 c & 6.28318+dih_diff(i,k)
7074 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
7075 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
7078 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
7081 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
7082 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
7084 write (iout,*) "i",i," betai",betai," kat2",kat2
7085 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
7087 if (kat2.le.1.0d-14) cycle
7088 kat=kat-dLOG(kat2/constr_homology)
7089 c write (iout,*) "kat",kat ! sum of -ln-s
7091 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
7092 ccc & dLOG(kat2), "-kat=", -kat
7094 c ----------------------------------------------------------------------
7096 c ----------------------------------------------------------------------
7100 do k=1,constr_homology
7101 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
7102 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
7103 sum_sgdih=sum_sgdih+sgdih
7105 c grad_dih3=sum_sgdih/sum_gdih
7106 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
7108 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
7109 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
7110 ccc & gloc(nphi+i-3,icg)
7111 gloc(i,icg)=gloc(i,icg)+grad_dih3
7113 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
7115 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
7116 ccc & gloc(nphi+i-3,icg)
7118 enddo ! i-loop for dih
7120 write(iout,*) "------- dih restrs end -------"
7123 c Pseudo-energy and gradient for theta angle restraints from
7124 c homology templates
7125 c FP 01/15 - inserted from econstr_local_test.F, loop structure
7129 c For constr_homology reference structures (FP)
7131 c Uconst_back_tot=0.0d0
7134 c Econstr_back legacy
7136 c do i=ithet_start,ithet_end
7139 c do i=loc_start,loc_end
7142 duscdiffx(j,i)=0.0d0
7147 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
7148 c write (iout,*) "waga_theta",waga_theta
7149 if (waga_theta.gt.0.0d0) then
7151 write (iout,*) "usampl",usampl
7152 write(iout,*) "------- theta restrs start -------"
7153 c do i=ithet_start,ithet_end
7154 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
7157 c write (iout,*) "maxres",maxres,"nres",nres
7159 do i=ithet_start,ithet_end
7162 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
7164 c Deviation of theta angles wrt constr_homology ref structures
7166 utheta_i=0.0d0 ! argument of Gaussian for single k
7167 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
7168 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
7169 c over residues in a fragment
7170 c write (iout,*) "theta(",i,")=",theta(i)
7171 do k=1,constr_homology
7173 c dtheta_i=theta(j)-thetaref(j,iref)
7174 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
7175 theta_diff(k)=thetatpl(k,i)-theta(i)
7176 cd write (iout,'(a8,2i4,2f15.8)') "theta_diff",i,k,theta_diff(k)
7177 cd & ,sigma_theta(k,i)
7180 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
7181 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
7182 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
7183 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
7184 c Gradient for single Gaussian restraint in subr Econstr_back
7185 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
7188 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
7189 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
7192 c Gradient for multiple Gaussian restraint
7193 sum_gtheta=gutheta_i
7195 do k=1,constr_homology
7196 c New generalized expr for multiple Gaussian from Econstr_back
7197 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
7199 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
7200 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
7202 c Final value of gradient using same var as in Econstr_back
7203 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)
7204 & +sum_sgtheta/sum_gtheta*waga_theta
7205 & *waga_homology(iset)
7206 c dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
7207 c & *waga_homology(iset)
7208 c dutheta(i)=sum_sgtheta/sum_gtheta
7210 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
7211 Eval=Eval-dLOG(gutheta_i/constr_homology)
7212 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
7213 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
7214 c Uconst_back=Uconst_back+utheta(i)
7215 enddo ! (i-loop for theta)
7217 write(iout,*) "------- theta restrs end -------"
7221 c Deviation of local SC geometry
7223 c Separation of two i-loops (instructed by AL - 11/3/2014)
7225 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
7226 c write (iout,*) "waga_d",waga_d
7229 write(iout,*) "------- SC restrs start -------"
7230 write (iout,*) "Initial duscdiff,duscdiffx"
7231 do i=loc_start,loc_end
7232 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
7233 & (duscdiffx(jik,i),jik=1,3)
7236 do i=loc_start,loc_end
7237 usc_diff_i=0.0d0 ! argument of Gaussian for single k
7238 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
7239 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
7240 c write(iout,*) "xxtab, yytab, zztab"
7241 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
7242 do k=1,constr_homology
7244 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
7245 c Original sign inverted for calc of gradients (s. Econstr_back)
7246 dyy=-yytpl(k,i)+yytab(i) ! ibid y
7247 dzz=-zztpl(k,i)+zztab(i) ! ibid z
7248 c write(iout,*) "dxx, dyy, dzz"
7249 cd write(iout,'(2i5,4f8.2)') k,i,dxx,dyy,dzz,sigma_d(k,i)
7251 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
7252 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
7253 c uscdiffk(k)=usc_diff(i)
7254 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
7255 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
7256 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
7257 c & xxref(j),yyref(j),zzref(j)
7262 c Generalized expression for multiple Gaussian acc to that for a single
7263 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
7265 c Original implementation
7266 c sum_guscdiff=guscdiff(i)
7268 c sum_sguscdiff=0.0d0
7269 c do k=1,constr_homology
7270 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
7271 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
7272 c sum_sguscdiff=sum_sguscdiff+sguscdiff
7275 c Implementation of new expressions for gradient (Jan. 2015)
7277 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
7278 do k=1,constr_homology
7280 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
7281 c before. Now the drivatives should be correct
7283 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
7284 c Original sign inverted for calc of gradients (s. Econstr_back)
7285 dyy=-yytpl(k,i)+yytab(i) ! ibid y
7286 dzz=-zztpl(k,i)+zztab(i) ! ibid z
7288 c New implementation
7290 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
7291 & sigma_d(k,i) ! for the grad wrt r'
7292 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
7295 c New implementation
7296 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
7298 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
7299 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
7300 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
7301 duscdiff(jik,i)=duscdiff(jik,i)+
7302 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
7303 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
7304 duscdiffx(jik,i)=duscdiffx(jik,i)+
7305 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
7306 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
7309 write(iout,*) "jik",jik,"i",i
7310 write(iout,*) "dxx, dyy, dzz"
7311 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
7312 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
7313 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
7314 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
7315 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
7316 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
7317 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
7318 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
7319 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
7320 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
7321 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
7322 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
7323 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
7324 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
7325 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
7331 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
7332 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
7334 c write (iout,*) i," uscdiff",uscdiff(i)
7336 c Put together deviations from local geometry
7338 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
7339 c & wfrag_back(3,i,iset)*uscdiff(i)
7340 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
7341 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
7342 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
7343 c Uconst_back=Uconst_back+usc_diff(i)
7345 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
7347 c New implment: multiplied by sum_sguscdiff
7350 enddo ! (i-loop for dscdiff)
7355 write(iout,*) "------- SC restrs end -------"
7356 write (iout,*) "------ After SC loop in e_modeller ------"
7357 do i=loc_start,loc_end
7358 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
7359 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
7361 if (waga_theta.eq.1.0d0) then
7362 write (iout,*) "in e_modeller after SC restr end: dutheta"
7363 do i=ithet_start,ithet_end
7364 write (iout,*) i,dutheta(i)
7367 if (waga_d.eq.1.0d0) then
7368 write (iout,*) "e_modeller after SC loop: duscdiff/x"
7370 write (iout,*) i,(duscdiff(j,i),j=1,3)
7371 write (iout,*) i,(duscdiffx(j,i),j=1,3)
7376 c Total energy from homology restraints
7378 write (iout,*) "odleg",odleg," kat",kat
7381 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
7383 c ehomology_constr=odleg+kat
7385 c For Lorentzian-type Urestr
7388 if (waga_dist.ge.0.0d0) then
7390 c For Gaussian-type Urestr
7392 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
7393 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
7394 c write (iout,*) "ehomology_constr=",ehomology_constr
7397 c For Lorentzian-type Urestr
7399 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
7400 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
7401 c write (iout,*) "ehomology_constr=",ehomology_constr
7404 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
7405 & "Eval",waga_theta,eval,
7406 & "Erot",waga_d,Erot
7407 write (iout,*) "ehomology_constr",ehomology_constr
7413 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
7414 747 format(a12,i4,i4,i4,f8.3,f8.3)
7415 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
7416 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
7417 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
7418 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
7421 c------------------------------------------------------------------------------
7422 subroutine etor_d(etors_d)
7423 C 6/23/01 Compute double torsional energy
7424 implicit real*8 (a-h,o-z)
7425 include 'DIMENSIONS'
7426 include 'COMMON.VAR'
7427 include 'COMMON.GEO'
7428 include 'COMMON.LOCAL'
7429 include 'COMMON.TORSION'
7430 include 'COMMON.INTERACT'
7431 include 'COMMON.DERIV'
7432 include 'COMMON.CHAIN'
7433 include 'COMMON.NAMES'
7434 include 'COMMON.IOUNITS'
7435 include 'COMMON.FFIELD'
7436 include 'COMMON.TORCNSTR'
7437 include 'COMMON.CONTROL'
7439 C Set lprn=.true. for debugging
7443 c write(iout,*) "a tu??"
7444 do i=iphid_start,iphid_end
7445 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7446 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7447 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7448 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7449 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7450 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7451 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7452 & (itype(i+1).eq.ntyp1)) cycle
7453 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7455 itori=itortyp(itype(i-2))
7456 itori1=itortyp(itype(i-1))
7457 itori2=itortyp(itype(i))
7463 if (iabs(itype(i+1)).eq.20) iblock=2
7464 C Iblock=2 Proline type
7465 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7466 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7467 C if (itype(i+1).eq.ntyp1) iblock=3
7468 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7469 C IS or IS NOT need for this
7470 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7471 C is (itype(i-3).eq.ntyp1) ntblock=2
7472 C ntblock is N-terminal blocking group
7474 C Regular cosine and sine terms
7475 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7476 C Example of changes for NH3+ blocking group
7477 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7478 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7479 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7480 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7481 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7482 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7483 cosphi1=dcos(j*phii)
7484 sinphi1=dsin(j*phii)
7485 cosphi2=dcos(j*phii1)
7486 sinphi2=dsin(j*phii1)
7487 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7488 & v2cij*cosphi2+v2sij*sinphi2
7489 if (energy_dec) etors_d_ii=etors_d_ii+
7490 & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
7491 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7492 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7494 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7496 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7497 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7498 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7499 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7500 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7501 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7502 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7503 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7504 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7505 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7506 if (energy_dec) etors_d_ii=etors_d_ii+
7507 & v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7508 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7509 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7510 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7511 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7512 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7515 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7516 & 'etor_d',i,etors_d_ii
7517 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7518 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7523 c------------------------------------------------------------------------------
7524 subroutine eback_sc_corr(esccor)
7525 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7526 c conformational states; temporarily implemented as differences
7527 c between UNRES torsional potentials (dependent on three types of
7528 c residues) and the torsional potentials dependent on all 20 types
7529 c of residues computed from AM1 energy surfaces of terminally-blocked
7530 c amino-acid residues.
7531 implicit real*8 (a-h,o-z)
7532 include 'DIMENSIONS'
7533 include 'COMMON.VAR'
7534 include 'COMMON.GEO'
7535 include 'COMMON.LOCAL'
7536 include 'COMMON.TORSION'
7537 include 'COMMON.SCCOR'
7538 include 'COMMON.INTERACT'
7539 include 'COMMON.DERIV'
7540 include 'COMMON.CHAIN'
7541 include 'COMMON.NAMES'
7542 include 'COMMON.IOUNITS'
7543 include 'COMMON.FFIELD'
7544 include 'COMMON.CONTROL'
7546 C Set lprn=.true. for debugging
7549 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7551 do i=itau_start,itau_end
7552 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7554 isccori=isccortyp(itype(i-2))
7555 isccori1=isccortyp(itype(i-1))
7556 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7558 do intertyp=1,3 !intertyp
7559 cc Added 09 May 2012 (Adasko)
7560 cc Intertyp means interaction type of backbone mainchain correlation:
7561 c 1 = SC...Ca...Ca...Ca
7562 c 2 = Ca...Ca...Ca...SC
7563 c 3 = SC...Ca...Ca...SCi
7565 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7566 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7567 & (itype(i-1).eq.ntyp1)))
7568 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7569 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7570 & .or.(itype(i).eq.ntyp1)))
7571 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7572 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7573 & (itype(i-3).eq.ntyp1)))) cycle
7574 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7575 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7577 do j=1,nterm_sccor(isccori,isccori1)
7578 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7579 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7580 cosphi=dcos(j*tauangle(intertyp,i))
7581 sinphi=dsin(j*tauangle(intertyp,i))
7582 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7583 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7585 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7586 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7588 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7589 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
7590 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
7591 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7592 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7598 c----------------------------------------------------------------------------
7599 subroutine multibody(ecorr)
7600 C This subroutine calculates multi-body contributions to energy following
7601 C the idea of Skolnick et al. If side chains I and J make a contact and
7602 C at the same time side chains I+1 and J+1 make a contact, an extra
7603 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7604 implicit real*8 (a-h,o-z)
7605 include 'DIMENSIONS'
7606 include 'COMMON.IOUNITS'
7607 include 'COMMON.DERIV'
7608 include 'COMMON.INTERACT'
7609 include 'COMMON.CONTACTS'
7610 double precision gx(3),gx1(3)
7613 C Set lprn=.true. for debugging
7617 write (iout,'(a)') 'Contact function values:'
7619 write (iout,'(i2,20(1x,i2,f10.5))')
7620 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7635 num_conti=num_cont(i)
7636 num_conti1=num_cont(i1)
7641 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7642 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7643 cd & ' ishift=',ishift
7644 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7645 C The system gains extra energy.
7646 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7647 endif ! j1==j+-ishift
7656 c------------------------------------------------------------------------------
7657 double precision function esccorr(i,j,k,l,jj,kk)
7658 implicit real*8 (a-h,o-z)
7659 include 'DIMENSIONS'
7660 include 'COMMON.IOUNITS'
7661 include 'COMMON.DERIV'
7662 include 'COMMON.INTERACT'
7663 include 'COMMON.CONTACTS'
7664 double precision gx(3),gx1(3)
7669 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7670 C Calculate the multi-body contribution to energy.
7671 C Calculate multi-body contributions to the gradient.
7672 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7673 cd & k,l,(gacont(m,kk,k),m=1,3)
7675 gx(m) =ekl*gacont(m,jj,i)
7676 gx1(m)=eij*gacont(m,kk,k)
7677 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7678 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7679 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7680 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7684 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7689 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7695 c------------------------------------------------------------------------------
7696 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7697 C This subroutine calculates multi-body contributions to hydrogen-bonding
7698 implicit real*8 (a-h,o-z)
7699 include 'DIMENSIONS'
7700 include 'COMMON.IOUNITS'
7703 parameter (max_cont=maxconts)
7704 parameter (max_dim=26)
7705 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7706 double precision zapas(max_dim,maxconts,max_fg_procs),
7707 & zapas_recv(max_dim,maxconts,max_fg_procs)
7708 common /przechowalnia/ zapas
7709 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7710 & status_array(MPI_STATUS_SIZE,maxconts*2)
7712 include 'COMMON.SETUP'
7713 include 'COMMON.FFIELD'
7714 include 'COMMON.DERIV'
7715 include 'COMMON.INTERACT'
7716 include 'COMMON.CONTACTS'
7717 include 'COMMON.CONTROL'
7718 include 'COMMON.LOCAL'
7719 double precision gx(3),gx1(3),time00
7722 C Set lprn=.true. for debugging
7727 if (nfgtasks.le.1) goto 30
7729 write (iout,'(a)') 'Contact function values before RECEIVE:'
7731 write (iout,'(2i3,50(1x,i2,f5.2))')
7732 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7733 & j=1,num_cont_hb(i))
7737 do i=1,ntask_cont_from
7740 do i=1,ntask_cont_to
7743 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7745 C Make the list of contacts to send to send to other procesors
7746 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7748 do i=iturn3_start,iturn3_end
7749 c write (iout,*) "make contact list turn3",i," num_cont",
7751 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7753 do i=iturn4_start,iturn4_end
7754 c write (iout,*) "make contact list turn4",i," num_cont",
7756 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7760 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7762 do j=1,num_cont_hb(i)
7765 iproc=iint_sent_local(k,jjc,ii)
7766 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7767 if (iproc.gt.0) then
7768 ncont_sent(iproc)=ncont_sent(iproc)+1
7769 nn=ncont_sent(iproc)
7771 zapas(2,nn,iproc)=jjc
7772 zapas(3,nn,iproc)=facont_hb(j,i)
7773 zapas(4,nn,iproc)=ees0p(j,i)
7774 zapas(5,nn,iproc)=ees0m(j,i)
7775 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7776 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7777 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7778 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7779 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7780 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7781 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7782 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7783 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7784 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7785 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7786 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7787 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7788 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7789 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7790 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7791 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7792 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7793 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7794 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7795 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7802 & "Numbers of contacts to be sent to other processors",
7803 & (ncont_sent(i),i=1,ntask_cont_to)
7804 write (iout,*) "Contacts sent"
7805 do ii=1,ntask_cont_to
7807 iproc=itask_cont_to(ii)
7808 write (iout,*) nn," contacts to processor",iproc,
7809 & " of CONT_TO_COMM group"
7811 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7819 CorrelID1=nfgtasks+fg_rank+1
7821 C Receive the numbers of needed contacts from other processors
7822 do ii=1,ntask_cont_from
7823 iproc=itask_cont_from(ii)
7825 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7826 & FG_COMM,req(ireq),IERR)
7828 c write (iout,*) "IRECV ended"
7830 C Send the number of contacts needed by other processors
7831 do ii=1,ntask_cont_to
7832 iproc=itask_cont_to(ii)
7834 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7835 & FG_COMM,req(ireq),IERR)
7837 c write (iout,*) "ISEND ended"
7838 c write (iout,*) "number of requests (nn)",ireq
7841 & call MPI_Waitall(ireq,req,status_array,ierr)
7843 c & "Numbers of contacts to be received from other processors",
7844 c & (ncont_recv(i),i=1,ntask_cont_from)
7848 do ii=1,ntask_cont_from
7849 iproc=itask_cont_from(ii)
7851 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7852 c & " of CONT_TO_COMM group"
7856 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7857 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7858 c write (iout,*) "ireq,req",ireq,req(ireq)
7861 C Send the contacts to processors that need them
7862 do ii=1,ntask_cont_to
7863 iproc=itask_cont_to(ii)
7865 c write (iout,*) nn," contacts to processor",iproc,
7866 c & " of CONT_TO_COMM group"
7869 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7870 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7871 c write (iout,*) "ireq,req",ireq,req(ireq)
7873 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7877 c write (iout,*) "number of requests (contacts)",ireq
7878 c write (iout,*) "req",(req(i),i=1,4)
7881 & call MPI_Waitall(ireq,req,status_array,ierr)
7882 do iii=1,ntask_cont_from
7883 iproc=itask_cont_from(iii)
7886 write (iout,*) "Received",nn," contacts from processor",iproc,
7887 & " of CONT_FROM_COMM group"
7890 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7895 ii=zapas_recv(1,i,iii)
7896 c Flag the received contacts to prevent double-counting
7897 jj=-zapas_recv(2,i,iii)
7898 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7900 nnn=num_cont_hb(ii)+1
7903 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7904 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7905 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7906 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7907 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7908 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7909 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7910 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7911 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7912 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7913 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7914 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7915 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7916 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7917 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7918 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7919 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7920 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7921 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7922 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7923 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7924 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7925 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7926 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7931 write (iout,'(a)') 'Contact function values after receive:'
7933 write (iout,'(2i3,50(1x,i3,f5.2))')
7934 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7935 & j=1,num_cont_hb(i))
7942 write (iout,'(a)') 'Contact function values:'
7944 write (iout,'(2i3,50(1x,i3,f5.2))')
7945 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7946 & j=1,num_cont_hb(i))
7950 C Remove the loop below after debugging !!!
7957 C Calculate the local-electrostatic correlation terms
7958 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7960 num_conti=num_cont_hb(i)
7961 num_conti1=num_cont_hb(i+1)
7968 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7969 c & ' jj=',jj,' kk=',kk
7970 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7971 & .or. j.lt.0 .and. j1.gt.0) .and.
7972 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7973 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7974 C The system gains extra energy.
7975 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7976 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7977 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7979 else if (j1.eq.j) then
7980 C Contacts I-J and I-(J+1) occur simultaneously.
7981 C The system loses extra energy.
7982 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7987 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7988 c & ' jj=',jj,' kk=',kk
7990 C Contacts I-J and (I+1)-J occur simultaneously.
7991 C The system loses extra energy.
7992 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7999 c------------------------------------------------------------------------------
8000 subroutine add_hb_contact(ii,jj,itask)
8001 implicit real*8 (a-h,o-z)
8002 include "DIMENSIONS"
8003 include "COMMON.IOUNITS"
8006 parameter (max_cont=maxconts)
8007 parameter (max_dim=26)
8008 include "COMMON.CONTACTS"
8009 double precision zapas(max_dim,maxconts,max_fg_procs),
8010 & zapas_recv(max_dim,maxconts,max_fg_procs)
8011 common /przechowalnia/ zapas
8012 integer i,j,ii,jj,iproc,itask(4),nn
8013 c write (iout,*) "itask",itask
8016 if (iproc.gt.0) then
8017 do j=1,num_cont_hb(ii)
8019 c write (iout,*) "i",ii," j",jj," jjc",jjc
8021 ncont_sent(iproc)=ncont_sent(iproc)+1
8022 nn=ncont_sent(iproc)
8023 zapas(1,nn,iproc)=ii
8024 zapas(2,nn,iproc)=jjc
8025 zapas(3,nn,iproc)=facont_hb(j,ii)
8026 zapas(4,nn,iproc)=ees0p(j,ii)
8027 zapas(5,nn,iproc)=ees0m(j,ii)
8028 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8029 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8030 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8031 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8032 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8033 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8034 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8035 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8036 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8037 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8038 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8039 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8040 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8041 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8042 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8043 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8044 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8045 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8046 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8047 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8048 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8056 c------------------------------------------------------------------------------
8057 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8059 C This subroutine calculates multi-body contributions to hydrogen-bonding
8060 implicit real*8 (a-h,o-z)
8061 include 'DIMENSIONS'
8062 include 'COMMON.IOUNITS'
8065 parameter (max_cont=maxconts)
8066 parameter (max_dim=70)
8067 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8068 double precision zapas(max_dim,maxconts,max_fg_procs),
8069 & zapas_recv(max_dim,maxconts,max_fg_procs)
8070 common /przechowalnia/ zapas
8071 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8072 & status_array(MPI_STATUS_SIZE,maxconts*2)
8074 include 'COMMON.SETUP'
8075 include 'COMMON.FFIELD'
8076 include 'COMMON.DERIV'
8077 include 'COMMON.LOCAL'
8078 include 'COMMON.INTERACT'
8079 include 'COMMON.CONTACTS'
8080 include 'COMMON.CHAIN'
8081 include 'COMMON.CONTROL'
8082 double precision gx(3),gx1(3)
8083 integer num_cont_hb_old(maxres)
8085 double precision eello4,eello5,eelo6,eello_turn6
8086 external eello4,eello5,eello6,eello_turn6
8087 C Set lprn=.true. for debugging
8092 num_cont_hb_old(i)=num_cont_hb(i)
8096 if (nfgtasks.le.1) goto 30
8098 write (iout,'(a)') 'Contact function values before RECEIVE:'
8100 write (iout,'(2i3,50(1x,i2,f5.2))')
8101 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8102 & j=1,num_cont_hb(i))
8106 do i=1,ntask_cont_from
8109 do i=1,ntask_cont_to
8112 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8114 C Make the list of contacts to send to send to other procesors
8115 do i=iturn3_start,iturn3_end
8116 c write (iout,*) "make contact list turn3",i," num_cont",
8118 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8120 do i=iturn4_start,iturn4_end
8121 c write (iout,*) "make contact list turn4",i," num_cont",
8123 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8127 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8129 do j=1,num_cont_hb(i)
8132 iproc=iint_sent_local(k,jjc,ii)
8133 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8134 if (iproc.ne.0) then
8135 ncont_sent(iproc)=ncont_sent(iproc)+1
8136 nn=ncont_sent(iproc)
8138 zapas(2,nn,iproc)=jjc
8139 zapas(3,nn,iproc)=d_cont(j,i)
8143 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8148 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8156 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8167 & "Numbers of contacts to be sent to other processors",
8168 & (ncont_sent(i),i=1,ntask_cont_to)
8169 write (iout,*) "Contacts sent"
8170 do ii=1,ntask_cont_to
8172 iproc=itask_cont_to(ii)
8173 write (iout,*) nn," contacts to processor",iproc,
8174 & " of CONT_TO_COMM group"
8176 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8184 CorrelID1=nfgtasks+fg_rank+1
8186 C Receive the numbers of needed contacts from other processors
8187 do ii=1,ntask_cont_from
8188 iproc=itask_cont_from(ii)
8190 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8191 & FG_COMM,req(ireq),IERR)
8193 c write (iout,*) "IRECV ended"
8195 C Send the number of contacts needed by other processors
8196 do ii=1,ntask_cont_to
8197 iproc=itask_cont_to(ii)
8199 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8200 & FG_COMM,req(ireq),IERR)
8202 c write (iout,*) "ISEND ended"
8203 c write (iout,*) "number of requests (nn)",ireq
8206 & call MPI_Waitall(ireq,req,status_array,ierr)
8208 c & "Numbers of contacts to be received from other processors",
8209 c & (ncont_recv(i),i=1,ntask_cont_from)
8213 do ii=1,ntask_cont_from
8214 iproc=itask_cont_from(ii)
8216 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8217 c & " of CONT_TO_COMM group"
8221 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8222 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8223 c write (iout,*) "ireq,req",ireq,req(ireq)
8226 C Send the contacts to processors that need them
8227 do ii=1,ntask_cont_to
8228 iproc=itask_cont_to(ii)
8230 c write (iout,*) nn," contacts to processor",iproc,
8231 c & " of CONT_TO_COMM group"
8234 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8235 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8236 c write (iout,*) "ireq,req",ireq,req(ireq)
8238 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8242 c write (iout,*) "number of requests (contacts)",ireq
8243 c write (iout,*) "req",(req(i),i=1,4)
8246 & call MPI_Waitall(ireq,req,status_array,ierr)
8247 do iii=1,ntask_cont_from
8248 iproc=itask_cont_from(iii)
8251 write (iout,*) "Received",nn," contacts from processor",iproc,
8252 & " of CONT_FROM_COMM group"
8255 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8260 ii=zapas_recv(1,i,iii)
8261 c Flag the received contacts to prevent double-counting
8262 jj=-zapas_recv(2,i,iii)
8263 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8265 nnn=num_cont_hb(ii)+1
8268 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8272 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8277 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8285 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8294 write (iout,'(a)') 'Contact function values after receive:'
8296 write (iout,'(2i3,50(1x,i3,5f6.3))')
8297 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8298 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8305 write (iout,'(a)') 'Contact function values:'
8307 write (iout,'(2i3,50(1x,i2,5f6.3))')
8308 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8309 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8315 C Remove the loop below after debugging !!!
8322 C Calculate the dipole-dipole interaction energies
8323 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8324 do i=iatel_s,iatel_e+1
8325 num_conti=num_cont_hb(i)
8334 C Calculate the local-electrostatic correlation terms
8335 c write (iout,*) "gradcorr5 in eello5 before loop"
8337 c write (iout,'(i5,3f10.5)')
8338 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8340 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8341 c write (iout,*) "corr loop i",i
8343 num_conti=num_cont_hb(i)
8344 num_conti1=num_cont_hb(i+1)
8351 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8352 c & ' jj=',jj,' kk=',kk
8353 c if (j1.eq.j+1 .or. j1.eq.j-1) then
8354 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8355 & .or. j.lt.0 .and. j1.gt.0) .and.
8356 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8357 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8358 C The system gains extra energy.
8360 sqd1=dsqrt(d_cont(jj,i))
8361 sqd2=dsqrt(d_cont(kk,i1))
8362 sred_geom = sqd1*sqd2
8363 IF (sred_geom.lt.cutoff_corr) THEN
8364 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
8366 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8367 cd & ' jj=',jj,' kk=',kk
8368 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8369 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8371 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8372 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8375 cd write (iout,*) 'sred_geom=',sred_geom,
8376 cd & ' ekont=',ekont,' fprim=',fprimcont,
8377 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8378 cd write (iout,*) "g_contij",g_contij
8379 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8380 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8381 call calc_eello(i,jp,i+1,jp1,jj,kk)
8382 if (wcorr4.gt.0.0d0)
8383 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8384 if (energy_dec.and.wcorr4.gt.0.0d0)
8385 1 write (iout,'(a6,4i5,0pf7.3)')
8386 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8387 c write (iout,*) "gradcorr5 before eello5"
8389 c write (iout,'(i5,3f10.5)')
8390 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8392 if (wcorr5.gt.0.0d0)
8393 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8394 c write (iout,*) "gradcorr5 after eello5"
8396 c write (iout,'(i5,3f10.5)')
8397 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8399 if (energy_dec.and.wcorr5.gt.0.0d0)
8400 1 write (iout,'(a6,4i5,0pf7.3)')
8401 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8402 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8403 cd write(2,*)'ijkl',i,jp,i+1,jp1
8404 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
8405 & .or. wturn6.eq.0.0d0))then
8406 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8407 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8408 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8409 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8410 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8411 cd & 'ecorr6=',ecorr6
8412 cd write (iout,'(4e15.5)') sred_geom,
8413 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8414 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8415 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8416 else if (wturn6.gt.0.0d0
8417 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8418 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8419 eturn6=eturn6+eello_turn6(i,jj,kk)
8420 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8421 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8422 cd write (2,*) 'multibody_eello:eturn6',eturn6
8431 num_cont_hb(i)=num_cont_hb_old(i)
8433 c write (iout,*) "gradcorr5 in eello5"
8435 c write (iout,'(i5,3f10.5)')
8436 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8440 c------------------------------------------------------------------------------
8441 subroutine add_hb_contact_eello(ii,jj,itask)
8442 implicit real*8 (a-h,o-z)
8443 include "DIMENSIONS"
8444 include "COMMON.IOUNITS"
8447 parameter (max_cont=maxconts)
8448 parameter (max_dim=70)
8449 include "COMMON.CONTACTS"
8450 double precision zapas(max_dim,maxconts,max_fg_procs),
8451 & zapas_recv(max_dim,maxconts,max_fg_procs)
8452 common /przechowalnia/ zapas
8453 integer i,j,ii,jj,iproc,itask(4),nn
8454 c write (iout,*) "itask",itask
8457 if (iproc.gt.0) then
8458 do j=1,num_cont_hb(ii)
8460 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8462 ncont_sent(iproc)=ncont_sent(iproc)+1
8463 nn=ncont_sent(iproc)
8464 zapas(1,nn,iproc)=ii
8465 zapas(2,nn,iproc)=jjc
8466 zapas(3,nn,iproc)=d_cont(j,ii)
8470 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8475 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8483 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8495 c------------------------------------------------------------------------------
8496 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8497 implicit real*8 (a-h,o-z)
8498 include 'DIMENSIONS'
8499 include 'COMMON.IOUNITS'
8500 include 'COMMON.DERIV'
8501 include 'COMMON.INTERACT'
8502 include 'COMMON.CONTACTS'
8503 double precision gx(3),gx1(3)
8513 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8514 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8515 C Following 4 lines for diagnostics.
8520 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8521 c & 'Contacts ',i,j,
8522 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8523 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8525 C Calculate the multi-body contribution to energy.
8526 c ecorr=ecorr+ekont*ees
8527 C Calculate multi-body contributions to the gradient.
8528 coeffpees0pij=coeffp*ees0pij
8529 coeffmees0mij=coeffm*ees0mij
8530 coeffpees0pkl=coeffp*ees0pkl
8531 coeffmees0mkl=coeffm*ees0mkl
8533 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8534 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8535 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8536 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8537 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8538 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8539 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8540 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8541 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8542 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8543 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8544 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8545 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8546 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8547 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8548 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8549 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8550 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8551 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8552 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8553 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8554 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8555 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8556 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8557 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8562 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8563 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8564 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8565 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8570 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8571 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8572 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8573 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8576 c write (iout,*) "ehbcorr",ekont*ees
8581 C---------------------------------------------------------------------------
8582 subroutine dipole(i,j,jj)
8583 implicit real*8 (a-h,o-z)
8584 include 'DIMENSIONS'
8585 include 'COMMON.IOUNITS'
8586 include 'COMMON.CHAIN'
8587 include 'COMMON.FFIELD'
8588 include 'COMMON.DERIV'
8589 include 'COMMON.INTERACT'
8590 include 'COMMON.CONTACTS'
8591 include 'COMMON.TORSION'
8592 include 'COMMON.VAR'
8593 include 'COMMON.GEO'
8594 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8596 iti1 = itortyp(itype(i+1))
8597 if (j.lt.nres-1) then
8598 itj1 = itortyp(itype(j+1))
8603 dipi(iii,1)=Ub2(iii,i)
8604 dipderi(iii)=Ub2der(iii,i)
8605 dipi(iii,2)=b1(iii,i+1)
8606 dipj(iii,1)=Ub2(iii,j)
8607 dipderj(iii)=Ub2der(iii,j)
8608 dipj(iii,2)=b1(iii,j+1)
8612 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8615 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8622 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8626 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8631 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8632 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8634 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8636 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8638 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8643 C---------------------------------------------------------------------------
8644 subroutine calc_eello(i,j,k,l,jj,kk)
8646 C This subroutine computes matrices and vectors needed to calculate
8647 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8649 implicit real*8 (a-h,o-z)
8650 include 'DIMENSIONS'
8651 include 'COMMON.IOUNITS'
8652 include 'COMMON.CHAIN'
8653 include 'COMMON.DERIV'
8654 include 'COMMON.INTERACT'
8655 include 'COMMON.CONTACTS'
8656 include 'COMMON.TORSION'
8657 include 'COMMON.VAR'
8658 include 'COMMON.GEO'
8659 include 'COMMON.FFIELD'
8660 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8661 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8664 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8665 cd & ' jj=',jj,' kk=',kk
8666 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8667 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8668 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8671 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8672 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8675 call transpose2(aa1(1,1),aa1t(1,1))
8676 call transpose2(aa2(1,1),aa2t(1,1))
8679 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8680 & aa1tder(1,1,lll,kkk))
8681 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8682 & aa2tder(1,1,lll,kkk))
8686 C parallel orientation of the two CA-CA-CA frames.
8688 iti=itortyp(itype(i))
8692 itk1=itortyp(itype(k+1))
8693 itj=itortyp(itype(j))
8694 if (l.lt.nres-1) then
8695 itl1=itortyp(itype(l+1))
8699 C A1 kernel(j+1) A2T
8701 cd write (iout,'(3f10.5,5x,3f10.5)')
8702 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8704 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8705 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8706 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8707 C Following matrices are needed only for 6-th order cumulants
8708 IF (wcorr6.gt.0.0d0) THEN
8709 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8710 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8711 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8712 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8713 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8714 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8715 & ADtEAderx(1,1,1,1,1,1))
8717 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8718 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8719 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8720 & ADtEA1derx(1,1,1,1,1,1))
8722 C End 6-th order cumulants
8725 cd write (2,*) 'In calc_eello6'
8727 cd write (2,*) 'iii=',iii
8729 cd write (2,*) 'kkk=',kkk
8731 cd write (2,'(3(2f10.5),5x)')
8732 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8737 call transpose2(EUgder(1,1,k),auxmat(1,1))
8738 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8739 call transpose2(EUg(1,1,k),auxmat(1,1))
8740 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8741 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8745 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8746 & EAEAderx(1,1,lll,kkk,iii,1))
8750 C A1T kernel(i+1) A2
8751 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8752 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8753 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8754 C Following matrices are needed only for 6-th order cumulants
8755 IF (wcorr6.gt.0.0d0) THEN
8756 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8757 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8758 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8759 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8760 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8761 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8762 & ADtEAderx(1,1,1,1,1,2))
8763 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8764 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8765 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8766 & ADtEA1derx(1,1,1,1,1,2))
8768 C End 6-th order cumulants
8769 call transpose2(EUgder(1,1,l),auxmat(1,1))
8770 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8771 call transpose2(EUg(1,1,l),auxmat(1,1))
8772 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8773 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8777 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8778 & EAEAderx(1,1,lll,kkk,iii,2))
8783 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8784 C They are needed only when the fifth- or the sixth-order cumulants are
8786 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8787 call transpose2(AEA(1,1,1),auxmat(1,1))
8788 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8789 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8790 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8791 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8792 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8793 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8794 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8795 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8796 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8797 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8798 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8799 call transpose2(AEA(1,1,2),auxmat(1,1))
8800 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8801 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8802 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8803 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8804 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8805 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8806 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8807 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8808 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8809 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8810 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8811 C Calculate the Cartesian derivatives of the vectors.
8815 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8816 call matvec2(auxmat(1,1),b1(1,i),
8817 & AEAb1derx(1,lll,kkk,iii,1,1))
8818 call matvec2(auxmat(1,1),Ub2(1,i),
8819 & AEAb2derx(1,lll,kkk,iii,1,1))
8820 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8821 & AEAb1derx(1,lll,kkk,iii,2,1))
8822 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8823 & AEAb2derx(1,lll,kkk,iii,2,1))
8824 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8825 call matvec2(auxmat(1,1),b1(1,j),
8826 & AEAb1derx(1,lll,kkk,iii,1,2))
8827 call matvec2(auxmat(1,1),Ub2(1,j),
8828 & AEAb2derx(1,lll,kkk,iii,1,2))
8829 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8830 & AEAb1derx(1,lll,kkk,iii,2,2))
8831 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8832 & AEAb2derx(1,lll,kkk,iii,2,2))
8839 C Antiparallel orientation of the two CA-CA-CA frames.
8841 iti=itortyp(itype(i))
8845 itk1=itortyp(itype(k+1))
8846 itl=itortyp(itype(l))
8847 itj=itortyp(itype(j))
8848 if (j.lt.nres-1) then
8849 itj1=itortyp(itype(j+1))
8853 C A2 kernel(j-1)T A1T
8854 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8855 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8856 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8857 C Following matrices are needed only for 6-th order cumulants
8858 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8859 & j.eq.i+4 .and. l.eq.i+3)) THEN
8860 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8861 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8862 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8863 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8864 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8865 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8866 & ADtEAderx(1,1,1,1,1,1))
8867 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8868 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8869 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8870 & ADtEA1derx(1,1,1,1,1,1))
8872 C End 6-th order cumulants
8873 call transpose2(EUgder(1,1,k),auxmat(1,1))
8874 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8875 call transpose2(EUg(1,1,k),auxmat(1,1))
8876 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8877 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8881 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8882 & EAEAderx(1,1,lll,kkk,iii,1))
8886 C A2T kernel(i+1)T A1
8887 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8888 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8889 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8890 C Following matrices are needed only for 6-th order cumulants
8891 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8892 & j.eq.i+4 .and. l.eq.i+3)) THEN
8893 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8894 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8895 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8896 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8897 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8898 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8899 & ADtEAderx(1,1,1,1,1,2))
8900 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8901 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8902 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8903 & ADtEA1derx(1,1,1,1,1,2))
8905 C End 6-th order cumulants
8906 call transpose2(EUgder(1,1,j),auxmat(1,1))
8907 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8908 call transpose2(EUg(1,1,j),auxmat(1,1))
8909 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8910 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8914 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8915 & EAEAderx(1,1,lll,kkk,iii,2))
8920 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8921 C They are needed only when the fifth- or the sixth-order cumulants are
8923 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8924 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8925 call transpose2(AEA(1,1,1),auxmat(1,1))
8926 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8927 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8928 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8929 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8930 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8931 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8932 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8933 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8934 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8935 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8936 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8937 call transpose2(AEA(1,1,2),auxmat(1,1))
8938 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8939 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8940 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8941 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8942 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8943 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8944 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8945 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8946 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8947 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8948 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8949 C Calculate the Cartesian derivatives of the vectors.
8953 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8954 call matvec2(auxmat(1,1),b1(1,i),
8955 & AEAb1derx(1,lll,kkk,iii,1,1))
8956 call matvec2(auxmat(1,1),Ub2(1,i),
8957 & AEAb2derx(1,lll,kkk,iii,1,1))
8958 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8959 & AEAb1derx(1,lll,kkk,iii,2,1))
8960 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8961 & AEAb2derx(1,lll,kkk,iii,2,1))
8962 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8963 call matvec2(auxmat(1,1),b1(1,l),
8964 & AEAb1derx(1,lll,kkk,iii,1,2))
8965 call matvec2(auxmat(1,1),Ub2(1,l),
8966 & AEAb2derx(1,lll,kkk,iii,1,2))
8967 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8968 & AEAb1derx(1,lll,kkk,iii,2,2))
8969 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8970 & AEAb2derx(1,lll,kkk,iii,2,2))
8979 C---------------------------------------------------------------------------
8980 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8981 & KK,KKderg,AKA,AKAderg,AKAderx)
8985 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8986 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8987 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8992 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8994 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8997 cd if (lprn) write (2,*) 'In kernel'
8999 cd if (lprn) write (2,*) 'kkk=',kkk
9001 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
9002 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9004 cd write (2,*) 'lll=',lll
9005 cd write (2,*) 'iii=1'
9007 cd write (2,'(3(2f10.5),5x)')
9008 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9011 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
9012 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9014 cd write (2,*) 'lll=',lll
9015 cd write (2,*) 'iii=2'
9017 cd write (2,'(3(2f10.5),5x)')
9018 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9025 C---------------------------------------------------------------------------
9026 double precision function eello4(i,j,k,l,jj,kk)
9027 implicit real*8 (a-h,o-z)
9028 include 'DIMENSIONS'
9029 include 'COMMON.IOUNITS'
9030 include 'COMMON.CHAIN'
9031 include 'COMMON.DERIV'
9032 include 'COMMON.INTERACT'
9033 include 'COMMON.CONTACTS'
9034 include 'COMMON.TORSION'
9035 include 'COMMON.VAR'
9036 include 'COMMON.GEO'
9037 double precision pizda(2,2),ggg1(3),ggg2(3)
9038 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9042 cd print *,'eello4:',i,j,k,l,jj,kk
9043 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9044 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9045 cold eij=facont_hb(jj,i)
9046 cold ekl=facont_hb(kk,k)
9048 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9049 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9050 gcorr_loc(k-1)=gcorr_loc(k-1)
9051 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9053 gcorr_loc(l-1)=gcorr_loc(l-1)
9054 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9056 gcorr_loc(j-1)=gcorr_loc(j-1)
9057 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9062 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9063 & -EAEAderx(2,2,lll,kkk,iii,1)
9064 cd derx(lll,kkk,iii)=0.0d0
9068 cd gcorr_loc(l-1)=0.0d0
9069 cd gcorr_loc(j-1)=0.0d0
9070 cd gcorr_loc(k-1)=0.0d0
9072 cd write (iout,*)'Contacts have occurred for peptide groups',
9073 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9074 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9075 if (j.lt.nres-1) then
9082 if (l.lt.nres-1) then
9090 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9091 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9092 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9093 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9094 cgrad ghalf=0.5d0*ggg1(ll)
9095 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9096 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9097 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9098 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9099 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9100 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9101 cgrad ghalf=0.5d0*ggg2(ll)
9102 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9103 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9104 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9105 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9106 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9107 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9111 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9116 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9121 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9126 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9130 cd write (2,*) iii,gcorr_loc(iii)
9133 cd write (2,*) 'ekont',ekont
9134 cd write (iout,*) 'eello4',ekont*eel4
9137 C---------------------------------------------------------------------------
9138 double precision function eello5(i,j,k,l,jj,kk)
9139 implicit real*8 (a-h,o-z)
9140 include 'DIMENSIONS'
9141 include 'COMMON.IOUNITS'
9142 include 'COMMON.CHAIN'
9143 include 'COMMON.DERIV'
9144 include 'COMMON.INTERACT'
9145 include 'COMMON.CONTACTS'
9146 include 'COMMON.TORSION'
9147 include 'COMMON.VAR'
9148 include 'COMMON.GEO'
9149 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9150 double precision ggg1(3),ggg2(3)
9151 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9156 C /l\ / \ \ / \ / \ / C
9157 C / \ / \ \ / \ / \ / C
9158 C j| o |l1 | o | o| o | | o |o C
9159 C \ |/k\| |/ \| / |/ \| |/ \| C
9160 C \i/ \ / \ / / \ / \ C
9162 C (I) (II) (III) (IV) C
9164 C eello5_1 eello5_2 eello5_3 eello5_4 C
9166 C Antiparallel chains C
9169 C /j\ / \ \ / \ / \ / C
9170 C / \ / \ \ / \ / \ / C
9171 C j1| o |l | o | o| o | | o |o C
9172 C \ |/k\| |/ \| / |/ \| |/ \| C
9173 C \i/ \ / \ / / \ / \ C
9175 C (I) (II) (III) (IV) C
9177 C eello5_1 eello5_2 eello5_3 eello5_4 C
9179 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9181 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9182 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9187 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9189 itk=itortyp(itype(k))
9190 itl=itortyp(itype(l))
9191 itj=itortyp(itype(j))
9196 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9197 cd & eel5_3_num,eel5_4_num)
9201 derx(lll,kkk,iii)=0.0d0
9205 cd eij=facont_hb(jj,i)
9206 cd ekl=facont_hb(kk,k)
9208 cd write (iout,*)'Contacts have occurred for peptide groups',
9209 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9211 C Contribution from the graph I.
9212 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9213 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9214 call transpose2(EUg(1,1,k),auxmat(1,1))
9215 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9216 vv(1)=pizda(1,1)-pizda(2,2)
9217 vv(2)=pizda(1,2)+pizda(2,1)
9218 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9219 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9220 C Explicit gradient in virtual-dihedral angles.
9221 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9222 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9223 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9224 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9225 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9226 vv(1)=pizda(1,1)-pizda(2,2)
9227 vv(2)=pizda(1,2)+pizda(2,1)
9228 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9229 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9230 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9231 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9232 vv(1)=pizda(1,1)-pizda(2,2)
9233 vv(2)=pizda(1,2)+pizda(2,1)
9235 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9236 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9237 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9239 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9240 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9241 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9243 C Cartesian gradient
9247 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
9249 vv(1)=pizda(1,1)-pizda(2,2)
9250 vv(2)=pizda(1,2)+pizda(2,1)
9251 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9252 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
9253 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9259 C Contribution from graph II
9260 call transpose2(EE(1,1,itk),auxmat(1,1))
9261 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9262 vv(1)=pizda(1,1)+pizda(2,2)
9263 vv(2)=pizda(2,1)-pizda(1,2)
9264 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
9265 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9266 C Explicit gradient in virtual-dihedral angles.
9267 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9268 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9269 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9270 vv(1)=pizda(1,1)+pizda(2,2)
9271 vv(2)=pizda(2,1)-pizda(1,2)
9273 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9274 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9275 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9277 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9278 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9279 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9281 C Cartesian gradient
9285 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9287 vv(1)=pizda(1,1)+pizda(2,2)
9288 vv(2)=pizda(2,1)-pizda(1,2)
9289 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9290 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
9291 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9299 C Parallel orientation
9300 C Contribution from graph III
9301 call transpose2(EUg(1,1,l),auxmat(1,1))
9302 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9303 vv(1)=pizda(1,1)-pizda(2,2)
9304 vv(2)=pizda(1,2)+pizda(2,1)
9305 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
9306 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9307 C Explicit gradient in virtual-dihedral angles.
9308 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9309 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
9310 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9311 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9312 vv(1)=pizda(1,1)-pizda(2,2)
9313 vv(2)=pizda(1,2)+pizda(2,1)
9314 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9315 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
9316 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9317 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9318 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9319 vv(1)=pizda(1,1)-pizda(2,2)
9320 vv(2)=pizda(1,2)+pizda(2,1)
9321 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9322 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
9323 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9324 C Cartesian gradient
9328 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9330 vv(1)=pizda(1,1)-pizda(2,2)
9331 vv(2)=pizda(1,2)+pizda(2,1)
9332 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9333 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
9334 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9339 C Contribution from graph IV
9341 call transpose2(EE(1,1,itl),auxmat(1,1))
9342 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9343 vv(1)=pizda(1,1)+pizda(2,2)
9344 vv(2)=pizda(2,1)-pizda(1,2)
9345 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
9346 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9347 C Explicit gradient in virtual-dihedral angles.
9348 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9349 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9350 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9351 vv(1)=pizda(1,1)+pizda(2,2)
9352 vv(2)=pizda(2,1)-pizda(1,2)
9353 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9354 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
9355 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9356 C Cartesian gradient
9360 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9362 vv(1)=pizda(1,1)+pizda(2,2)
9363 vv(2)=pizda(2,1)-pizda(1,2)
9364 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9365 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
9366 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9371 C Antiparallel orientation
9372 C Contribution from graph III
9374 call transpose2(EUg(1,1,j),auxmat(1,1))
9375 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9376 vv(1)=pizda(1,1)-pizda(2,2)
9377 vv(2)=pizda(1,2)+pizda(2,1)
9378 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9379 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9380 C Explicit gradient in virtual-dihedral angles.
9381 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9382 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9383 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9384 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9385 vv(1)=pizda(1,1)-pizda(2,2)
9386 vv(2)=pizda(1,2)+pizda(2,1)
9387 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9388 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9389 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9390 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9391 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9392 vv(1)=pizda(1,1)-pizda(2,2)
9393 vv(2)=pizda(1,2)+pizda(2,1)
9394 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9395 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9396 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9397 C Cartesian gradient
9401 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9403 vv(1)=pizda(1,1)-pizda(2,2)
9404 vv(2)=pizda(1,2)+pizda(2,1)
9405 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9406 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9407 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9412 C Contribution from graph IV
9414 call transpose2(EE(1,1,itj),auxmat(1,1))
9415 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9416 vv(1)=pizda(1,1)+pizda(2,2)
9417 vv(2)=pizda(2,1)-pizda(1,2)
9418 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9419 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9420 C Explicit gradient in virtual-dihedral angles.
9421 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9422 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9423 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9424 vv(1)=pizda(1,1)+pizda(2,2)
9425 vv(2)=pizda(2,1)-pizda(1,2)
9426 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9427 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9428 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9429 C Cartesian gradient
9433 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9435 vv(1)=pizda(1,1)+pizda(2,2)
9436 vv(2)=pizda(2,1)-pizda(1,2)
9437 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9438 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9439 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9445 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9446 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9447 cd write (2,*) 'ijkl',i,j,k,l
9448 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9449 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9451 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9452 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9453 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9454 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9455 if (j.lt.nres-1) then
9462 if (l.lt.nres-1) then
9472 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9473 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9474 C summed up outside the subrouine as for the other subroutines
9475 C handling long-range interactions. The old code is commented out
9476 C with "cgrad" to keep track of changes.
9478 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9479 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9480 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9481 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9482 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9483 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9484 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9485 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9486 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9487 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9489 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9490 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9491 cgrad ghalf=0.5d0*ggg1(ll)
9493 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9494 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9495 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9496 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9497 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9498 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9499 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9500 cgrad ghalf=0.5d0*ggg2(ll)
9502 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
9503 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9504 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
9505 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9506 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9507 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9512 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9513 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9518 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9519 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9525 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9530 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9534 cd write (2,*) iii,g_corr5_loc(iii)
9537 cd write (2,*) 'ekont',ekont
9538 cd write (iout,*) 'eello5',ekont*eel5
9541 c--------------------------------------------------------------------------
9542 double precision function eello6(i,j,k,l,jj,kk)
9543 implicit real*8 (a-h,o-z)
9544 include 'DIMENSIONS'
9545 include 'COMMON.IOUNITS'
9546 include 'COMMON.CHAIN'
9547 include 'COMMON.DERIV'
9548 include 'COMMON.INTERACT'
9549 include 'COMMON.CONTACTS'
9550 include 'COMMON.TORSION'
9551 include 'COMMON.VAR'
9552 include 'COMMON.GEO'
9553 include 'COMMON.FFIELD'
9554 double precision ggg1(3),ggg2(3)
9555 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9560 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9568 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9569 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9573 derx(lll,kkk,iii)=0.0d0
9577 cd eij=facont_hb(jj,i)
9578 cd ekl=facont_hb(kk,k)
9584 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9585 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9586 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9587 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9588 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9589 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9591 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9592 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9593 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9594 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9595 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9596 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9600 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9602 C If turn contributions are considered, they will be handled separately.
9603 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9604 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9605 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9606 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9607 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9608 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9609 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9611 if (j.lt.nres-1) then
9618 if (l.lt.nres-1) then
9626 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9627 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9628 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9629 cgrad ghalf=0.5d0*ggg1(ll)
9631 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9632 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9633 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9634 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9635 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9636 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9637 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9638 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9639 cgrad ghalf=0.5d0*ggg2(ll)
9640 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9642 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9643 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9644 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9645 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9646 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9647 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9652 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9653 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9658 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9659 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9665 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9670 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9674 cd write (2,*) iii,g_corr6_loc(iii)
9677 cd write (2,*) 'ekont',ekont
9678 cd write (iout,*) 'eello6',ekont*eel6
9681 c--------------------------------------------------------------------------
9682 double precision function eello6_graph1(i,j,k,l,imat,swap)
9683 implicit real*8 (a-h,o-z)
9684 include 'DIMENSIONS'
9685 include 'COMMON.IOUNITS'
9686 include 'COMMON.CHAIN'
9687 include 'COMMON.DERIV'
9688 include 'COMMON.INTERACT'
9689 include 'COMMON.CONTACTS'
9690 include 'COMMON.TORSION'
9691 include 'COMMON.VAR'
9692 include 'COMMON.GEO'
9693 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9697 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9699 C Parallel Antiparallel C
9705 C \ j|/k\| / \ |/k\|l / C
9710 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9711 itk=itortyp(itype(k))
9712 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9713 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9714 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9715 call transpose2(EUgC(1,1,k),auxmat(1,1))
9716 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9717 vv1(1)=pizda1(1,1)-pizda1(2,2)
9718 vv1(2)=pizda1(1,2)+pizda1(2,1)
9719 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9720 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9721 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9722 s5=scalar2(vv(1),Dtobr2(1,i))
9723 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9724 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9725 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9726 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9727 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9728 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9729 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9730 & +scalar2(vv(1),Dtobr2der(1,i)))
9731 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9732 vv1(1)=pizda1(1,1)-pizda1(2,2)
9733 vv1(2)=pizda1(1,2)+pizda1(2,1)
9734 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9735 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9737 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9738 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9739 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9740 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9741 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9743 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9744 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9745 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9746 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9747 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9749 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9750 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9751 vv1(1)=pizda1(1,1)-pizda1(2,2)
9752 vv1(2)=pizda1(1,2)+pizda1(2,1)
9753 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9754 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9755 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9756 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9765 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9766 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9767 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9768 call transpose2(EUgC(1,1,k),auxmat(1,1))
9769 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9771 vv1(1)=pizda1(1,1)-pizda1(2,2)
9772 vv1(2)=pizda1(1,2)+pizda1(2,1)
9773 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9774 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9775 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9776 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9777 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9778 s5=scalar2(vv(1),Dtobr2(1,i))
9779 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9785 c----------------------------------------------------------------------------
9786 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9787 implicit real*8 (a-h,o-z)
9788 include 'DIMENSIONS'
9789 include 'COMMON.IOUNITS'
9790 include 'COMMON.CHAIN'
9791 include 'COMMON.DERIV'
9792 include 'COMMON.INTERACT'
9793 include 'COMMON.CONTACTS'
9794 include 'COMMON.TORSION'
9795 include 'COMMON.VAR'
9796 include 'COMMON.GEO'
9798 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9799 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9802 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9804 C Parallel Antiparallel C
9810 C \ j|/k\| \ |/k\|l C
9815 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9816 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9817 C AL 7/4/01 s1 would occur in the sixth-order moment,
9818 C but not in a cluster cumulant
9820 s1=dip(1,jj,i)*dip(1,kk,k)
9822 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9823 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9824 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9825 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9826 call transpose2(EUg(1,1,k),auxmat(1,1))
9827 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9828 vv(1)=pizda(1,1)-pizda(2,2)
9829 vv(2)=pizda(1,2)+pizda(2,1)
9830 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9831 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9833 eello6_graph2=-(s1+s2+s3+s4)
9835 eello6_graph2=-(s2+s3+s4)
9838 C Derivatives in gamma(i-1)
9841 s1=dipderg(1,jj,i)*dip(1,kk,k)
9843 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9844 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9845 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9846 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9848 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9850 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9852 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9854 C Derivatives in gamma(k-1)
9856 s1=dip(1,jj,i)*dipderg(1,kk,k)
9858 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9859 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9860 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9861 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9862 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9863 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9864 vv(1)=pizda(1,1)-pizda(2,2)
9865 vv(2)=pizda(1,2)+pizda(2,1)
9866 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9868 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9870 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9872 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9873 C Derivatives in gamma(j-1) or gamma(l-1)
9876 s1=dipderg(3,jj,i)*dip(1,kk,k)
9878 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9879 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9880 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9881 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9882 vv(1)=pizda(1,1)-pizda(2,2)
9883 vv(2)=pizda(1,2)+pizda(2,1)
9884 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9887 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9889 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9892 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9893 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9895 C Derivatives in gamma(l-1) or gamma(j-1)
9898 s1=dip(1,jj,i)*dipderg(3,kk,k)
9900 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9901 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9902 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9903 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9904 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9905 vv(1)=pizda(1,1)-pizda(2,2)
9906 vv(2)=pizda(1,2)+pizda(2,1)
9907 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9910 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9912 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9915 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9916 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9918 C Cartesian derivatives.
9920 write (2,*) 'In eello6_graph2'
9922 write (2,*) 'iii=',iii
9924 write (2,*) 'kkk=',kkk
9926 write (2,'(3(2f10.5),5x)')
9927 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9937 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9939 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9942 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9944 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9945 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9947 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9948 call transpose2(EUg(1,1,k),auxmat(1,1))
9949 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9951 vv(1)=pizda(1,1)-pizda(2,2)
9952 vv(2)=pizda(1,2)+pizda(2,1)
9953 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9954 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9956 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9958 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9961 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9963 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9970 c----------------------------------------------------------------------------
9971 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9972 implicit real*8 (a-h,o-z)
9973 include 'DIMENSIONS'
9974 include 'COMMON.IOUNITS'
9975 include 'COMMON.CHAIN'
9976 include 'COMMON.DERIV'
9977 include 'COMMON.INTERACT'
9978 include 'COMMON.CONTACTS'
9979 include 'COMMON.TORSION'
9980 include 'COMMON.VAR'
9981 include 'COMMON.GEO'
9982 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9984 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9986 C Parallel Antiparallel C
9992 C j|/k\| / |/k\|l / C
9997 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9999 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10000 C energy moment and not to the cluster cumulant.
10001 iti=itortyp(itype(i))
10002 if (j.lt.nres-1) then
10003 itj1=itortyp(itype(j+1))
10007 itk=itortyp(itype(k))
10008 itk1=itortyp(itype(k+1))
10009 if (l.lt.nres-1) then
10010 itl1=itortyp(itype(l+1))
10015 s1=dip(4,jj,i)*dip(4,kk,k)
10017 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
10018 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10019 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
10020 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10021 call transpose2(EE(1,1,itk),auxmat(1,1))
10022 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10023 vv(1)=pizda(1,1)+pizda(2,2)
10024 vv(2)=pizda(2,1)-pizda(1,2)
10025 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10026 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10027 cd & "sum",-(s2+s3+s4)
10029 eello6_graph3=-(s1+s2+s3+s4)
10031 eello6_graph3=-(s2+s3+s4)
10033 c eello6_graph3=-s4
10034 C Derivatives in gamma(k-1)
10035 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
10036 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10037 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10038 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10039 C Derivatives in gamma(l-1)
10040 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
10041 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10042 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10043 vv(1)=pizda(1,1)+pizda(2,2)
10044 vv(2)=pizda(2,1)-pizda(1,2)
10045 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10046 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10047 C Cartesian derivatives.
10053 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10055 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10058 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
10060 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10061 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
10063 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10064 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,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))
10070 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10072 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10075 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10077 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10079 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10085 c----------------------------------------------------------------------------
10086 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10087 implicit real*8 (a-h,o-z)
10088 include 'DIMENSIONS'
10089 include 'COMMON.IOUNITS'
10090 include 'COMMON.CHAIN'
10091 include 'COMMON.DERIV'
10092 include 'COMMON.INTERACT'
10093 include 'COMMON.CONTACTS'
10094 include 'COMMON.TORSION'
10095 include 'COMMON.VAR'
10096 include 'COMMON.GEO'
10097 include 'COMMON.FFIELD'
10098 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10099 & auxvec1(2),auxmat1(2,2)
10101 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10103 C Parallel Antiparallel C
10108 C /| o |o o| o |\ C
10109 C \ j|/k\| \ |/k\|l C
10114 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10116 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10117 C energy moment and not to the cluster cumulant.
10118 cd write (2,*) 'eello_graph4: wturn6',wturn6
10119 iti=itortyp(itype(i))
10120 itj=itortyp(itype(j))
10121 if (j.lt.nres-1) then
10122 itj1=itortyp(itype(j+1))
10126 itk=itortyp(itype(k))
10127 if (k.lt.nres-1) then
10128 itk1=itortyp(itype(k+1))
10132 itl=itortyp(itype(l))
10133 if (l.lt.nres-1) then
10134 itl1=itortyp(itype(l+1))
10138 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10139 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10140 cd & ' itl',itl,' itl1',itl1
10142 if (imat.eq.1) then
10143 s1=dip(3,jj,i)*dip(3,kk,k)
10145 s1=dip(2,jj,j)*dip(2,kk,l)
10148 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10149 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10151 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
10152 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10154 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
10155 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10157 call transpose2(EUg(1,1,k),auxmat(1,1))
10158 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10159 vv(1)=pizda(1,1)-pizda(2,2)
10160 vv(2)=pizda(2,1)+pizda(1,2)
10161 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10162 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10164 eello6_graph4=-(s1+s2+s3+s4)
10166 eello6_graph4=-(s2+s3+s4)
10168 C Derivatives in gamma(i-1)
10171 if (imat.eq.1) then
10172 s1=dipderg(2,jj,i)*dip(3,kk,k)
10174 s1=dipderg(4,jj,j)*dip(2,kk,l)
10177 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10179 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
10180 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10182 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
10183 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10185 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10186 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10187 cd write (2,*) 'turn6 derivatives'
10189 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10191 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10195 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10197 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10201 C Derivatives in gamma(k-1)
10203 if (imat.eq.1) then
10204 s1=dip(3,jj,i)*dipderg(2,kk,k)
10206 s1=dip(2,jj,j)*dipderg(4,kk,l)
10209 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10210 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10212 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
10213 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10215 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
10216 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10218 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10219 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10220 vv(1)=pizda(1,1)-pizda(2,2)
10221 vv(2)=pizda(2,1)+pizda(1,2)
10222 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10223 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10225 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10227 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10231 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10233 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10236 C Derivatives in gamma(j-1) or gamma(l-1)
10237 if (l.eq.j+1 .and. l.gt.1) then
10238 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10239 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10240 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10241 vv(1)=pizda(1,1)-pizda(2,2)
10242 vv(2)=pizda(2,1)+pizda(1,2)
10243 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10244 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10245 else if (j.gt.1) then
10246 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10247 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10248 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10249 vv(1)=pizda(1,1)-pizda(2,2)
10250 vv(2)=pizda(2,1)+pizda(1,2)
10251 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10252 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10253 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10255 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10258 C Cartesian derivatives.
10264 if (imat.eq.1) then
10265 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10267 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10270 if (imat.eq.1) then
10271 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10273 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10277 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
10279 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10281 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10282 & b1(1,j+1),auxvec(1))
10283 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
10285 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10286 & b1(1,l+1),auxvec(1))
10287 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
10289 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10291 vv(1)=pizda(1,1)-pizda(2,2)
10292 vv(2)=pizda(2,1)+pizda(1,2)
10293 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
10297 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10300 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10303 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10306 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10308 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10310 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10314 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10316 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10319 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10321 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10329 c----------------------------------------------------------------------------
10330 double precision function eello_turn6(i,jj,kk)
10331 implicit real*8 (a-h,o-z)
10332 include 'DIMENSIONS'
10333 include 'COMMON.IOUNITS'
10334 include 'COMMON.CHAIN'
10335 include 'COMMON.DERIV'
10336 include 'COMMON.INTERACT'
10337 include 'COMMON.CONTACTS'
10338 include 'COMMON.TORSION'
10339 include 'COMMON.VAR'
10340 include 'COMMON.GEO'
10341 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
10342 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
10344 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
10345 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
10346 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10347 C the respective energy moment and not to the cluster cumulant.
10356 iti=itortyp(itype(i))
10357 itk=itortyp(itype(k))
10358 itk1=itortyp(itype(k+1))
10359 itl=itortyp(itype(l))
10360 itj=itortyp(itype(j))
10361 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10362 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
10363 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10368 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10370 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10374 derx_turn(lll,kkk,iii)=0.0d0
10381 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10383 cd write (2,*) 'eello6_5',eello6_5
10385 call transpose2(AEA(1,1,1),auxmat(1,1))
10386 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10387 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10388 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10390 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10391 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10392 s2 = scalar2(b1(1,k),vtemp1(1))
10394 call transpose2(AEA(1,1,2),atemp(1,1))
10395 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10396 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10397 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10399 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10400 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10401 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10403 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10404 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10405 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10406 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10407 ss13 = scalar2(b1(1,k),vtemp4(1))
10408 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10410 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10416 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10417 C Derivatives in gamma(i+2)
10421 call transpose2(AEA(1,1,1),auxmatd(1,1))
10422 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10423 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10424 call transpose2(AEAderg(1,1,2),atempd(1,1))
10425 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10426 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10428 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10429 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10430 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10436 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10437 C Derivatives in gamma(i+3)
10439 call transpose2(AEA(1,1,1),auxmatd(1,1))
10440 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10441 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10442 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10444 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10445 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10446 s2d = scalar2(b1(1,k),vtemp1d(1))
10448 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10449 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10451 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10453 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10454 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10455 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10463 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10464 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10466 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10467 & -0.5d0*ekont*(s2d+s12d)
10469 C Derivatives in gamma(i+4)
10470 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10471 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10472 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10474 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10475 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10476 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10484 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10486 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10488 C Derivatives in gamma(i+5)
10490 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10491 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10492 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10494 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10495 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10496 s2d = scalar2(b1(1,k),vtemp1d(1))
10498 call transpose2(AEA(1,1,2),atempd(1,1))
10499 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10500 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10502 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10503 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10505 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10506 ss13d = scalar2(b1(1,k),vtemp4d(1))
10507 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10515 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10516 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10518 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10519 & -0.5d0*ekont*(s2d+s12d)
10521 C Cartesian derivatives
10526 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10527 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10528 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10530 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10531 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10533 s2d = scalar2(b1(1,k),vtemp1d(1))
10535 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10536 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10537 s8d = -(atempd(1,1)+atempd(2,2))*
10538 & scalar2(cc(1,1,itl),vtemp2(1))
10540 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10542 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10543 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10550 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10551 & - 0.5d0*(s1d+s2d)
10553 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10557 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10558 & - 0.5d0*(s8d+s12d)
10560 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10569 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10570 & achuj_tempd(1,1))
10571 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10572 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10573 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10574 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10575 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10577 ss13d = scalar2(b1(1,k),vtemp4d(1))
10578 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10579 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10583 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10584 cd & 16*eel_turn6_num
10586 if (j.lt.nres-1) then
10593 if (l.lt.nres-1) then
10601 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10602 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10603 cgrad ghalf=0.5d0*ggg1(ll)
10605 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10606 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10607 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10608 & +ekont*derx_turn(ll,2,1)
10609 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10610 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10611 & +ekont*derx_turn(ll,4,1)
10612 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10613 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10614 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10615 cgrad ghalf=0.5d0*ggg2(ll)
10617 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10618 & +ekont*derx_turn(ll,2,2)
10619 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10620 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10621 & +ekont*derx_turn(ll,4,2)
10622 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10623 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10624 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10629 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10634 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10640 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10645 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10649 cd write (2,*) iii,g_corr6_loc(iii)
10651 eello_turn6=ekont*eel_turn6
10652 cd write (2,*) 'ekont',ekont
10653 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10657 C-----------------------------------------------------------------------------
10658 double precision function scalar(u,v)
10659 !DIR$ INLINEALWAYS scalar
10661 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10664 double precision u(3),v(3)
10665 cd double precision sc
10673 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10676 crc-------------------------------------------------
10677 SUBROUTINE MATVEC2(A1,V1,V2)
10678 !DIR$ INLINEALWAYS MATVEC2
10680 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10682 implicit real*8 (a-h,o-z)
10683 include 'DIMENSIONS'
10684 DIMENSION A1(2,2),V1(2),V2(2)
10688 c 3 VI=VI+A1(I,K)*V1(K)
10692 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10693 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10698 C---------------------------------------
10699 SUBROUTINE MATMAT2(A1,A2,A3)
10701 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10703 implicit real*8 (a-h,o-z)
10704 include 'DIMENSIONS'
10705 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10706 c DIMENSION AI3(2,2)
10710 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10716 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10717 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10718 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10719 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10727 c-------------------------------------------------------------------------
10728 double precision function scalar2(u,v)
10729 !DIR$ INLINEALWAYS scalar2
10731 double precision u(2),v(2)
10732 double precision sc
10734 scalar2=u(1)*v(1)+u(2)*v(2)
10738 C-----------------------------------------------------------------------------
10740 subroutine transpose2(a,at)
10741 !DIR$ INLINEALWAYS transpose2
10743 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10746 double precision a(2,2),at(2,2)
10753 c--------------------------------------------------------------------------
10754 subroutine transpose(n,a,at)
10757 double precision a(n,n),at(n,n)
10765 C---------------------------------------------------------------------------
10766 subroutine prodmat3(a1,a2,kk,transp,prod)
10767 !DIR$ INLINEALWAYS prodmat3
10769 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10773 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10775 crc double precision auxmat(2,2),prod_(2,2)
10778 crc call transpose2(kk(1,1),auxmat(1,1))
10779 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10780 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10782 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10783 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10784 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10785 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10786 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10787 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10788 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10789 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10792 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10793 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10795 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10796 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10797 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10798 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10799 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10800 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10801 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10802 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10805 c call transpose2(a2(1,1),a2t(1,1))
10808 crc print *,((prod_(i,j),i=1,2),j=1,2)
10809 crc print *,((prod(i,j),i=1,2),j=1,2)
10813 CCC----------------------------------------------
10814 subroutine Eliptransfer(eliptran)
10815 implicit real*8 (a-h,o-z)
10816 include 'DIMENSIONS'
10817 include 'COMMON.GEO'
10818 include 'COMMON.VAR'
10819 include 'COMMON.LOCAL'
10820 include 'COMMON.CHAIN'
10821 include 'COMMON.DERIV'
10822 include 'COMMON.NAMES'
10823 include 'COMMON.INTERACT'
10824 include 'COMMON.IOUNITS'
10825 include 'COMMON.CALC'
10826 include 'COMMON.CONTROL'
10827 include 'COMMON.SPLITELE'
10828 include 'COMMON.SBRIDGE'
10829 C this is done by Adasko
10830 C print *,"wchodze"
10831 C structure of box:
10833 C--bordliptop-- buffore starts
10834 C--bufliptop--- here true lipid starts
10836 C--buflipbot--- lipid ends buffore starts
10837 C--bordlipbot--buffore ends
10839 do i=ilip_start,ilip_end
10841 if (itype(i).eq.ntyp1) cycle
10843 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10844 if (positi.le.0) positi=positi+boxzsize
10846 C first for peptide groups
10847 c for each residue check if it is in lipid or lipid water border area
10848 if ((positi.gt.bordlipbot)
10849 &.and.(positi.lt.bordliptop)) then
10850 C the energy transfer exist
10851 if (positi.lt.buflipbot) then
10852 C what fraction I am in
10854 & ((positi-bordlipbot)/lipbufthick)
10855 C lipbufthick is thickenes of lipid buffore
10856 sslip=sscalelip(fracinbuf)
10857 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10858 eliptran=eliptran+sslip*pepliptran
10859 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10860 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10861 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10863 C print *,"doing sccale for lower part"
10864 C print *,i,sslip,fracinbuf,ssgradlip
10865 elseif (positi.gt.bufliptop) then
10866 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10867 sslip=sscalelip(fracinbuf)
10868 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10869 eliptran=eliptran+sslip*pepliptran
10870 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10871 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10872 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10873 C print *, "doing sscalefor top part"
10874 C print *,i,sslip,fracinbuf,ssgradlip
10876 eliptran=eliptran+pepliptran
10877 C print *,"I am in true lipid"
10880 C eliptran=elpitran+0.0 ! I am in water
10883 C print *, "nic nie bylo w lipidzie?"
10884 C now multiply all by the peptide group transfer factor
10885 C eliptran=eliptran*pepliptran
10886 C now the same for side chains
10888 do i=ilip_start,ilip_end
10889 if (itype(i).eq.ntyp1) cycle
10890 positi=(mod(c(3,i+nres),boxzsize))
10891 if (positi.le.0) positi=positi+boxzsize
10892 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10893 c for each residue check if it is in lipid or lipid water border area
10894 C respos=mod(c(3,i+nres),boxzsize)
10895 C print *,positi,bordlipbot,buflipbot
10896 if ((positi.gt.bordlipbot)
10897 & .and.(positi.lt.bordliptop)) then
10898 C the energy transfer exist
10899 if (positi.lt.buflipbot) then
10901 & ((positi-bordlipbot)/lipbufthick)
10902 C lipbufthick is thickenes of lipid buffore
10903 sslip=sscalelip(fracinbuf)
10904 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10905 eliptran=eliptran+sslip*liptranene(itype(i))
10906 gliptranx(3,i)=gliptranx(3,i)
10907 &+ssgradlip*liptranene(itype(i))
10908 gliptranc(3,i-1)= gliptranc(3,i-1)
10909 &+ssgradlip*liptranene(itype(i))
10910 C print *,"doing sccale for lower part"
10911 elseif (positi.gt.bufliptop) then
10913 &((bordliptop-positi)/lipbufthick)
10914 sslip=sscalelip(fracinbuf)
10915 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10916 eliptran=eliptran+sslip*liptranene(itype(i))
10917 gliptranx(3,i)=gliptranx(3,i)
10918 &+ssgradlip*liptranene(itype(i))
10919 gliptranc(3,i-1)= gliptranc(3,i-1)
10920 &+ssgradlip*liptranene(itype(i))
10921 C print *, "doing sscalefor top part",sslip,fracinbuf
10923 eliptran=eliptran+liptranene(itype(i))
10924 C print *,"I am in true lipid"
10926 endif ! if in lipid or buffor
10928 C eliptran=elpitran+0.0 ! I am in water
10932 C---------------------------------------------------------
10933 C AFM soubroutine for constant force
10934 subroutine AFMforce(Eafmforce)
10935 implicit real*8 (a-h,o-z)
10936 include 'DIMENSIONS'
10937 include 'COMMON.GEO'
10938 include 'COMMON.VAR'
10939 include 'COMMON.LOCAL'
10940 include 'COMMON.CHAIN'
10941 include 'COMMON.DERIV'
10942 include 'COMMON.NAMES'
10943 include 'COMMON.INTERACT'
10944 include 'COMMON.IOUNITS'
10945 include 'COMMON.CALC'
10946 include 'COMMON.CONTROL'
10947 include 'COMMON.SPLITELE'
10948 include 'COMMON.SBRIDGE'
10953 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10954 dist=dist+diffafm(i)**2
10957 Eafmforce=-forceAFMconst*(dist-distafminit)
10959 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
10960 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
10962 C print *,'AFM',Eafmforce
10965 C---------------------------------------------------------
10966 C AFM subroutine with pseudoconstant velocity
10967 subroutine AFMvel(Eafmforce)
10968 implicit real*8 (a-h,o-z)
10969 include 'DIMENSIONS'
10970 include 'COMMON.GEO'
10971 include 'COMMON.VAR'
10972 include 'COMMON.LOCAL'
10973 include 'COMMON.CHAIN'
10974 include 'COMMON.DERIV'
10975 include 'COMMON.NAMES'
10976 include 'COMMON.INTERACT'
10977 include 'COMMON.IOUNITS'
10978 include 'COMMON.CALC'
10979 include 'COMMON.CONTROL'
10980 include 'COMMON.SPLITELE'
10981 include 'COMMON.SBRIDGE'
10983 C Only for check grad COMMENT if not used for checkgrad
10985 C--------------------------------------------------------
10986 C print *,"wchodze"
10990 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10991 dist=dist+diffafm(i)**2
10994 Eafmforce=0.5d0*forceAFMconst
10995 & *(distafminit+totTafm*velAFMconst-dist)**2
10996 C Eafmforce=-forceAFMconst*(dist-distafminit)
10998 gradafm(i,afmend-1)=-forceAFMconst*
10999 &(distafminit+totTafm*velAFMconst-dist)
11001 gradafm(i,afmbeg-1)=forceAFMconst*
11002 &(distafminit+totTafm*velAFMconst-dist)
11005 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist