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 min_odl=minval(distancek)
6900 c write (iout,* )"min_odl",min_odl
6902 write (iout,*) "ij dij",i,j,dij
6903 write (iout,*) "distance",(distance(k),k=1,constr_homology)
6904 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
6905 write (iout,* )"min_odl",min_odl
6908 do k=1,constr_homology
6909 c Nie wiem po co to liczycie jeszcze raz!
6910 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
6911 c & (2*(sigma_odl(i,j,k))**2))
6912 if(.not.l_homo(k,ii)) cycle
6913 if (waga_dist.ge.0.0d0) then
6915 c For Gaussian-type Urestr
6917 godl(k)=dexp(-distancek(k)+min_odl)
6918 odleg2=odleg2+godl(k)
6920 c For Lorentzian-type Urestr
6923 odleg2=odleg2+distancek(k)
6926 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
6927 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
6928 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
6929 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
6932 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6933 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6935 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6936 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6938 if (waga_dist.ge.0.0d0) then
6940 c For Gaussian-type Urestr
6942 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
6944 c For Lorentzian-type Urestr
6947 odleg=odleg+odleg2/constr_homology
6950 c write (iout,*) "odleg",odleg ! sum of -ln-s
6953 c For Gaussian-type Urestr
6955 if (waga_dist.ge.0.0d0) sum_godl=odleg2
6957 do k=1,constr_homology
6958 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6959 c & *waga_dist)+min_odl
6960 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
6962 if(.not.l_homo(k,ii)) cycle
6963 if (waga_dist.ge.0.0d0) then
6964 c For Gaussian-type Urestr
6966 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
6968 c For Lorentzian-type Urestr
6971 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
6972 & sigma_odlir(k,ii)**2)**2)
6974 sum_sgodl=sum_sgodl+sgodl
6976 c sgodl2=sgodl2+sgodl
6977 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
6978 c write(iout,*) "constr_homology=",constr_homology
6979 c write(iout,*) i, j, k, "TEST K"
6981 if (waga_dist.ge.0.0d0) then
6983 c For Gaussian-type Urestr
6985 grad_odl3=waga_homology(iset)*waga_dist
6986 & *sum_sgodl/(sum_godl*dij)
6988 c For Lorentzian-type Urestr
6991 c Original grad expr modified by analogy w Gaussian-type Urestr grad
6992 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
6993 grad_odl3=-waga_homology(iset)*waga_dist*
6994 & sum_sgodl/(constr_homology*dij)
6997 c grad_odl3=sum_sgodl/(sum_godl*dij)
7000 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
7001 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
7002 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
7004 ccc write(iout,*) godl, sgodl, grad_odl3
7006 c grad_odl=grad_odl+grad_odl3
7009 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
7010 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
7011 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
7012 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
7013 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
7014 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
7015 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
7016 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
7017 c if (i.eq.25.and.j.eq.27) then
7018 c write(iout,*) "jik",jik,"i",i,"j",j
7019 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
7020 c write(iout,*) "grad_odl3",grad_odl3
7021 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
7022 c write(iout,*) "ggodl",ggodl
7023 c write(iout,*) "ghpbc(",jik,i,")",
7024 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
7028 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
7029 ccc & dLOG(odleg2),"-odleg=", -odleg
7031 enddo ! ii-loop for dist
7033 write(iout,*) "------- dist restrs end -------"
7034 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
7035 c & waga_d.eq.1.0d0) call sum_gradient
7037 c Pseudo-energy and gradient from dihedral-angle restraints from
7038 c homology templates
7039 c write (iout,*) "End of distance loop"
7042 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
7044 write(iout,*) "------- dih restrs start -------"
7045 do i=idihconstr_start_homo,idihconstr_end_homo
7046 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
7049 do i=idihconstr_start_homo,idihconstr_end_homo
7051 c betai=beta(i,i+1,i+2,i+3)
7053 c write (iout,*) "betai =",betai
7054 do k=1,constr_homology
7055 dih_diff(k)=pinorm(dih(k,i)-betai)
7056 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
7057 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
7058 c & -(6.28318-dih_diff(i,k))
7059 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
7060 c & 6.28318+dih_diff(i,k)
7062 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
7063 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
7066 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
7069 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
7070 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
7072 write (iout,*) "i",i," betai",betai," kat2",kat2
7073 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
7075 if (kat2.le.1.0d-14) cycle
7076 kat=kat-dLOG(kat2/constr_homology)
7077 c write (iout,*) "kat",kat ! sum of -ln-s
7079 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
7080 ccc & dLOG(kat2), "-kat=", -kat
7082 c ----------------------------------------------------------------------
7084 c ----------------------------------------------------------------------
7088 do k=1,constr_homology
7089 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
7090 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
7091 sum_sgdih=sum_sgdih+sgdih
7093 c grad_dih3=sum_sgdih/sum_gdih
7094 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
7096 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
7097 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
7098 ccc & gloc(nphi+i-3,icg)
7099 gloc(i,icg)=gloc(i,icg)+grad_dih3
7101 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
7103 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
7104 ccc & gloc(nphi+i-3,icg)
7106 enddo ! i-loop for dih
7108 write(iout,*) "------- dih restrs end -------"
7111 c Pseudo-energy and gradient for theta angle restraints from
7112 c homology templates
7113 c FP 01/15 - inserted from econstr_local_test.F, loop structure
7117 c For constr_homology reference structures (FP)
7119 c Uconst_back_tot=0.0d0
7122 c Econstr_back legacy
7124 c do i=ithet_start,ithet_end
7127 c do i=loc_start,loc_end
7130 duscdiffx(j,i)=0.0d0
7135 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
7136 c write (iout,*) "waga_theta",waga_theta
7137 if (waga_theta.gt.0.0d0) then
7139 write (iout,*) "usampl",usampl
7140 write(iout,*) "------- theta restrs start -------"
7141 c do i=ithet_start,ithet_end
7142 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
7145 c write (iout,*) "maxres",maxres,"nres",nres
7147 do i=ithet_start,ithet_end
7150 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
7152 c Deviation of theta angles wrt constr_homology ref structures
7154 utheta_i=0.0d0 ! argument of Gaussian for single k
7155 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
7156 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
7157 c over residues in a fragment
7158 c write (iout,*) "theta(",i,")=",theta(i)
7159 do k=1,constr_homology
7161 c dtheta_i=theta(j)-thetaref(j,iref)
7162 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
7163 theta_diff(k)=thetatpl(k,i)-theta(i)
7165 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
7166 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
7167 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
7168 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
7169 c Gradient for single Gaussian restraint in subr Econstr_back
7170 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
7173 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
7174 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
7177 c Gradient for multiple Gaussian restraint
7178 sum_gtheta=gutheta_i
7180 do k=1,constr_homology
7181 c New generalized expr for multiple Gaussian from Econstr_back
7182 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
7184 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
7185 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
7187 c Final value of gradient using same var as in Econstr_back
7188 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)
7189 & +sum_sgtheta/sum_gtheta*waga_theta
7190 & *waga_homology(iset)
7191 c dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
7192 c & *waga_homology(iset)
7193 c dutheta(i)=sum_sgtheta/sum_gtheta
7195 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
7196 Eval=Eval-dLOG(gutheta_i/constr_homology)
7197 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
7198 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
7199 c Uconst_back=Uconst_back+utheta(i)
7200 enddo ! (i-loop for theta)
7202 write(iout,*) "------- theta restrs end -------"
7206 c Deviation of local SC geometry
7208 c Separation of two i-loops (instructed by AL - 11/3/2014)
7210 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
7211 c write (iout,*) "waga_d",waga_d
7214 write(iout,*) "------- SC restrs start -------"
7215 write (iout,*) "Initial duscdiff,duscdiffx"
7216 do i=loc_start,loc_end
7217 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
7218 & (duscdiffx(jik,i),jik=1,3)
7221 do i=loc_start,loc_end
7222 usc_diff_i=0.0d0 ! argument of Gaussian for single k
7223 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
7224 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
7225 c write(iout,*) "xxtab, yytab, zztab"
7226 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
7227 do k=1,constr_homology
7229 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
7230 c Original sign inverted for calc of gradients (s. Econstr_back)
7231 dyy=-yytpl(k,i)+yytab(i) ! ibid y
7232 dzz=-zztpl(k,i)+zztab(i) ! ibid z
7233 c write(iout,*) "dxx, dyy, dzz"
7234 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
7236 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
7237 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
7238 c uscdiffk(k)=usc_diff(i)
7239 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
7240 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
7241 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
7242 c & xxref(j),yyref(j),zzref(j)
7247 c Generalized expression for multiple Gaussian acc to that for a single
7248 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
7250 c Original implementation
7251 c sum_guscdiff=guscdiff(i)
7253 c sum_sguscdiff=0.0d0
7254 c do k=1,constr_homology
7255 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
7256 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
7257 c sum_sguscdiff=sum_sguscdiff+sguscdiff
7260 c Implementation of new expressions for gradient (Jan. 2015)
7262 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
7263 do k=1,constr_homology
7265 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
7266 c before. Now the drivatives should be correct
7268 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
7269 c Original sign inverted for calc of gradients (s. Econstr_back)
7270 dyy=-yytpl(k,i)+yytab(i) ! ibid y
7271 dzz=-zztpl(k,i)+zztab(i) ! ibid z
7273 c New implementation
7275 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
7276 & sigma_d(k,i) ! for the grad wrt r'
7277 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
7280 c New implementation
7281 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
7283 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
7284 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
7285 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
7286 duscdiff(jik,i)=duscdiff(jik,i)+
7287 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
7288 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
7289 duscdiffx(jik,i)=duscdiffx(jik,i)+
7290 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
7291 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
7294 write(iout,*) "jik",jik,"i",i
7295 write(iout,*) "dxx, dyy, dzz"
7296 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
7297 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
7298 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
7299 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
7300 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
7301 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
7302 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
7303 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
7304 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
7305 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
7306 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
7307 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
7308 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
7309 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
7310 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
7316 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
7317 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
7319 c write (iout,*) i," uscdiff",uscdiff(i)
7321 c Put together deviations from local geometry
7323 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
7324 c & wfrag_back(3,i,iset)*uscdiff(i)
7325 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
7326 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
7327 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
7328 c Uconst_back=Uconst_back+usc_diff(i)
7330 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
7332 c New implment: multiplied by sum_sguscdiff
7335 enddo ! (i-loop for dscdiff)
7340 write(iout,*) "------- SC restrs end -------"
7341 write (iout,*) "------ After SC loop in e_modeller ------"
7342 do i=loc_start,loc_end
7343 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
7344 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
7346 if (waga_theta.eq.1.0d0) then
7347 write (iout,*) "in e_modeller after SC restr end: dutheta"
7348 do i=ithet_start,ithet_end
7349 write (iout,*) i,dutheta(i)
7352 if (waga_d.eq.1.0d0) then
7353 write (iout,*) "e_modeller after SC loop: duscdiff/x"
7355 write (iout,*) i,(duscdiff(j,i),j=1,3)
7356 write (iout,*) i,(duscdiffx(j,i),j=1,3)
7361 c Total energy from homology restraints
7363 write (iout,*) "odleg",odleg," kat",kat
7366 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
7368 c ehomology_constr=odleg+kat
7370 c For Lorentzian-type Urestr
7373 if (waga_dist.ge.0.0d0) then
7375 c For Gaussian-type Urestr
7377 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
7378 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
7379 c write (iout,*) "ehomology_constr=",ehomology_constr
7382 c For Lorentzian-type Urestr
7384 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
7385 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
7386 c write (iout,*) "ehomology_constr=",ehomology_constr
7389 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
7390 & "Eval",waga_theta,eval,
7391 & "Erot",waga_d,Erot
7392 write (iout,*) "ehomology_constr",ehomology_constr
7398 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
7399 747 format(a12,i4,i4,i4,f8.3,f8.3)
7400 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
7401 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
7402 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
7403 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
7406 c------------------------------------------------------------------------------
7407 subroutine etor_d(etors_d)
7408 C 6/23/01 Compute double torsional energy
7409 implicit real*8 (a-h,o-z)
7410 include 'DIMENSIONS'
7411 include 'COMMON.VAR'
7412 include 'COMMON.GEO'
7413 include 'COMMON.LOCAL'
7414 include 'COMMON.TORSION'
7415 include 'COMMON.INTERACT'
7416 include 'COMMON.DERIV'
7417 include 'COMMON.CHAIN'
7418 include 'COMMON.NAMES'
7419 include 'COMMON.IOUNITS'
7420 include 'COMMON.FFIELD'
7421 include 'COMMON.TORCNSTR'
7422 include 'COMMON.CONTROL'
7424 C Set lprn=.true. for debugging
7428 c write(iout,*) "a tu??"
7429 do i=iphid_start,iphid_end
7430 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7431 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7432 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7433 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7434 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7435 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7436 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7437 & (itype(i+1).eq.ntyp1)) cycle
7438 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7440 itori=itortyp(itype(i-2))
7441 itori1=itortyp(itype(i-1))
7442 itori2=itortyp(itype(i))
7448 if (iabs(itype(i+1)).eq.20) iblock=2
7449 C Iblock=2 Proline type
7450 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7451 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7452 C if (itype(i+1).eq.ntyp1) iblock=3
7453 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7454 C IS or IS NOT need for this
7455 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7456 C is (itype(i-3).eq.ntyp1) ntblock=2
7457 C ntblock is N-terminal blocking group
7459 C Regular cosine and sine terms
7460 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7461 C Example of changes for NH3+ blocking group
7462 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7463 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7464 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7465 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7466 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7467 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7468 cosphi1=dcos(j*phii)
7469 sinphi1=dsin(j*phii)
7470 cosphi2=dcos(j*phii1)
7471 sinphi2=dsin(j*phii1)
7472 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7473 & v2cij*cosphi2+v2sij*sinphi2
7474 if (energy_dec) etors_d_ii=etors_d_ii+
7475 & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
7476 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7477 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7479 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7481 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7482 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7483 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7484 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7485 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7486 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7487 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7488 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7489 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7490 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7491 if (energy_dec) etors_d_ii=etors_d_ii+
7492 & v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7493 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7494 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7495 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7496 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7497 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7500 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7501 & 'etor_d',i,etors_d_ii
7502 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7503 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7508 c------------------------------------------------------------------------------
7509 subroutine eback_sc_corr(esccor)
7510 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7511 c conformational states; temporarily implemented as differences
7512 c between UNRES torsional potentials (dependent on three types of
7513 c residues) and the torsional potentials dependent on all 20 types
7514 c of residues computed from AM1 energy surfaces of terminally-blocked
7515 c amino-acid residues.
7516 implicit real*8 (a-h,o-z)
7517 include 'DIMENSIONS'
7518 include 'COMMON.VAR'
7519 include 'COMMON.GEO'
7520 include 'COMMON.LOCAL'
7521 include 'COMMON.TORSION'
7522 include 'COMMON.SCCOR'
7523 include 'COMMON.INTERACT'
7524 include 'COMMON.DERIV'
7525 include 'COMMON.CHAIN'
7526 include 'COMMON.NAMES'
7527 include 'COMMON.IOUNITS'
7528 include 'COMMON.FFIELD'
7529 include 'COMMON.CONTROL'
7531 C Set lprn=.true. for debugging
7534 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7536 do i=itau_start,itau_end
7537 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7539 isccori=isccortyp(itype(i-2))
7540 isccori1=isccortyp(itype(i-1))
7541 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7543 do intertyp=1,3 !intertyp
7544 cc Added 09 May 2012 (Adasko)
7545 cc Intertyp means interaction type of backbone mainchain correlation:
7546 c 1 = SC...Ca...Ca...Ca
7547 c 2 = Ca...Ca...Ca...SC
7548 c 3 = SC...Ca...Ca...SCi
7550 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7551 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7552 & (itype(i-1).eq.ntyp1)))
7553 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7554 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7555 & .or.(itype(i).eq.ntyp1)))
7556 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7557 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7558 & (itype(i-3).eq.ntyp1)))) cycle
7559 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7560 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7562 do j=1,nterm_sccor(isccori,isccori1)
7563 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7564 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7565 cosphi=dcos(j*tauangle(intertyp,i))
7566 sinphi=dsin(j*tauangle(intertyp,i))
7567 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7568 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7570 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7571 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7573 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7574 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
7575 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
7576 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7577 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7583 c----------------------------------------------------------------------------
7584 subroutine multibody(ecorr)
7585 C This subroutine calculates multi-body contributions to energy following
7586 C the idea of Skolnick et al. If side chains I and J make a contact and
7587 C at the same time side chains I+1 and J+1 make a contact, an extra
7588 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7589 implicit real*8 (a-h,o-z)
7590 include 'DIMENSIONS'
7591 include 'COMMON.IOUNITS'
7592 include 'COMMON.DERIV'
7593 include 'COMMON.INTERACT'
7594 include 'COMMON.CONTACTS'
7595 double precision gx(3),gx1(3)
7598 C Set lprn=.true. for debugging
7602 write (iout,'(a)') 'Contact function values:'
7604 write (iout,'(i2,20(1x,i2,f10.5))')
7605 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7620 num_conti=num_cont(i)
7621 num_conti1=num_cont(i1)
7626 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7627 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7628 cd & ' ishift=',ishift
7629 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7630 C The system gains extra energy.
7631 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7632 endif ! j1==j+-ishift
7641 c------------------------------------------------------------------------------
7642 double precision function esccorr(i,j,k,l,jj,kk)
7643 implicit real*8 (a-h,o-z)
7644 include 'DIMENSIONS'
7645 include 'COMMON.IOUNITS'
7646 include 'COMMON.DERIV'
7647 include 'COMMON.INTERACT'
7648 include 'COMMON.CONTACTS'
7649 double precision gx(3),gx1(3)
7654 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7655 C Calculate the multi-body contribution to energy.
7656 C Calculate multi-body contributions to the gradient.
7657 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7658 cd & k,l,(gacont(m,kk,k),m=1,3)
7660 gx(m) =ekl*gacont(m,jj,i)
7661 gx1(m)=eij*gacont(m,kk,k)
7662 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7663 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7664 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7665 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7669 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7674 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7680 c------------------------------------------------------------------------------
7681 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7682 C This subroutine calculates multi-body contributions to hydrogen-bonding
7683 implicit real*8 (a-h,o-z)
7684 include 'DIMENSIONS'
7685 include 'COMMON.IOUNITS'
7688 parameter (max_cont=maxconts)
7689 parameter (max_dim=26)
7690 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7691 double precision zapas(max_dim,maxconts,max_fg_procs),
7692 & zapas_recv(max_dim,maxconts,max_fg_procs)
7693 common /przechowalnia/ zapas
7694 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7695 & status_array(MPI_STATUS_SIZE,maxconts*2)
7697 include 'COMMON.SETUP'
7698 include 'COMMON.FFIELD'
7699 include 'COMMON.DERIV'
7700 include 'COMMON.INTERACT'
7701 include 'COMMON.CONTACTS'
7702 include 'COMMON.CONTROL'
7703 include 'COMMON.LOCAL'
7704 double precision gx(3),gx1(3),time00
7707 C Set lprn=.true. for debugging
7712 if (nfgtasks.le.1) goto 30
7714 write (iout,'(a)') 'Contact function values before RECEIVE:'
7716 write (iout,'(2i3,50(1x,i2,f5.2))')
7717 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7718 & j=1,num_cont_hb(i))
7722 do i=1,ntask_cont_from
7725 do i=1,ntask_cont_to
7728 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7730 C Make the list of contacts to send to send to other procesors
7731 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7733 do i=iturn3_start,iturn3_end
7734 c write (iout,*) "make contact list turn3",i," num_cont",
7736 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7738 do i=iturn4_start,iturn4_end
7739 c write (iout,*) "make contact list turn4",i," num_cont",
7741 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7745 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7747 do j=1,num_cont_hb(i)
7750 iproc=iint_sent_local(k,jjc,ii)
7751 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7752 if (iproc.gt.0) then
7753 ncont_sent(iproc)=ncont_sent(iproc)+1
7754 nn=ncont_sent(iproc)
7756 zapas(2,nn,iproc)=jjc
7757 zapas(3,nn,iproc)=facont_hb(j,i)
7758 zapas(4,nn,iproc)=ees0p(j,i)
7759 zapas(5,nn,iproc)=ees0m(j,i)
7760 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7761 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7762 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7763 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7764 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7765 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7766 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7767 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7768 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7769 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7770 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7771 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7772 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7773 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7774 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7775 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7776 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7777 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7778 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7779 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7780 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7787 & "Numbers of contacts to be sent to other processors",
7788 & (ncont_sent(i),i=1,ntask_cont_to)
7789 write (iout,*) "Contacts sent"
7790 do ii=1,ntask_cont_to
7792 iproc=itask_cont_to(ii)
7793 write (iout,*) nn," contacts to processor",iproc,
7794 & " of CONT_TO_COMM group"
7796 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7804 CorrelID1=nfgtasks+fg_rank+1
7806 C Receive the numbers of needed contacts from other processors
7807 do ii=1,ntask_cont_from
7808 iproc=itask_cont_from(ii)
7810 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7811 & FG_COMM,req(ireq),IERR)
7813 c write (iout,*) "IRECV ended"
7815 C Send the number of contacts needed by other processors
7816 do ii=1,ntask_cont_to
7817 iproc=itask_cont_to(ii)
7819 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7820 & FG_COMM,req(ireq),IERR)
7822 c write (iout,*) "ISEND ended"
7823 c write (iout,*) "number of requests (nn)",ireq
7826 & call MPI_Waitall(ireq,req,status_array,ierr)
7828 c & "Numbers of contacts to be received from other processors",
7829 c & (ncont_recv(i),i=1,ntask_cont_from)
7833 do ii=1,ntask_cont_from
7834 iproc=itask_cont_from(ii)
7836 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7837 c & " of CONT_TO_COMM group"
7841 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7842 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7843 c write (iout,*) "ireq,req",ireq,req(ireq)
7846 C Send the contacts to processors that need them
7847 do ii=1,ntask_cont_to
7848 iproc=itask_cont_to(ii)
7850 c write (iout,*) nn," contacts to processor",iproc,
7851 c & " of CONT_TO_COMM group"
7854 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7855 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7856 c write (iout,*) "ireq,req",ireq,req(ireq)
7858 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7862 c write (iout,*) "number of requests (contacts)",ireq
7863 c write (iout,*) "req",(req(i),i=1,4)
7866 & call MPI_Waitall(ireq,req,status_array,ierr)
7867 do iii=1,ntask_cont_from
7868 iproc=itask_cont_from(iii)
7871 write (iout,*) "Received",nn," contacts from processor",iproc,
7872 & " of CONT_FROM_COMM group"
7875 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7880 ii=zapas_recv(1,i,iii)
7881 c Flag the received contacts to prevent double-counting
7882 jj=-zapas_recv(2,i,iii)
7883 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7885 nnn=num_cont_hb(ii)+1
7888 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7889 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7890 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7891 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7892 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7893 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7894 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7895 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7896 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7897 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7898 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7899 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7900 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7901 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7902 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7903 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7904 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7905 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7906 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7907 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7908 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7909 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7910 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7911 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7916 write (iout,'(a)') 'Contact function values after receive:'
7918 write (iout,'(2i3,50(1x,i3,f5.2))')
7919 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7920 & j=1,num_cont_hb(i))
7927 write (iout,'(a)') 'Contact function values:'
7929 write (iout,'(2i3,50(1x,i3,f5.2))')
7930 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7931 & j=1,num_cont_hb(i))
7935 C Remove the loop below after debugging !!!
7942 C Calculate the local-electrostatic correlation terms
7943 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7945 num_conti=num_cont_hb(i)
7946 num_conti1=num_cont_hb(i+1)
7953 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7954 c & ' jj=',jj,' kk=',kk
7955 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7956 & .or. j.lt.0 .and. j1.gt.0) .and.
7957 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7958 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7959 C The system gains extra energy.
7960 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7961 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7962 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7964 else if (j1.eq.j) then
7965 C Contacts I-J and I-(J+1) occur simultaneously.
7966 C The system loses extra energy.
7967 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7972 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7973 c & ' jj=',jj,' kk=',kk
7975 C Contacts I-J and (I+1)-J occur simultaneously.
7976 C The system loses extra energy.
7977 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7984 c------------------------------------------------------------------------------
7985 subroutine add_hb_contact(ii,jj,itask)
7986 implicit real*8 (a-h,o-z)
7987 include "DIMENSIONS"
7988 include "COMMON.IOUNITS"
7991 parameter (max_cont=maxconts)
7992 parameter (max_dim=26)
7993 include "COMMON.CONTACTS"
7994 double precision zapas(max_dim,maxconts,max_fg_procs),
7995 & zapas_recv(max_dim,maxconts,max_fg_procs)
7996 common /przechowalnia/ zapas
7997 integer i,j,ii,jj,iproc,itask(4),nn
7998 c write (iout,*) "itask",itask
8001 if (iproc.gt.0) then
8002 do j=1,num_cont_hb(ii)
8004 c write (iout,*) "i",ii," j",jj," jjc",jjc
8006 ncont_sent(iproc)=ncont_sent(iproc)+1
8007 nn=ncont_sent(iproc)
8008 zapas(1,nn,iproc)=ii
8009 zapas(2,nn,iproc)=jjc
8010 zapas(3,nn,iproc)=facont_hb(j,ii)
8011 zapas(4,nn,iproc)=ees0p(j,ii)
8012 zapas(5,nn,iproc)=ees0m(j,ii)
8013 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8014 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8015 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8016 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8017 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8018 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8019 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8020 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8021 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8022 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8023 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8024 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8025 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8026 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8027 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8028 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8029 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8030 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8031 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8032 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8033 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8041 c------------------------------------------------------------------------------
8042 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8044 C This subroutine calculates multi-body contributions to hydrogen-bonding
8045 implicit real*8 (a-h,o-z)
8046 include 'DIMENSIONS'
8047 include 'COMMON.IOUNITS'
8050 parameter (max_cont=maxconts)
8051 parameter (max_dim=70)
8052 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8053 double precision zapas(max_dim,maxconts,max_fg_procs),
8054 & zapas_recv(max_dim,maxconts,max_fg_procs)
8055 common /przechowalnia/ zapas
8056 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8057 & status_array(MPI_STATUS_SIZE,maxconts*2)
8059 include 'COMMON.SETUP'
8060 include 'COMMON.FFIELD'
8061 include 'COMMON.DERIV'
8062 include 'COMMON.LOCAL'
8063 include 'COMMON.INTERACT'
8064 include 'COMMON.CONTACTS'
8065 include 'COMMON.CHAIN'
8066 include 'COMMON.CONTROL'
8067 double precision gx(3),gx1(3)
8068 integer num_cont_hb_old(maxres)
8070 double precision eello4,eello5,eelo6,eello_turn6
8071 external eello4,eello5,eello6,eello_turn6
8072 C Set lprn=.true. for debugging
8077 num_cont_hb_old(i)=num_cont_hb(i)
8081 if (nfgtasks.le.1) goto 30
8083 write (iout,'(a)') 'Contact function values before RECEIVE:'
8085 write (iout,'(2i3,50(1x,i2,f5.2))')
8086 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8087 & j=1,num_cont_hb(i))
8091 do i=1,ntask_cont_from
8094 do i=1,ntask_cont_to
8097 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8099 C Make the list of contacts to send to send to other procesors
8100 do i=iturn3_start,iturn3_end
8101 c write (iout,*) "make contact list turn3",i," num_cont",
8103 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8105 do i=iturn4_start,iturn4_end
8106 c write (iout,*) "make contact list turn4",i," num_cont",
8108 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8112 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8114 do j=1,num_cont_hb(i)
8117 iproc=iint_sent_local(k,jjc,ii)
8118 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8119 if (iproc.ne.0) then
8120 ncont_sent(iproc)=ncont_sent(iproc)+1
8121 nn=ncont_sent(iproc)
8123 zapas(2,nn,iproc)=jjc
8124 zapas(3,nn,iproc)=d_cont(j,i)
8128 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8133 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8141 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8152 & "Numbers of contacts to be sent to other processors",
8153 & (ncont_sent(i),i=1,ntask_cont_to)
8154 write (iout,*) "Contacts sent"
8155 do ii=1,ntask_cont_to
8157 iproc=itask_cont_to(ii)
8158 write (iout,*) nn," contacts to processor",iproc,
8159 & " of CONT_TO_COMM group"
8161 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8169 CorrelID1=nfgtasks+fg_rank+1
8171 C Receive the numbers of needed contacts from other processors
8172 do ii=1,ntask_cont_from
8173 iproc=itask_cont_from(ii)
8175 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8176 & FG_COMM,req(ireq),IERR)
8178 c write (iout,*) "IRECV ended"
8180 C Send the number of contacts needed by other processors
8181 do ii=1,ntask_cont_to
8182 iproc=itask_cont_to(ii)
8184 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8185 & FG_COMM,req(ireq),IERR)
8187 c write (iout,*) "ISEND ended"
8188 c write (iout,*) "number of requests (nn)",ireq
8191 & call MPI_Waitall(ireq,req,status_array,ierr)
8193 c & "Numbers of contacts to be received from other processors",
8194 c & (ncont_recv(i),i=1,ntask_cont_from)
8198 do ii=1,ntask_cont_from
8199 iproc=itask_cont_from(ii)
8201 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8202 c & " of CONT_TO_COMM group"
8206 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8207 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8208 c write (iout,*) "ireq,req",ireq,req(ireq)
8211 C Send the contacts to processors that need them
8212 do ii=1,ntask_cont_to
8213 iproc=itask_cont_to(ii)
8215 c write (iout,*) nn," contacts to processor",iproc,
8216 c & " of CONT_TO_COMM group"
8219 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8220 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8221 c write (iout,*) "ireq,req",ireq,req(ireq)
8223 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8227 c write (iout,*) "number of requests (contacts)",ireq
8228 c write (iout,*) "req",(req(i),i=1,4)
8231 & call MPI_Waitall(ireq,req,status_array,ierr)
8232 do iii=1,ntask_cont_from
8233 iproc=itask_cont_from(iii)
8236 write (iout,*) "Received",nn," contacts from processor",iproc,
8237 & " of CONT_FROM_COMM group"
8240 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8245 ii=zapas_recv(1,i,iii)
8246 c Flag the received contacts to prevent double-counting
8247 jj=-zapas_recv(2,i,iii)
8248 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8250 nnn=num_cont_hb(ii)+1
8253 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8257 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8262 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8270 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8279 write (iout,'(a)') 'Contact function values after receive:'
8281 write (iout,'(2i3,50(1x,i3,5f6.3))')
8282 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8283 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8290 write (iout,'(a)') 'Contact function values:'
8292 write (iout,'(2i3,50(1x,i2,5f6.3))')
8293 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8294 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8300 C Remove the loop below after debugging !!!
8307 C Calculate the dipole-dipole interaction energies
8308 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8309 do i=iatel_s,iatel_e+1
8310 num_conti=num_cont_hb(i)
8319 C Calculate the local-electrostatic correlation terms
8320 c write (iout,*) "gradcorr5 in eello5 before loop"
8322 c write (iout,'(i5,3f10.5)')
8323 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8325 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8326 c write (iout,*) "corr loop i",i
8328 num_conti=num_cont_hb(i)
8329 num_conti1=num_cont_hb(i+1)
8336 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8337 c & ' jj=',jj,' kk=',kk
8338 c if (j1.eq.j+1 .or. j1.eq.j-1) then
8339 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8340 & .or. j.lt.0 .and. j1.gt.0) .and.
8341 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8342 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8343 C The system gains extra energy.
8345 sqd1=dsqrt(d_cont(jj,i))
8346 sqd2=dsqrt(d_cont(kk,i1))
8347 sred_geom = sqd1*sqd2
8348 IF (sred_geom.lt.cutoff_corr) THEN
8349 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
8351 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8352 cd & ' jj=',jj,' kk=',kk
8353 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8354 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8356 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8357 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8360 cd write (iout,*) 'sred_geom=',sred_geom,
8361 cd & ' ekont=',ekont,' fprim=',fprimcont,
8362 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8363 cd write (iout,*) "g_contij",g_contij
8364 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8365 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8366 call calc_eello(i,jp,i+1,jp1,jj,kk)
8367 if (wcorr4.gt.0.0d0)
8368 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8369 if (energy_dec.and.wcorr4.gt.0.0d0)
8370 1 write (iout,'(a6,4i5,0pf7.3)')
8371 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8372 c write (iout,*) "gradcorr5 before eello5"
8374 c write (iout,'(i5,3f10.5)')
8375 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8377 if (wcorr5.gt.0.0d0)
8378 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8379 c write (iout,*) "gradcorr5 after eello5"
8381 c write (iout,'(i5,3f10.5)')
8382 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8384 if (energy_dec.and.wcorr5.gt.0.0d0)
8385 1 write (iout,'(a6,4i5,0pf7.3)')
8386 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8387 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8388 cd write(2,*)'ijkl',i,jp,i+1,jp1
8389 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
8390 & .or. wturn6.eq.0.0d0))then
8391 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8392 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8393 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8394 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8395 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8396 cd & 'ecorr6=',ecorr6
8397 cd write (iout,'(4e15.5)') sred_geom,
8398 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8399 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8400 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8401 else if (wturn6.gt.0.0d0
8402 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8403 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8404 eturn6=eturn6+eello_turn6(i,jj,kk)
8405 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8406 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8407 cd write (2,*) 'multibody_eello:eturn6',eturn6
8416 num_cont_hb(i)=num_cont_hb_old(i)
8418 c write (iout,*) "gradcorr5 in eello5"
8420 c write (iout,'(i5,3f10.5)')
8421 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8425 c------------------------------------------------------------------------------
8426 subroutine add_hb_contact_eello(ii,jj,itask)
8427 implicit real*8 (a-h,o-z)
8428 include "DIMENSIONS"
8429 include "COMMON.IOUNITS"
8432 parameter (max_cont=maxconts)
8433 parameter (max_dim=70)
8434 include "COMMON.CONTACTS"
8435 double precision zapas(max_dim,maxconts,max_fg_procs),
8436 & zapas_recv(max_dim,maxconts,max_fg_procs)
8437 common /przechowalnia/ zapas
8438 integer i,j,ii,jj,iproc,itask(4),nn
8439 c write (iout,*) "itask",itask
8442 if (iproc.gt.0) then
8443 do j=1,num_cont_hb(ii)
8445 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8447 ncont_sent(iproc)=ncont_sent(iproc)+1
8448 nn=ncont_sent(iproc)
8449 zapas(1,nn,iproc)=ii
8450 zapas(2,nn,iproc)=jjc
8451 zapas(3,nn,iproc)=d_cont(j,ii)
8455 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8460 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8468 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8480 c------------------------------------------------------------------------------
8481 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8482 implicit real*8 (a-h,o-z)
8483 include 'DIMENSIONS'
8484 include 'COMMON.IOUNITS'
8485 include 'COMMON.DERIV'
8486 include 'COMMON.INTERACT'
8487 include 'COMMON.CONTACTS'
8488 double precision gx(3),gx1(3)
8498 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8499 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8500 C Following 4 lines for diagnostics.
8505 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8506 c & 'Contacts ',i,j,
8507 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8508 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8510 C Calculate the multi-body contribution to energy.
8511 c ecorr=ecorr+ekont*ees
8512 C Calculate multi-body contributions to the gradient.
8513 coeffpees0pij=coeffp*ees0pij
8514 coeffmees0mij=coeffm*ees0mij
8515 coeffpees0pkl=coeffp*ees0pkl
8516 coeffmees0mkl=coeffm*ees0mkl
8518 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8519 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8520 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8521 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8522 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8523 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8524 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8525 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8526 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8527 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8528 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8529 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8530 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8531 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8532 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8533 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8534 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8535 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8536 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8537 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8538 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8539 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8540 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8541 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8542 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8547 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8548 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8549 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8550 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8555 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8556 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8557 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8558 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8561 c write (iout,*) "ehbcorr",ekont*ees
8566 C---------------------------------------------------------------------------
8567 subroutine dipole(i,j,jj)
8568 implicit real*8 (a-h,o-z)
8569 include 'DIMENSIONS'
8570 include 'COMMON.IOUNITS'
8571 include 'COMMON.CHAIN'
8572 include 'COMMON.FFIELD'
8573 include 'COMMON.DERIV'
8574 include 'COMMON.INTERACT'
8575 include 'COMMON.CONTACTS'
8576 include 'COMMON.TORSION'
8577 include 'COMMON.VAR'
8578 include 'COMMON.GEO'
8579 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8581 iti1 = itortyp(itype(i+1))
8582 if (j.lt.nres-1) then
8583 itj1 = itortyp(itype(j+1))
8588 dipi(iii,1)=Ub2(iii,i)
8589 dipderi(iii)=Ub2der(iii,i)
8590 dipi(iii,2)=b1(iii,i+1)
8591 dipj(iii,1)=Ub2(iii,j)
8592 dipderj(iii)=Ub2der(iii,j)
8593 dipj(iii,2)=b1(iii,j+1)
8597 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8600 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8607 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8611 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8616 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8617 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8619 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8621 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8623 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8628 C---------------------------------------------------------------------------
8629 subroutine calc_eello(i,j,k,l,jj,kk)
8631 C This subroutine computes matrices and vectors needed to calculate
8632 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8634 implicit real*8 (a-h,o-z)
8635 include 'DIMENSIONS'
8636 include 'COMMON.IOUNITS'
8637 include 'COMMON.CHAIN'
8638 include 'COMMON.DERIV'
8639 include 'COMMON.INTERACT'
8640 include 'COMMON.CONTACTS'
8641 include 'COMMON.TORSION'
8642 include 'COMMON.VAR'
8643 include 'COMMON.GEO'
8644 include 'COMMON.FFIELD'
8645 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8646 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8649 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8650 cd & ' jj=',jj,' kk=',kk
8651 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8652 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8653 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8656 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8657 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8660 call transpose2(aa1(1,1),aa1t(1,1))
8661 call transpose2(aa2(1,1),aa2t(1,1))
8664 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8665 & aa1tder(1,1,lll,kkk))
8666 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8667 & aa2tder(1,1,lll,kkk))
8671 C parallel orientation of the two CA-CA-CA frames.
8673 iti=itortyp(itype(i))
8677 itk1=itortyp(itype(k+1))
8678 itj=itortyp(itype(j))
8679 if (l.lt.nres-1) then
8680 itl1=itortyp(itype(l+1))
8684 C A1 kernel(j+1) A2T
8686 cd write (iout,'(3f10.5,5x,3f10.5)')
8687 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8689 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8690 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8691 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8692 C Following matrices are needed only for 6-th order cumulants
8693 IF (wcorr6.gt.0.0d0) THEN
8694 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8695 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8696 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8697 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8698 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8699 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8700 & ADtEAderx(1,1,1,1,1,1))
8702 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8703 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8704 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8705 & ADtEA1derx(1,1,1,1,1,1))
8707 C End 6-th order cumulants
8710 cd write (2,*) 'In calc_eello6'
8712 cd write (2,*) 'iii=',iii
8714 cd write (2,*) 'kkk=',kkk
8716 cd write (2,'(3(2f10.5),5x)')
8717 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8722 call transpose2(EUgder(1,1,k),auxmat(1,1))
8723 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8724 call transpose2(EUg(1,1,k),auxmat(1,1))
8725 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8726 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8730 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8731 & EAEAderx(1,1,lll,kkk,iii,1))
8735 C A1T kernel(i+1) A2
8736 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8737 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8738 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8739 C Following matrices are needed only for 6-th order cumulants
8740 IF (wcorr6.gt.0.0d0) THEN
8741 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8742 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8743 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8744 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8745 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8746 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8747 & ADtEAderx(1,1,1,1,1,2))
8748 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8749 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8750 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8751 & ADtEA1derx(1,1,1,1,1,2))
8753 C End 6-th order cumulants
8754 call transpose2(EUgder(1,1,l),auxmat(1,1))
8755 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8756 call transpose2(EUg(1,1,l),auxmat(1,1))
8757 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8758 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8762 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8763 & EAEAderx(1,1,lll,kkk,iii,2))
8768 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8769 C They are needed only when the fifth- or the sixth-order cumulants are
8771 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8772 call transpose2(AEA(1,1,1),auxmat(1,1))
8773 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8774 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8775 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8776 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8777 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8778 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8779 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8780 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8781 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8782 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8783 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8784 call transpose2(AEA(1,1,2),auxmat(1,1))
8785 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8786 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8787 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8788 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8789 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8790 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8791 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8792 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8793 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8794 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8795 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8796 C Calculate the Cartesian derivatives of the vectors.
8800 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8801 call matvec2(auxmat(1,1),b1(1,i),
8802 & AEAb1derx(1,lll,kkk,iii,1,1))
8803 call matvec2(auxmat(1,1),Ub2(1,i),
8804 & AEAb2derx(1,lll,kkk,iii,1,1))
8805 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8806 & AEAb1derx(1,lll,kkk,iii,2,1))
8807 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8808 & AEAb2derx(1,lll,kkk,iii,2,1))
8809 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8810 call matvec2(auxmat(1,1),b1(1,j),
8811 & AEAb1derx(1,lll,kkk,iii,1,2))
8812 call matvec2(auxmat(1,1),Ub2(1,j),
8813 & AEAb2derx(1,lll,kkk,iii,1,2))
8814 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8815 & AEAb1derx(1,lll,kkk,iii,2,2))
8816 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8817 & AEAb2derx(1,lll,kkk,iii,2,2))
8824 C Antiparallel orientation of the two CA-CA-CA frames.
8826 iti=itortyp(itype(i))
8830 itk1=itortyp(itype(k+1))
8831 itl=itortyp(itype(l))
8832 itj=itortyp(itype(j))
8833 if (j.lt.nres-1) then
8834 itj1=itortyp(itype(j+1))
8838 C A2 kernel(j-1)T A1T
8839 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8840 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8841 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8842 C Following matrices are needed only for 6-th order cumulants
8843 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8844 & j.eq.i+4 .and. l.eq.i+3)) THEN
8845 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8846 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8847 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8848 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8849 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8850 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8851 & ADtEAderx(1,1,1,1,1,1))
8852 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8853 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8854 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8855 & ADtEA1derx(1,1,1,1,1,1))
8857 C End 6-th order cumulants
8858 call transpose2(EUgder(1,1,k),auxmat(1,1))
8859 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8860 call transpose2(EUg(1,1,k),auxmat(1,1))
8861 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8862 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8866 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8867 & EAEAderx(1,1,lll,kkk,iii,1))
8871 C A2T kernel(i+1)T A1
8872 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8873 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8874 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8875 C Following matrices are needed only for 6-th order cumulants
8876 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8877 & j.eq.i+4 .and. l.eq.i+3)) THEN
8878 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8879 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8880 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8881 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8882 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8883 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8884 & ADtEAderx(1,1,1,1,1,2))
8885 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8886 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8887 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8888 & ADtEA1derx(1,1,1,1,1,2))
8890 C End 6-th order cumulants
8891 call transpose2(EUgder(1,1,j),auxmat(1,1))
8892 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8893 call transpose2(EUg(1,1,j),auxmat(1,1))
8894 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8895 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8899 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8900 & EAEAderx(1,1,lll,kkk,iii,2))
8905 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8906 C They are needed only when the fifth- or the sixth-order cumulants are
8908 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8909 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8910 call transpose2(AEA(1,1,1),auxmat(1,1))
8911 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8912 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8913 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8914 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8915 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8916 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8917 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8918 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8919 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8920 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8921 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8922 call transpose2(AEA(1,1,2),auxmat(1,1))
8923 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8924 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8925 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8926 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8927 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8928 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8929 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8930 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8931 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8932 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8933 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8934 C Calculate the Cartesian derivatives of the vectors.
8938 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8939 call matvec2(auxmat(1,1),b1(1,i),
8940 & AEAb1derx(1,lll,kkk,iii,1,1))
8941 call matvec2(auxmat(1,1),Ub2(1,i),
8942 & AEAb2derx(1,lll,kkk,iii,1,1))
8943 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8944 & AEAb1derx(1,lll,kkk,iii,2,1))
8945 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8946 & AEAb2derx(1,lll,kkk,iii,2,1))
8947 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8948 call matvec2(auxmat(1,1),b1(1,l),
8949 & AEAb1derx(1,lll,kkk,iii,1,2))
8950 call matvec2(auxmat(1,1),Ub2(1,l),
8951 & AEAb2derx(1,lll,kkk,iii,1,2))
8952 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8953 & AEAb1derx(1,lll,kkk,iii,2,2))
8954 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8955 & AEAb2derx(1,lll,kkk,iii,2,2))
8964 C---------------------------------------------------------------------------
8965 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8966 & KK,KKderg,AKA,AKAderg,AKAderx)
8970 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8971 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8972 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8977 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8979 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8982 cd if (lprn) write (2,*) 'In kernel'
8984 cd if (lprn) write (2,*) 'kkk=',kkk
8986 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8987 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8989 cd write (2,*) 'lll=',lll
8990 cd write (2,*) 'iii=1'
8992 cd write (2,'(3(2f10.5),5x)')
8993 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8996 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8997 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8999 cd write (2,*) 'lll=',lll
9000 cd write (2,*) 'iii=2'
9002 cd write (2,'(3(2f10.5),5x)')
9003 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9010 C---------------------------------------------------------------------------
9011 double precision function eello4(i,j,k,l,jj,kk)
9012 implicit real*8 (a-h,o-z)
9013 include 'DIMENSIONS'
9014 include 'COMMON.IOUNITS'
9015 include 'COMMON.CHAIN'
9016 include 'COMMON.DERIV'
9017 include 'COMMON.INTERACT'
9018 include 'COMMON.CONTACTS'
9019 include 'COMMON.TORSION'
9020 include 'COMMON.VAR'
9021 include 'COMMON.GEO'
9022 double precision pizda(2,2),ggg1(3),ggg2(3)
9023 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9027 cd print *,'eello4:',i,j,k,l,jj,kk
9028 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9029 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9030 cold eij=facont_hb(jj,i)
9031 cold ekl=facont_hb(kk,k)
9033 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9034 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9035 gcorr_loc(k-1)=gcorr_loc(k-1)
9036 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9038 gcorr_loc(l-1)=gcorr_loc(l-1)
9039 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9041 gcorr_loc(j-1)=gcorr_loc(j-1)
9042 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9047 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9048 & -EAEAderx(2,2,lll,kkk,iii,1)
9049 cd derx(lll,kkk,iii)=0.0d0
9053 cd gcorr_loc(l-1)=0.0d0
9054 cd gcorr_loc(j-1)=0.0d0
9055 cd gcorr_loc(k-1)=0.0d0
9057 cd write (iout,*)'Contacts have occurred for peptide groups',
9058 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9059 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9060 if (j.lt.nres-1) then
9067 if (l.lt.nres-1) then
9075 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9076 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9077 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9078 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9079 cgrad ghalf=0.5d0*ggg1(ll)
9080 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9081 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9082 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9083 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9084 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9085 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9086 cgrad ghalf=0.5d0*ggg2(ll)
9087 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9088 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9089 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9090 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9091 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9092 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9096 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9101 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9106 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9111 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9115 cd write (2,*) iii,gcorr_loc(iii)
9118 cd write (2,*) 'ekont',ekont
9119 cd write (iout,*) 'eello4',ekont*eel4
9122 C---------------------------------------------------------------------------
9123 double precision function eello5(i,j,k,l,jj,kk)
9124 implicit real*8 (a-h,o-z)
9125 include 'DIMENSIONS'
9126 include 'COMMON.IOUNITS'
9127 include 'COMMON.CHAIN'
9128 include 'COMMON.DERIV'
9129 include 'COMMON.INTERACT'
9130 include 'COMMON.CONTACTS'
9131 include 'COMMON.TORSION'
9132 include 'COMMON.VAR'
9133 include 'COMMON.GEO'
9134 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9135 double precision ggg1(3),ggg2(3)
9136 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9141 C /l\ / \ \ / \ / \ / C
9142 C / \ / \ \ / \ / \ / C
9143 C j| o |l1 | o | o| o | | o |o C
9144 C \ |/k\| |/ \| / |/ \| |/ \| C
9145 C \i/ \ / \ / / \ / \ C
9147 C (I) (II) (III) (IV) C
9149 C eello5_1 eello5_2 eello5_3 eello5_4 C
9151 C Antiparallel chains C
9154 C /j\ / \ \ / \ / \ / C
9155 C / \ / \ \ / \ / \ / C
9156 C j1| o |l | o | o| o | | o |o C
9157 C \ |/k\| |/ \| / |/ \| |/ \| C
9158 C \i/ \ / \ / / \ / \ C
9160 C (I) (II) (III) (IV) C
9162 C eello5_1 eello5_2 eello5_3 eello5_4 C
9164 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9166 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9167 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9172 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9174 itk=itortyp(itype(k))
9175 itl=itortyp(itype(l))
9176 itj=itortyp(itype(j))
9181 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9182 cd & eel5_3_num,eel5_4_num)
9186 derx(lll,kkk,iii)=0.0d0
9190 cd eij=facont_hb(jj,i)
9191 cd ekl=facont_hb(kk,k)
9193 cd write (iout,*)'Contacts have occurred for peptide groups',
9194 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9196 C Contribution from the graph I.
9197 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9198 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9199 call transpose2(EUg(1,1,k),auxmat(1,1))
9200 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9201 vv(1)=pizda(1,1)-pizda(2,2)
9202 vv(2)=pizda(1,2)+pizda(2,1)
9203 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9204 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9205 C Explicit gradient in virtual-dihedral angles.
9206 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9207 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9208 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9209 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9210 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9211 vv(1)=pizda(1,1)-pizda(2,2)
9212 vv(2)=pizda(1,2)+pizda(2,1)
9213 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9214 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9215 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9216 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9217 vv(1)=pizda(1,1)-pizda(2,2)
9218 vv(2)=pizda(1,2)+pizda(2,1)
9220 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9221 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9222 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9224 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9225 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9226 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9228 C Cartesian gradient
9232 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
9234 vv(1)=pizda(1,1)-pizda(2,2)
9235 vv(2)=pizda(1,2)+pizda(2,1)
9236 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9237 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
9238 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9244 C Contribution from graph II
9245 call transpose2(EE(1,1,itk),auxmat(1,1))
9246 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9247 vv(1)=pizda(1,1)+pizda(2,2)
9248 vv(2)=pizda(2,1)-pizda(1,2)
9249 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
9250 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9251 C Explicit gradient in virtual-dihedral angles.
9252 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9253 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9254 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9255 vv(1)=pizda(1,1)+pizda(2,2)
9256 vv(2)=pizda(2,1)-pizda(1,2)
9258 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9259 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9260 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9262 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9263 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9264 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9266 C Cartesian gradient
9270 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9272 vv(1)=pizda(1,1)+pizda(2,2)
9273 vv(2)=pizda(2,1)-pizda(1,2)
9274 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9275 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
9276 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9284 C Parallel orientation
9285 C Contribution from graph III
9286 call transpose2(EUg(1,1,l),auxmat(1,1))
9287 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9288 vv(1)=pizda(1,1)-pizda(2,2)
9289 vv(2)=pizda(1,2)+pizda(2,1)
9290 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
9291 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9292 C Explicit gradient in virtual-dihedral angles.
9293 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9294 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
9295 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9296 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9297 vv(1)=pizda(1,1)-pizda(2,2)
9298 vv(2)=pizda(1,2)+pizda(2,1)
9299 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9300 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
9301 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9302 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9303 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9304 vv(1)=pizda(1,1)-pizda(2,2)
9305 vv(2)=pizda(1,2)+pizda(2,1)
9306 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9307 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
9308 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9309 C Cartesian gradient
9313 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9315 vv(1)=pizda(1,1)-pizda(2,2)
9316 vv(2)=pizda(1,2)+pizda(2,1)
9317 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9318 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
9319 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9324 C Contribution from graph IV
9326 call transpose2(EE(1,1,itl),auxmat(1,1))
9327 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9328 vv(1)=pizda(1,1)+pizda(2,2)
9329 vv(2)=pizda(2,1)-pizda(1,2)
9330 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
9331 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9332 C Explicit gradient in virtual-dihedral angles.
9333 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9334 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9335 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9336 vv(1)=pizda(1,1)+pizda(2,2)
9337 vv(2)=pizda(2,1)-pizda(1,2)
9338 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9339 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
9340 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9341 C Cartesian gradient
9345 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9347 vv(1)=pizda(1,1)+pizda(2,2)
9348 vv(2)=pizda(2,1)-pizda(1,2)
9349 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9350 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
9351 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9356 C Antiparallel orientation
9357 C Contribution from graph III
9359 call transpose2(EUg(1,1,j),auxmat(1,1))
9360 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9361 vv(1)=pizda(1,1)-pizda(2,2)
9362 vv(2)=pizda(1,2)+pizda(2,1)
9363 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9364 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9365 C Explicit gradient in virtual-dihedral angles.
9366 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9367 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9368 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9369 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9370 vv(1)=pizda(1,1)-pizda(2,2)
9371 vv(2)=pizda(1,2)+pizda(2,1)
9372 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9373 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9374 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9375 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9376 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9377 vv(1)=pizda(1,1)-pizda(2,2)
9378 vv(2)=pizda(1,2)+pizda(2,1)
9379 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9380 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9381 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9382 C Cartesian gradient
9386 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9388 vv(1)=pizda(1,1)-pizda(2,2)
9389 vv(2)=pizda(1,2)+pizda(2,1)
9390 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9391 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9392 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9397 C Contribution from graph IV
9399 call transpose2(EE(1,1,itj),auxmat(1,1))
9400 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9401 vv(1)=pizda(1,1)+pizda(2,2)
9402 vv(2)=pizda(2,1)-pizda(1,2)
9403 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9404 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9405 C Explicit gradient in virtual-dihedral angles.
9406 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9407 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9408 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9409 vv(1)=pizda(1,1)+pizda(2,2)
9410 vv(2)=pizda(2,1)-pizda(1,2)
9411 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9412 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9413 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9414 C Cartesian gradient
9418 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9420 vv(1)=pizda(1,1)+pizda(2,2)
9421 vv(2)=pizda(2,1)-pizda(1,2)
9422 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9423 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9424 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9430 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9431 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9432 cd write (2,*) 'ijkl',i,j,k,l
9433 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9434 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9436 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9437 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9438 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9439 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9440 if (j.lt.nres-1) then
9447 if (l.lt.nres-1) then
9457 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9458 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9459 C summed up outside the subrouine as for the other subroutines
9460 C handling long-range interactions. The old code is commented out
9461 C with "cgrad" to keep track of changes.
9463 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9464 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9465 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9466 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9467 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9468 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9469 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9470 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9471 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9472 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9474 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9475 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9476 cgrad ghalf=0.5d0*ggg1(ll)
9478 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9479 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9480 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9481 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9482 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9483 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9484 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9485 cgrad ghalf=0.5d0*ggg2(ll)
9487 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
9488 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9489 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
9490 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9491 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9492 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9497 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9498 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9503 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9504 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9510 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9515 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9519 cd write (2,*) iii,g_corr5_loc(iii)
9522 cd write (2,*) 'ekont',ekont
9523 cd write (iout,*) 'eello5',ekont*eel5
9526 c--------------------------------------------------------------------------
9527 double precision function eello6(i,j,k,l,jj,kk)
9528 implicit real*8 (a-h,o-z)
9529 include 'DIMENSIONS'
9530 include 'COMMON.IOUNITS'
9531 include 'COMMON.CHAIN'
9532 include 'COMMON.DERIV'
9533 include 'COMMON.INTERACT'
9534 include 'COMMON.CONTACTS'
9535 include 'COMMON.TORSION'
9536 include 'COMMON.VAR'
9537 include 'COMMON.GEO'
9538 include 'COMMON.FFIELD'
9539 double precision ggg1(3),ggg2(3)
9540 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9545 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9553 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9554 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9558 derx(lll,kkk,iii)=0.0d0
9562 cd eij=facont_hb(jj,i)
9563 cd ekl=facont_hb(kk,k)
9569 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9570 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9571 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9572 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9573 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9574 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9576 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9577 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9578 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9579 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9580 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9581 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9585 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9587 C If turn contributions are considered, they will be handled separately.
9588 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9589 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9590 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9591 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9592 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9593 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9594 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9596 if (j.lt.nres-1) then
9603 if (l.lt.nres-1) then
9611 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9612 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9613 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9614 cgrad ghalf=0.5d0*ggg1(ll)
9616 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9617 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9618 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9619 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9620 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9621 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9622 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9623 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9624 cgrad ghalf=0.5d0*ggg2(ll)
9625 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9627 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9628 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9629 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9630 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9631 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9632 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9637 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9638 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9643 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9644 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9650 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9655 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9659 cd write (2,*) iii,g_corr6_loc(iii)
9662 cd write (2,*) 'ekont',ekont
9663 cd write (iout,*) 'eello6',ekont*eel6
9666 c--------------------------------------------------------------------------
9667 double precision function eello6_graph1(i,j,k,l,imat,swap)
9668 implicit real*8 (a-h,o-z)
9669 include 'DIMENSIONS'
9670 include 'COMMON.IOUNITS'
9671 include 'COMMON.CHAIN'
9672 include 'COMMON.DERIV'
9673 include 'COMMON.INTERACT'
9674 include 'COMMON.CONTACTS'
9675 include 'COMMON.TORSION'
9676 include 'COMMON.VAR'
9677 include 'COMMON.GEO'
9678 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9682 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9684 C Parallel Antiparallel C
9690 C \ j|/k\| / \ |/k\|l / C
9695 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9696 itk=itortyp(itype(k))
9697 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9698 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9699 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9700 call transpose2(EUgC(1,1,k),auxmat(1,1))
9701 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9702 vv1(1)=pizda1(1,1)-pizda1(2,2)
9703 vv1(2)=pizda1(1,2)+pizda1(2,1)
9704 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9705 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9706 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9707 s5=scalar2(vv(1),Dtobr2(1,i))
9708 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9709 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9710 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9711 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9712 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9713 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9714 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9715 & +scalar2(vv(1),Dtobr2der(1,i)))
9716 call matmat2(AEAderg(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 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9720 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9722 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9723 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9724 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9725 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9726 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9728 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9729 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9730 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9731 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9732 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9734 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9735 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9736 vv1(1)=pizda1(1,1)-pizda1(2,2)
9737 vv1(2)=pizda1(1,2)+pizda1(2,1)
9738 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9739 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9740 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9741 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9750 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9751 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9752 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9753 call transpose2(EUgC(1,1,k),auxmat(1,1))
9754 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9756 vv1(1)=pizda1(1,1)-pizda1(2,2)
9757 vv1(2)=pizda1(1,2)+pizda1(2,1)
9758 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9759 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9760 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9761 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9762 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9763 s5=scalar2(vv(1),Dtobr2(1,i))
9764 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9770 c----------------------------------------------------------------------------
9771 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9772 implicit real*8 (a-h,o-z)
9773 include 'DIMENSIONS'
9774 include 'COMMON.IOUNITS'
9775 include 'COMMON.CHAIN'
9776 include 'COMMON.DERIV'
9777 include 'COMMON.INTERACT'
9778 include 'COMMON.CONTACTS'
9779 include 'COMMON.TORSION'
9780 include 'COMMON.VAR'
9781 include 'COMMON.GEO'
9783 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9784 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9787 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9789 C Parallel Antiparallel C
9795 C \ j|/k\| \ |/k\|l C
9800 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9801 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9802 C AL 7/4/01 s1 would occur in the sixth-order moment,
9803 C but not in a cluster cumulant
9805 s1=dip(1,jj,i)*dip(1,kk,k)
9807 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9808 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9809 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9810 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9811 call transpose2(EUg(1,1,k),auxmat(1,1))
9812 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9813 vv(1)=pizda(1,1)-pizda(2,2)
9814 vv(2)=pizda(1,2)+pizda(2,1)
9815 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9816 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9818 eello6_graph2=-(s1+s2+s3+s4)
9820 eello6_graph2=-(s2+s3+s4)
9823 C Derivatives in gamma(i-1)
9826 s1=dipderg(1,jj,i)*dip(1,kk,k)
9828 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9829 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9830 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9831 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9833 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9835 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9837 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9839 C Derivatives in gamma(k-1)
9841 s1=dip(1,jj,i)*dipderg(1,kk,k)
9843 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9844 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9845 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9846 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9847 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9848 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9849 vv(1)=pizda(1,1)-pizda(2,2)
9850 vv(2)=pizda(1,2)+pizda(2,1)
9851 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9853 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9855 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9857 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9858 C Derivatives in gamma(j-1) or gamma(l-1)
9861 s1=dipderg(3,jj,i)*dip(1,kk,k)
9863 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9864 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9865 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9866 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9867 vv(1)=pizda(1,1)-pizda(2,2)
9868 vv(2)=pizda(1,2)+pizda(2,1)
9869 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9872 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9874 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9877 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9878 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9880 C Derivatives in gamma(l-1) or gamma(j-1)
9883 s1=dip(1,jj,i)*dipderg(3,kk,k)
9885 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9886 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9887 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9888 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9889 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9890 vv(1)=pizda(1,1)-pizda(2,2)
9891 vv(2)=pizda(1,2)+pizda(2,1)
9892 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9895 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9897 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9900 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9901 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9903 C Cartesian derivatives.
9905 write (2,*) 'In eello6_graph2'
9907 write (2,*) 'iii=',iii
9909 write (2,*) 'kkk=',kkk
9911 write (2,'(3(2f10.5),5x)')
9912 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9922 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9924 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9927 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9929 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9930 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9932 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9933 call transpose2(EUg(1,1,k),auxmat(1,1))
9934 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9936 vv(1)=pizda(1,1)-pizda(2,2)
9937 vv(2)=pizda(1,2)+pizda(2,1)
9938 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9939 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9941 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9943 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9946 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9948 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9955 c----------------------------------------------------------------------------
9956 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9957 implicit real*8 (a-h,o-z)
9958 include 'DIMENSIONS'
9959 include 'COMMON.IOUNITS'
9960 include 'COMMON.CHAIN'
9961 include 'COMMON.DERIV'
9962 include 'COMMON.INTERACT'
9963 include 'COMMON.CONTACTS'
9964 include 'COMMON.TORSION'
9965 include 'COMMON.VAR'
9966 include 'COMMON.GEO'
9967 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9969 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9971 C Parallel Antiparallel C
9977 C j|/k\| / |/k\|l / C
9982 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9984 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9985 C energy moment and not to the cluster cumulant.
9986 iti=itortyp(itype(i))
9987 if (j.lt.nres-1) then
9988 itj1=itortyp(itype(j+1))
9992 itk=itortyp(itype(k))
9993 itk1=itortyp(itype(k+1))
9994 if (l.lt.nres-1) then
9995 itl1=itortyp(itype(l+1))
10000 s1=dip(4,jj,i)*dip(4,kk,k)
10002 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
10003 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10004 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
10005 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10006 call transpose2(EE(1,1,itk),auxmat(1,1))
10007 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10008 vv(1)=pizda(1,1)+pizda(2,2)
10009 vv(2)=pizda(2,1)-pizda(1,2)
10010 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10011 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10012 cd & "sum",-(s2+s3+s4)
10014 eello6_graph3=-(s1+s2+s3+s4)
10016 eello6_graph3=-(s2+s3+s4)
10018 c eello6_graph3=-s4
10019 C Derivatives in gamma(k-1)
10020 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
10021 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10022 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10023 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10024 C Derivatives in gamma(l-1)
10025 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
10026 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10027 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10028 vv(1)=pizda(1,1)+pizda(2,2)
10029 vv(2)=pizda(2,1)-pizda(1,2)
10030 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10031 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10032 C Cartesian derivatives.
10038 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10040 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10043 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
10045 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10046 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
10048 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10049 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
10051 vv(1)=pizda(1,1)+pizda(2,2)
10052 vv(2)=pizda(2,1)-pizda(1,2)
10053 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10055 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10057 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10060 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10062 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10064 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10070 c----------------------------------------------------------------------------
10071 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10072 implicit real*8 (a-h,o-z)
10073 include 'DIMENSIONS'
10074 include 'COMMON.IOUNITS'
10075 include 'COMMON.CHAIN'
10076 include 'COMMON.DERIV'
10077 include 'COMMON.INTERACT'
10078 include 'COMMON.CONTACTS'
10079 include 'COMMON.TORSION'
10080 include 'COMMON.VAR'
10081 include 'COMMON.GEO'
10082 include 'COMMON.FFIELD'
10083 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10084 & auxvec1(2),auxmat1(2,2)
10086 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10088 C Parallel Antiparallel C
10093 C /| o |o o| o |\ C
10094 C \ j|/k\| \ |/k\|l C
10099 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10101 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10102 C energy moment and not to the cluster cumulant.
10103 cd write (2,*) 'eello_graph4: wturn6',wturn6
10104 iti=itortyp(itype(i))
10105 itj=itortyp(itype(j))
10106 if (j.lt.nres-1) then
10107 itj1=itortyp(itype(j+1))
10111 itk=itortyp(itype(k))
10112 if (k.lt.nres-1) then
10113 itk1=itortyp(itype(k+1))
10117 itl=itortyp(itype(l))
10118 if (l.lt.nres-1) then
10119 itl1=itortyp(itype(l+1))
10123 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10124 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10125 cd & ' itl',itl,' itl1',itl1
10127 if (imat.eq.1) then
10128 s1=dip(3,jj,i)*dip(3,kk,k)
10130 s1=dip(2,jj,j)*dip(2,kk,l)
10133 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10134 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10136 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
10137 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10139 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
10140 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10142 call transpose2(EUg(1,1,k),auxmat(1,1))
10143 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10144 vv(1)=pizda(1,1)-pizda(2,2)
10145 vv(2)=pizda(2,1)+pizda(1,2)
10146 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10147 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10149 eello6_graph4=-(s1+s2+s3+s4)
10151 eello6_graph4=-(s2+s3+s4)
10153 C Derivatives in gamma(i-1)
10156 if (imat.eq.1) then
10157 s1=dipderg(2,jj,i)*dip(3,kk,k)
10159 s1=dipderg(4,jj,j)*dip(2,kk,l)
10162 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10164 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
10165 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10167 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
10168 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10170 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10171 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10172 cd write (2,*) 'turn6 derivatives'
10174 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10176 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10180 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10182 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10186 C Derivatives in gamma(k-1)
10188 if (imat.eq.1) then
10189 s1=dip(3,jj,i)*dipderg(2,kk,k)
10191 s1=dip(2,jj,j)*dipderg(4,kk,l)
10194 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10195 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10197 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
10198 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10200 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
10201 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10203 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10204 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10205 vv(1)=pizda(1,1)-pizda(2,2)
10206 vv(2)=pizda(2,1)+pizda(1,2)
10207 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10208 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10210 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10212 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10216 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10218 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10221 C Derivatives in gamma(j-1) or gamma(l-1)
10222 if (l.eq.j+1 .and. l.gt.1) then
10223 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10224 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10225 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10226 vv(1)=pizda(1,1)-pizda(2,2)
10227 vv(2)=pizda(2,1)+pizda(1,2)
10228 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10229 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10230 else if (j.gt.1) then
10231 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10232 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10233 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10234 vv(1)=pizda(1,1)-pizda(2,2)
10235 vv(2)=pizda(2,1)+pizda(1,2)
10236 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10237 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10238 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10240 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10243 C Cartesian derivatives.
10249 if (imat.eq.1) then
10250 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10252 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10255 if (imat.eq.1) then
10256 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10258 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10262 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
10264 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10266 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10267 & b1(1,j+1),auxvec(1))
10268 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
10270 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10271 & b1(1,l+1),auxvec(1))
10272 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
10274 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10276 vv(1)=pizda(1,1)-pizda(2,2)
10277 vv(2)=pizda(2,1)+pizda(1,2)
10278 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10280 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10282 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10285 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10288 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10291 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10293 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10295 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10299 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10301 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10304 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10306 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10314 c----------------------------------------------------------------------------
10315 double precision function eello_turn6(i,jj,kk)
10316 implicit real*8 (a-h,o-z)
10317 include 'DIMENSIONS'
10318 include 'COMMON.IOUNITS'
10319 include 'COMMON.CHAIN'
10320 include 'COMMON.DERIV'
10321 include 'COMMON.INTERACT'
10322 include 'COMMON.CONTACTS'
10323 include 'COMMON.TORSION'
10324 include 'COMMON.VAR'
10325 include 'COMMON.GEO'
10326 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
10327 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
10329 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
10330 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
10331 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10332 C the respective energy moment and not to the cluster cumulant.
10341 iti=itortyp(itype(i))
10342 itk=itortyp(itype(k))
10343 itk1=itortyp(itype(k+1))
10344 itl=itortyp(itype(l))
10345 itj=itortyp(itype(j))
10346 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10347 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
10348 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10353 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10355 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10359 derx_turn(lll,kkk,iii)=0.0d0
10366 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10368 cd write (2,*) 'eello6_5',eello6_5
10370 call transpose2(AEA(1,1,1),auxmat(1,1))
10371 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10372 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10373 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10375 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10376 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10377 s2 = scalar2(b1(1,k),vtemp1(1))
10379 call transpose2(AEA(1,1,2),atemp(1,1))
10380 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10381 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10382 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10384 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10385 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10386 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10388 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10389 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10390 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10391 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10392 ss13 = scalar2(b1(1,k),vtemp4(1))
10393 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10395 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10401 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10402 C Derivatives in gamma(i+2)
10406 call transpose2(AEA(1,1,1),auxmatd(1,1))
10407 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10408 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10409 call transpose2(AEAderg(1,1,2),atempd(1,1))
10410 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10411 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10413 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10414 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10415 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10421 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10422 C Derivatives in gamma(i+3)
10424 call transpose2(AEA(1,1,1),auxmatd(1,1))
10425 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10426 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10427 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10429 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10430 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10431 s2d = scalar2(b1(1,k),vtemp1d(1))
10433 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10434 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10436 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10438 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10439 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10440 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10448 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10449 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10451 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10452 & -0.5d0*ekont*(s2d+s12d)
10454 C Derivatives in gamma(i+4)
10455 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10456 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10457 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10459 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10460 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10461 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10469 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10471 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10473 C Derivatives in gamma(i+5)
10475 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10476 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10477 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10479 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10480 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10481 s2d = scalar2(b1(1,k),vtemp1d(1))
10483 call transpose2(AEA(1,1,2),atempd(1,1))
10484 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10485 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10487 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10488 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10490 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10491 ss13d = scalar2(b1(1,k),vtemp4d(1))
10492 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10500 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10501 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10503 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10504 & -0.5d0*ekont*(s2d+s12d)
10506 C Cartesian derivatives
10511 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10512 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10513 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10515 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10516 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10518 s2d = scalar2(b1(1,k),vtemp1d(1))
10520 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10521 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10522 s8d = -(atempd(1,1)+atempd(2,2))*
10523 & scalar2(cc(1,1,itl),vtemp2(1))
10525 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10527 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10528 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10535 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10536 & - 0.5d0*(s1d+s2d)
10538 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10542 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10543 & - 0.5d0*(s8d+s12d)
10545 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10554 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10555 & achuj_tempd(1,1))
10556 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10557 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10558 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10559 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10560 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10562 ss13d = scalar2(b1(1,k),vtemp4d(1))
10563 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10564 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10568 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10569 cd & 16*eel_turn6_num
10571 if (j.lt.nres-1) then
10578 if (l.lt.nres-1) then
10586 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10587 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10588 cgrad ghalf=0.5d0*ggg1(ll)
10590 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10591 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10592 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10593 & +ekont*derx_turn(ll,2,1)
10594 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10595 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10596 & +ekont*derx_turn(ll,4,1)
10597 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10598 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10599 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10600 cgrad ghalf=0.5d0*ggg2(ll)
10602 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10603 & +ekont*derx_turn(ll,2,2)
10604 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10605 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10606 & +ekont*derx_turn(ll,4,2)
10607 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10608 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10609 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10614 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10619 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10625 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10630 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10634 cd write (2,*) iii,g_corr6_loc(iii)
10636 eello_turn6=ekont*eel_turn6
10637 cd write (2,*) 'ekont',ekont
10638 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10642 C-----------------------------------------------------------------------------
10643 double precision function scalar(u,v)
10644 !DIR$ INLINEALWAYS scalar
10646 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10649 double precision u(3),v(3)
10650 cd double precision sc
10658 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10661 crc-------------------------------------------------
10662 SUBROUTINE MATVEC2(A1,V1,V2)
10663 !DIR$ INLINEALWAYS MATVEC2
10665 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10667 implicit real*8 (a-h,o-z)
10668 include 'DIMENSIONS'
10669 DIMENSION A1(2,2),V1(2),V2(2)
10673 c 3 VI=VI+A1(I,K)*V1(K)
10677 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10678 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10683 C---------------------------------------
10684 SUBROUTINE MATMAT2(A1,A2,A3)
10686 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10688 implicit real*8 (a-h,o-z)
10689 include 'DIMENSIONS'
10690 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10691 c DIMENSION AI3(2,2)
10695 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10701 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10702 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10703 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10704 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10712 c-------------------------------------------------------------------------
10713 double precision function scalar2(u,v)
10714 !DIR$ INLINEALWAYS scalar2
10716 double precision u(2),v(2)
10717 double precision sc
10719 scalar2=u(1)*v(1)+u(2)*v(2)
10723 C-----------------------------------------------------------------------------
10725 subroutine transpose2(a,at)
10726 !DIR$ INLINEALWAYS transpose2
10728 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10731 double precision a(2,2),at(2,2)
10738 c--------------------------------------------------------------------------
10739 subroutine transpose(n,a,at)
10742 double precision a(n,n),at(n,n)
10750 C---------------------------------------------------------------------------
10751 subroutine prodmat3(a1,a2,kk,transp,prod)
10752 !DIR$ INLINEALWAYS prodmat3
10754 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10758 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10760 crc double precision auxmat(2,2),prod_(2,2)
10763 crc call transpose2(kk(1,1),auxmat(1,1))
10764 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10765 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10767 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10768 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10769 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10770 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10771 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10772 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10773 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10774 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10777 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10778 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10780 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10781 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10782 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10783 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10784 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10785 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10786 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10787 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10790 c call transpose2(a2(1,1),a2t(1,1))
10793 crc print *,((prod_(i,j),i=1,2),j=1,2)
10794 crc print *,((prod(i,j),i=1,2),j=1,2)
10798 CCC----------------------------------------------
10799 subroutine Eliptransfer(eliptran)
10800 implicit real*8 (a-h,o-z)
10801 include 'DIMENSIONS'
10802 include 'COMMON.GEO'
10803 include 'COMMON.VAR'
10804 include 'COMMON.LOCAL'
10805 include 'COMMON.CHAIN'
10806 include 'COMMON.DERIV'
10807 include 'COMMON.NAMES'
10808 include 'COMMON.INTERACT'
10809 include 'COMMON.IOUNITS'
10810 include 'COMMON.CALC'
10811 include 'COMMON.CONTROL'
10812 include 'COMMON.SPLITELE'
10813 include 'COMMON.SBRIDGE'
10814 C this is done by Adasko
10815 C print *,"wchodze"
10816 C structure of box:
10818 C--bordliptop-- buffore starts
10819 C--bufliptop--- here true lipid starts
10821 C--buflipbot--- lipid ends buffore starts
10822 C--bordlipbot--buffore ends
10824 do i=ilip_start,ilip_end
10826 if (itype(i).eq.ntyp1) cycle
10828 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10829 if (positi.le.0) positi=positi+boxzsize
10831 C first for peptide groups
10832 c for each residue check if it is in lipid or lipid water border area
10833 if ((positi.gt.bordlipbot)
10834 &.and.(positi.lt.bordliptop)) then
10835 C the energy transfer exist
10836 if (positi.lt.buflipbot) then
10837 C what fraction I am in
10839 & ((positi-bordlipbot)/lipbufthick)
10840 C lipbufthick is thickenes of lipid buffore
10841 sslip=sscalelip(fracinbuf)
10842 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10843 eliptran=eliptran+sslip*pepliptran
10844 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10845 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10846 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10848 C print *,"doing sccale for lower part"
10849 C print *,i,sslip,fracinbuf,ssgradlip
10850 elseif (positi.gt.bufliptop) then
10851 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10852 sslip=sscalelip(fracinbuf)
10853 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10854 eliptran=eliptran+sslip*pepliptran
10855 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10856 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10857 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10858 C print *, "doing sscalefor top part"
10859 C print *,i,sslip,fracinbuf,ssgradlip
10861 eliptran=eliptran+pepliptran
10862 C print *,"I am in true lipid"
10865 C eliptran=elpitran+0.0 ! I am in water
10868 C print *, "nic nie bylo w lipidzie?"
10869 C now multiply all by the peptide group transfer factor
10870 C eliptran=eliptran*pepliptran
10871 C now the same for side chains
10873 do i=ilip_start,ilip_end
10874 if (itype(i).eq.ntyp1) cycle
10875 positi=(mod(c(3,i+nres),boxzsize))
10876 if (positi.le.0) positi=positi+boxzsize
10877 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10878 c for each residue check if it is in lipid or lipid water border area
10879 C respos=mod(c(3,i+nres),boxzsize)
10880 C print *,positi,bordlipbot,buflipbot
10881 if ((positi.gt.bordlipbot)
10882 & .and.(positi.lt.bordliptop)) then
10883 C the energy transfer exist
10884 if (positi.lt.buflipbot) then
10886 & ((positi-bordlipbot)/lipbufthick)
10887 C lipbufthick is thickenes of lipid buffore
10888 sslip=sscalelip(fracinbuf)
10889 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10890 eliptran=eliptran+sslip*liptranene(itype(i))
10891 gliptranx(3,i)=gliptranx(3,i)
10892 &+ssgradlip*liptranene(itype(i))
10893 gliptranc(3,i-1)= gliptranc(3,i-1)
10894 &+ssgradlip*liptranene(itype(i))
10895 C print *,"doing sccale for lower part"
10896 elseif (positi.gt.bufliptop) then
10898 &((bordliptop-positi)/lipbufthick)
10899 sslip=sscalelip(fracinbuf)
10900 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10901 eliptran=eliptran+sslip*liptranene(itype(i))
10902 gliptranx(3,i)=gliptranx(3,i)
10903 &+ssgradlip*liptranene(itype(i))
10904 gliptranc(3,i-1)= gliptranc(3,i-1)
10905 &+ssgradlip*liptranene(itype(i))
10906 C print *, "doing sscalefor top part",sslip,fracinbuf
10908 eliptran=eliptran+liptranene(itype(i))
10909 C print *,"I am in true lipid"
10911 endif ! if in lipid or buffor
10913 C eliptran=elpitran+0.0 ! I am in water
10917 C---------------------------------------------------------
10918 C AFM soubroutine for constant force
10919 subroutine AFMforce(Eafmforce)
10920 implicit real*8 (a-h,o-z)
10921 include 'DIMENSIONS'
10922 include 'COMMON.GEO'
10923 include 'COMMON.VAR'
10924 include 'COMMON.LOCAL'
10925 include 'COMMON.CHAIN'
10926 include 'COMMON.DERIV'
10927 include 'COMMON.NAMES'
10928 include 'COMMON.INTERACT'
10929 include 'COMMON.IOUNITS'
10930 include 'COMMON.CALC'
10931 include 'COMMON.CONTROL'
10932 include 'COMMON.SPLITELE'
10933 include 'COMMON.SBRIDGE'
10938 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10939 dist=dist+diffafm(i)**2
10942 Eafmforce=-forceAFMconst*(dist-distafminit)
10944 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
10945 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
10947 C print *,'AFM',Eafmforce
10950 C---------------------------------------------------------
10951 C AFM subroutine with pseudoconstant velocity
10952 subroutine AFMvel(Eafmforce)
10953 implicit real*8 (a-h,o-z)
10954 include 'DIMENSIONS'
10955 include 'COMMON.GEO'
10956 include 'COMMON.VAR'
10957 include 'COMMON.LOCAL'
10958 include 'COMMON.CHAIN'
10959 include 'COMMON.DERIV'
10960 include 'COMMON.NAMES'
10961 include 'COMMON.INTERACT'
10962 include 'COMMON.IOUNITS'
10963 include 'COMMON.CALC'
10964 include 'COMMON.CONTROL'
10965 include 'COMMON.SPLITELE'
10966 include 'COMMON.SBRIDGE'
10968 C Only for check grad COMMENT if not used for checkgrad
10970 C--------------------------------------------------------
10971 C print *,"wchodze"
10975 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10976 dist=dist+diffafm(i)**2
10979 Eafmforce=0.5d0*forceAFMconst
10980 & *(distafminit+totTafm*velAFMconst-dist)**2
10981 C Eafmforce=-forceAFMconst*(dist-distafminit)
10983 gradafm(i,afmend-1)=-forceAFMconst*
10984 &(distafminit+totTafm*velAFMconst-dist)
10986 gradafm(i,afmbeg-1)=forceAFMconst*
10987 &(distafminit+totTafm*velAFMconst-dist)
10990 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist