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'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
30 if (nfgtasks.gt.1) then
32 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
33 if (fg_rank.eq.0) then
34 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
35 c print *,"Processor",myrank," BROADCAST iorder"
36 C FG master sets up the WEIGHTS_ array which will be broadcast to the
37 C FG slaves as WEIGHTS array.
57 C FG Master broadcasts the WEIGHTS_ array
58 call MPI_Bcast(weights_(1),n_ene,
59 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
61 C FG slaves receive the WEIGHTS array
62 call MPI_Bcast(weights(1),n_ene,
63 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
84 time_Bcast=time_Bcast+MPI_Wtime()-time00
85 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
86 c call chainbuild_cart
88 c print *,'Processor',myrank,' calling etotal ipot=',ipot
89 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
91 c if (modecalc.eq.12.or.modecalc.eq.14) then
92 c call int_from_cart1(.false.)
99 C Compute the side-chain and electrostatic interaction energy
101 goto (101,102,103,104,105,106) ipot
102 C Lennard-Jones potential.
104 cd print '(a)','Exit ELJ'
106 C Lennard-Jones-Kihara potential (shifted).
109 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 C Gay-Berne potential (shifted LJ, angular dependence).
115 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 C Soft-sphere potential
119 106 call e_softsphere(evdw)
121 C Calculate electrostatic (H-bonding) energy of the main chain.
125 cmc Sep-06: egb takes care of dynamic ss bonds too
127 c if (dyn_ss) call dyn_set_nss
129 c print *,"Processor",myrank," computed USCSC"
135 time_vec=time_vec+MPI_Wtime()-time01
137 c print *,"Processor",myrank," left VEC_AND_DERIV"
140 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
141 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
142 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
143 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
145 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
146 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
147 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
148 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
150 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
159 c write (iout,*) "Soft-spheer ELEC potential"
160 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
163 c print *,"Processor",myrank," computed UELEC"
165 C Calculate excluded-volume interaction energy between peptide groups
170 call escp(evdw2,evdw2_14)
176 c write (iout,*) "Soft-sphere SCP potential"
177 call escp_soft_sphere(evdw2,evdw2_14)
180 c Calculate the bond-stretching energy
184 C Calculate the disulfide-bridge and other energy and the contributions
185 C from other distance constraints.
186 cd print *,'Calling EHPB'
188 cd print *,'EHPB exitted succesfully.'
190 C Calculate the virtual-bond-angle energy.
192 if (wang.gt.0d0) then
197 c print *,"Processor",myrank," computed UB"
199 C Calculate the SC local energy.
202 c print *,"Processor",myrank," computed USC"
204 C Calculate the virtual-bond torsional energy.
206 cd print *,'nterm=',nterm
208 call etor(etors,edihcnstr)
213 c print *,"Processor",myrank," computed Utor"
215 C 6/23/01 Calculate double-torsional energy
217 if (wtor_d.gt.0) then
222 c print *,"Processor",myrank," computed Utord"
224 C 21/5/07 Calculate local sicdechain correlation energy
226 if (wsccor.gt.0.0d0) then
227 call eback_sc_corr(esccor)
231 c print *,"Processor",myrank," computed Usccorr"
233 C 12/1/95 Multi-body terms
237 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
238 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
239 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
240 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
241 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
248 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
249 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
250 cd write (iout,*) "multibody_hb ecorr",ecorr
252 c print *,"Processor",myrank," computed Ucorr"
254 C If performing constraint dynamics, call the constraint energy
255 C after the equilibration time
256 if(usampl.and.totT.gt.eq_time) then
264 time_enecalc=time_enecalc+MPI_Wtime()-time00
266 c print *,"Processor",myrank," computed Uconstr"
275 energia(2)=evdw2-evdw2_14
292 energia(8)=eello_turn3
293 energia(9)=eello_turn4
300 energia(19)=edihcnstr
302 energia(20)=Uconst+Uconst_back
304 c print *," Processor",myrank," calls SUM_ENERGY"
305 call sum_energy(energia,.true.)
306 if (dyn_ss) call dyn_set_nss
307 c print *," Processor",myrank," left SUM_ENERGY"
309 time_sumene=time_sumene+MPI_Wtime()-time00
313 c-------------------------------------------------------------------------------
314 subroutine sum_energy(energia,reduce)
315 implicit real*8 (a-h,o-z)
320 cMS$ATTRIBUTES C :: proc_proc
326 include 'COMMON.SETUP'
327 include 'COMMON.IOUNITS'
328 double precision energia(0:n_ene),enebuff(0:n_ene+1)
329 include 'COMMON.FFIELD'
330 include 'COMMON.DERIV'
331 include 'COMMON.INTERACT'
332 include 'COMMON.SBRIDGE'
333 include 'COMMON.CHAIN'
335 include 'COMMON.CONTROL'
336 include 'COMMON.TIME1'
339 if (nfgtasks.gt.1 .and. reduce) then
341 write (iout,*) "energies before REDUCE"
342 call enerprint(energia)
346 enebuff(i)=energia(i)
349 call MPI_Barrier(FG_COMM,IERR)
350 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
352 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
353 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
355 write (iout,*) "energies after REDUCE"
356 call enerprint(energia)
359 time_Reduce=time_Reduce+MPI_Wtime()-time00
361 if (fg_rank.eq.0) then
365 evdw2=energia(2)+energia(18)
381 eello_turn3=energia(8)
382 eello_turn4=energia(9)
389 edihcnstr=energia(19)
394 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
395 & +wang*ebe+wtor*etors+wscloc*escloc
396 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
397 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
398 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
399 & +wbond*estr+Uconst+wsccor*esccor
401 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
402 & +wang*ebe+wtor*etors+wscloc*escloc
403 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
404 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
405 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
406 & +wbond*estr+Uconst+wsccor*esccor
412 if (isnan(etot).ne.0) energia(0)=1.0d+99
414 if (isnan(etot)) energia(0)=1.0d+99
419 idumm=proc_proc(etot,i)
421 call proc_proc(etot,i)
423 if(i.eq.1)energia(0)=1.0d+99
430 c-------------------------------------------------------------------------------
431 subroutine sum_gradient
432 implicit real*8 (a-h,o-z)
437 cMS$ATTRIBUTES C :: proc_proc
442 double precision gradbufc(3,maxres),gradbufx(3,maxres),
443 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
445 include 'COMMON.SETUP'
446 include 'COMMON.IOUNITS'
447 include 'COMMON.FFIELD'
448 include 'COMMON.DERIV'
449 include 'COMMON.INTERACT'
450 include 'COMMON.SBRIDGE'
451 include 'COMMON.CHAIN'
453 include 'COMMON.CONTROL'
454 include 'COMMON.TIME1'
455 include 'COMMON.MAXGRAD'
460 write (iout,*) "sum_gradient gvdwc, gvdwx"
462 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
463 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
468 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
469 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
470 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
473 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
474 C in virtual-bond-vector coordinates
477 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
479 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
480 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
482 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
484 c write (iout,'(i5,3f10.5,2x,f10.5)')
485 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
487 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
489 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
490 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
498 gradbufc(j,i)=wsc*gvdwc(j,i)+
499 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
500 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
501 & wel_loc*gel_loc_long(j,i)+
502 & wcorr*gradcorr_long(j,i)+
503 & wcorr5*gradcorr5_long(j,i)+
504 & wcorr6*gradcorr6_long(j,i)+
505 & wturn6*gcorr6_turn_long(j,i)+
512 gradbufc(j,i)=wsc*gvdwc(j,i)+
513 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
514 & welec*gelc_long(j,i)+
516 & wel_loc*gel_loc_long(j,i)+
517 & wcorr*gradcorr_long(j,i)+
518 & wcorr5*gradcorr5_long(j,i)+
519 & wcorr6*gradcorr6_long(j,i)+
520 & wturn6*gcorr6_turn_long(j,i)+
526 if (nfgtasks.gt.1) then
529 write (iout,*) "gradbufc before allreduce"
531 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
537 gradbufc_sum(j,i)=gradbufc(j,i)
540 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
541 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
542 c time_reduce=time_reduce+MPI_Wtime()-time00
544 c write (iout,*) "gradbufc_sum after allreduce"
546 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
551 c time_allreduce=time_allreduce+MPI_Wtime()-time00
559 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
560 write (iout,*) (i," jgrad_start",jgrad_start(i),
561 & " jgrad_end ",jgrad_end(i),
562 & i=igrad_start,igrad_end)
565 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
566 c do not parallelize this part.
568 c do i=igrad_start,igrad_end
569 c do j=jgrad_start(i),jgrad_end(i)
571 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
576 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
580 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
584 write (iout,*) "gradbufc after summing"
586 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
593 write (iout,*) "gradbufc"
595 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
601 gradbufc_sum(j,i)=gradbufc(j,i)
606 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
610 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
615 c gradbufc(k,i)=0.0d0
619 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
624 write (iout,*) "gradbufc after summing"
626 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
634 gradbufc(k,nres)=0.0d0
639 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
640 & wel_loc*gel_loc(j,i)+
641 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
642 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
643 & wel_loc*gel_loc_long(j,i)+
644 & wcorr*gradcorr_long(j,i)+
645 & wcorr5*gradcorr5_long(j,i)+
646 & wcorr6*gradcorr6_long(j,i)+
647 & wturn6*gcorr6_turn_long(j,i))+
649 & wcorr*gradcorr(j,i)+
650 & wturn3*gcorr3_turn(j,i)+
651 & wturn4*gcorr4_turn(j,i)+
652 & wcorr5*gradcorr5(j,i)+
653 & wcorr6*gradcorr6(j,i)+
654 & wturn6*gcorr6_turn(j,i)+
655 & wsccor*gsccorc(j,i)
656 & +wscloc*gscloc(j,i)
658 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
659 & wel_loc*gel_loc(j,i)+
660 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
661 & welec*gelc_long(j,i)
662 & wel_loc*gel_loc_long(j,i)+
663 & wcorr*gcorr_long(j,i)+
664 & wcorr5*gradcorr5_long(j,i)+
665 & wcorr6*gradcorr6_long(j,i)+
666 & wturn6*gcorr6_turn_long(j,i))+
668 & wcorr*gradcorr(j,i)+
669 & wturn3*gcorr3_turn(j,i)+
670 & wturn4*gcorr4_turn(j,i)+
671 & wcorr5*gradcorr5(j,i)+
672 & wcorr6*gradcorr6(j,i)+
673 & wturn6*gcorr6_turn(j,i)+
674 & wsccor*gsccorc(j,i)
675 & +wscloc*gscloc(j,i)
677 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
679 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
680 & wsccor*gsccorx(j,i)
681 & +wscloc*gsclocx(j,i)
685 write (iout,*) "gloc before adding corr"
687 write (iout,*) i,gloc(i,icg)
691 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
692 & +wcorr5*g_corr5_loc(i)
693 & +wcorr6*g_corr6_loc(i)
694 & +wturn4*gel_loc_turn4(i)
695 & +wturn3*gel_loc_turn3(i)
696 & +wturn6*gel_loc_turn6(i)
697 & +wel_loc*gel_loc_loc(i)
698 & +wsccor*gsccor_loc(i)
701 write (iout,*) "gloc after adding corr"
703 write (iout,*) i,gloc(i,icg)
707 if (nfgtasks.gt.1) then
710 gradbufc(j,i)=gradc(j,i,icg)
711 gradbufx(j,i)=gradx(j,i,icg)
715 glocbuf(i)=gloc(i,icg)
718 call MPI_Barrier(FG_COMM,IERR)
719 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
721 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
722 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
723 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
724 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
725 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
726 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
727 time_reduce=time_reduce+MPI_Wtime()-time00
729 write (iout,*) "gloc after reduce"
731 write (iout,*) i,gloc(i,icg)
736 if (gnorm_check) then
738 c Compute the maximum elements of the gradient
748 gcorr3_turn_max=0.0d0
749 gcorr4_turn_max=0.0d0
752 gcorr6_turn_max=0.0d0
762 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
763 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
764 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
765 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
766 & gvdwc_scp_max=gvdwc_scp_norm
767 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
768 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
769 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
770 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
771 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
772 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
773 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
774 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
775 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
776 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
777 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
778 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
779 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
781 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
782 & gcorr3_turn_max=gcorr3_turn_norm
783 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
785 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
786 & gcorr4_turn_max=gcorr4_turn_norm
787 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
788 if (gradcorr5_norm.gt.gradcorr5_max)
789 & gradcorr5_max=gradcorr5_norm
790 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
791 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
792 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
794 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
795 & gcorr6_turn_max=gcorr6_turn_norm
796 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
797 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
798 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
799 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
800 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
801 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
802 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
803 if (gradx_scp_norm.gt.gradx_scp_max)
804 & gradx_scp_max=gradx_scp_norm
805 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
806 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
807 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
808 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
809 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
810 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
811 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
812 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
816 open(istat,file=statname,position="append")
818 open(istat,file=statname,access="append")
820 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
821 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
822 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
823 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
824 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
825 & gsccorx_max,gsclocx_max
827 if (gvdwc_max.gt.1.0d4) then
828 write (iout,*) "gvdwc gvdwx gradb gradbx"
830 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
831 & gradb(j,i),gradbx(j,i),j=1,3)
833 call pdbout(0.0d0,'cipiszcze',iout)
839 write (iout,*) "gradc gradx gloc"
841 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
842 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
846 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
850 c-------------------------------------------------------------------------------
851 subroutine rescale_weights(t_bath)
852 implicit real*8 (a-h,o-z)
854 include 'COMMON.IOUNITS'
855 include 'COMMON.FFIELD'
856 include 'COMMON.SBRIDGE'
857 double precision kfac /2.4d0/
858 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
860 c facT=2*temp0/(t_bath+temp0)
861 if (rescale_mode.eq.0) then
867 else if (rescale_mode.eq.1) then
868 facT=kfac/(kfac-1.0d0+t_bath/temp0)
869 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
870 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
871 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
872 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
873 else if (rescale_mode.eq.2) then
879 facT=licznik/dlog(dexp(x)+dexp(-x))
880 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
881 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
882 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
883 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
885 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
886 write (*,*) "Wrong RESCALE_MODE",rescale_mode
888 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
892 welec=weights(3)*fact
893 wcorr=weights(4)*fact3
894 wcorr5=weights(5)*fact4
895 wcorr6=weights(6)*fact5
896 wel_loc=weights(7)*fact2
897 wturn3=weights(8)*fact2
898 wturn4=weights(9)*fact3
899 wturn6=weights(10)*fact5
900 wtor=weights(13)*fact
901 wtor_d=weights(14)*fact2
902 wsccor=weights(21)*fact
906 C------------------------------------------------------------------------
907 subroutine enerprint(energia)
908 implicit real*8 (a-h,o-z)
910 include 'COMMON.IOUNITS'
911 include 'COMMON.FFIELD'
912 include 'COMMON.SBRIDGE'
914 double precision energia(0:n_ene)
919 evdw2=energia(2)+energia(18)
931 eello_turn3=energia(8)
932 eello_turn4=energia(9)
933 eello_turn6=energia(10)
939 edihcnstr=energia(19)
944 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
945 & estr,wbond,ebe,wang,
946 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
948 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
949 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
952 10 format (/'Virtual-chain energies:'//
953 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
954 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
955 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
956 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
957 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
958 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
959 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
960 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
961 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
962 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
963 & ' (SS bridges & dist. cnstr.)'/
964 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
965 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
966 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
967 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
968 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
969 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
970 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
971 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
972 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
973 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
974 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
975 & 'ETOT= ',1pE16.6,' (total)')
977 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
978 & estr,wbond,ebe,wang,
979 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
981 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
982 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
983 & ebr*nss,Uconst,etot
984 10 format (/'Virtual-chain energies:'//
985 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
986 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
987 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
988 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
989 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
990 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
991 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
992 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
993 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
994 & ' (SS bridges & dist. cnstr.)'/
995 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
996 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
997 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
998 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
999 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1000 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1001 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1002 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1003 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1004 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1005 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1006 & 'ETOT= ',1pE16.6,' (total)')
1010 C-----------------------------------------------------------------------
1011 subroutine elj(evdw)
1013 C This subroutine calculates the interaction energy of nonbonded side chains
1014 C assuming the LJ potential of interaction.
1016 implicit real*8 (a-h,o-z)
1017 include 'DIMENSIONS'
1018 parameter (accur=1.0d-10)
1019 include 'COMMON.GEO'
1020 include 'COMMON.VAR'
1021 include 'COMMON.LOCAL'
1022 include 'COMMON.CHAIN'
1023 include 'COMMON.DERIV'
1024 include 'COMMON.INTERACT'
1025 include 'COMMON.TORSION'
1026 include 'COMMON.SBRIDGE'
1027 include 'COMMON.NAMES'
1028 include 'COMMON.IOUNITS'
1029 include 'COMMON.CONTACTS'
1031 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1033 do i=iatsc_s,iatsc_e
1035 if (itypi.eq.21) cycle
1043 C Calculate SC interaction energy.
1045 do iint=1,nint_gr(i)
1046 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1047 cd & 'iend=',iend(i,iint)
1048 do j=istart(i,iint),iend(i,iint)
1050 if (itypj.eq.21) cycle
1054 C Change 12/1/95 to calculate four-body interactions
1055 rij=xj*xj+yj*yj+zj*zj
1057 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1058 eps0ij=eps(itypi,itypj)
1060 e1=fac*fac*aa(itypi,itypj)
1061 e2=fac*bb(itypi,itypj)
1063 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1064 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1065 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1066 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1067 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1068 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1071 C Calculate the components of the gradient in DC and X
1073 fac=-rrij*(e1+evdwij)
1078 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1079 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1080 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1081 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1085 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1089 C 12/1/95, revised on 5/20/97
1091 C Calculate the contact function. The ith column of the array JCONT will
1092 C contain the numbers of atoms that make contacts with the atom I (of numbers
1093 C greater than I). The arrays FACONT and GACONT will contain the values of
1094 C the contact function and its derivative.
1096 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1097 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1098 C Uncomment next line, if the correlation interactions are contact function only
1099 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1101 sigij=sigma(itypi,itypj)
1102 r0ij=rs0(itypi,itypj)
1104 C Check whether the SC's are not too far to make a contact.
1107 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1108 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1110 if (fcont.gt.0.0D0) then
1111 C If the SC-SC distance if close to sigma, apply spline.
1112 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1113 cAdam & fcont1,fprimcont1)
1114 cAdam fcont1=1.0d0-fcont1
1115 cAdam if (fcont1.gt.0.0d0) then
1116 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1117 cAdam fcont=fcont*fcont1
1119 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1120 cga eps0ij=1.0d0/dsqrt(eps0ij)
1122 cga gg(k)=gg(k)*eps0ij
1124 cga eps0ij=-evdwij*eps0ij
1125 C Uncomment for AL's type of SC correlation interactions.
1126 cadam eps0ij=-evdwij
1127 num_conti=num_conti+1
1128 jcont(num_conti,i)=j
1129 facont(num_conti,i)=fcont*eps0ij
1130 fprimcont=eps0ij*fprimcont/rij
1132 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1133 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1134 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1135 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1136 gacont(1,num_conti,i)=-fprimcont*xj
1137 gacont(2,num_conti,i)=-fprimcont*yj
1138 gacont(3,num_conti,i)=-fprimcont*zj
1139 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1140 cd write (iout,'(2i3,3f10.5)')
1141 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1147 num_cont(i)=num_conti
1151 gvdwc(j,i)=expon*gvdwc(j,i)
1152 gvdwx(j,i)=expon*gvdwx(j,i)
1155 C******************************************************************************
1159 C To save time, the factor of EXPON has been extracted from ALL components
1160 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1163 C******************************************************************************
1166 C-----------------------------------------------------------------------------
1167 subroutine eljk(evdw)
1169 C This subroutine calculates the interaction energy of nonbonded side chains
1170 C assuming the LJK potential of interaction.
1172 implicit real*8 (a-h,o-z)
1173 include 'DIMENSIONS'
1174 include 'COMMON.GEO'
1175 include 'COMMON.VAR'
1176 include 'COMMON.LOCAL'
1177 include 'COMMON.CHAIN'
1178 include 'COMMON.DERIV'
1179 include 'COMMON.INTERACT'
1180 include 'COMMON.IOUNITS'
1181 include 'COMMON.NAMES'
1184 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1186 do i=iatsc_s,iatsc_e
1188 if (itypi.eq.21) cycle
1194 C Calculate SC interaction energy.
1196 do iint=1,nint_gr(i)
1197 do j=istart(i,iint),iend(i,iint)
1199 if (itypj.eq.21) cycle
1203 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1204 fac_augm=rrij**expon
1205 e_augm=augm(itypi,itypj)*fac_augm
1206 r_inv_ij=dsqrt(rrij)
1208 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1209 fac=r_shift_inv**expon
1210 e1=fac*fac*aa(itypi,itypj)
1211 e2=fac*bb(itypi,itypj)
1213 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1214 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1215 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1216 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1217 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1218 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1219 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1222 C Calculate the components of the gradient in DC and X
1224 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1229 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1230 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1231 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1232 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1236 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1244 gvdwc(j,i)=expon*gvdwc(j,i)
1245 gvdwx(j,i)=expon*gvdwx(j,i)
1250 C-----------------------------------------------------------------------------
1251 subroutine ebp(evdw)
1253 C This subroutine calculates the interaction energy of nonbonded side chains
1254 C assuming the Berne-Pechukas potential of interaction.
1256 implicit real*8 (a-h,o-z)
1257 include 'DIMENSIONS'
1258 include 'COMMON.GEO'
1259 include 'COMMON.VAR'
1260 include 'COMMON.LOCAL'
1261 include 'COMMON.CHAIN'
1262 include 'COMMON.DERIV'
1263 include 'COMMON.NAMES'
1264 include 'COMMON.INTERACT'
1265 include 'COMMON.IOUNITS'
1266 include 'COMMON.CALC'
1267 common /srutu/ icall
1268 c double precision rrsave(maxdim)
1271 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1273 c if (icall.eq.0) then
1279 do i=iatsc_s,iatsc_e
1281 if (itypi.eq.21) cycle
1286 dxi=dc_norm(1,nres+i)
1287 dyi=dc_norm(2,nres+i)
1288 dzi=dc_norm(3,nres+i)
1289 c dsci_inv=dsc_inv(itypi)
1290 dsci_inv=vbld_inv(i+nres)
1292 C Calculate SC interaction energy.
1294 do iint=1,nint_gr(i)
1295 do j=istart(i,iint),iend(i,iint)
1298 if (itypj.eq.21) cycle
1299 c dscj_inv=dsc_inv(itypj)
1300 dscj_inv=vbld_inv(j+nres)
1301 chi1=chi(itypi,itypj)
1302 chi2=chi(itypj,itypi)
1309 alf12=0.5D0*(alf1+alf2)
1310 C For diagnostics only!!!
1323 dxj=dc_norm(1,nres+j)
1324 dyj=dc_norm(2,nres+j)
1325 dzj=dc_norm(3,nres+j)
1326 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1327 cd if (icall.eq.0) then
1333 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1335 C Calculate whole angle-dependent part of epsilon and contributions
1336 C to its derivatives
1337 fac=(rrij*sigsq)**expon2
1338 e1=fac*fac*aa(itypi,itypj)
1339 e2=fac*bb(itypi,itypj)
1340 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1341 eps2der=evdwij*eps3rt
1342 eps3der=evdwij*eps2rt
1343 evdwij=evdwij*eps2rt*eps3rt
1346 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1347 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1348 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1349 cd & restyp(itypi),i,restyp(itypj),j,
1350 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1351 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1352 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1355 C Calculate gradient components.
1356 e1=e1*eps1*eps2rt**2*eps3rt**2
1357 fac=-expon*(e1+evdwij)
1360 C Calculate radial part of the gradient
1364 C Calculate the angular part of the gradient and sum add the contributions
1365 C to the appropriate components of the Cartesian gradient.
1373 C-----------------------------------------------------------------------------
1374 subroutine egb(evdw)
1376 C This subroutine calculates the interaction energy of nonbonded side chains
1377 C assuming the Gay-Berne potential of interaction.
1379 implicit real*8 (a-h,o-z)
1380 include 'DIMENSIONS'
1381 include 'COMMON.GEO'
1382 include 'COMMON.VAR'
1383 include 'COMMON.LOCAL'
1384 include 'COMMON.CHAIN'
1385 include 'COMMON.DERIV'
1386 include 'COMMON.NAMES'
1387 include 'COMMON.INTERACT'
1388 include 'COMMON.IOUNITS'
1389 include 'COMMON.CALC'
1390 include 'COMMON.CONTROL'
1391 include 'COMMON.SBRIDGE'
1394 ccccc energy_dec=.false.
1395 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1398 c if (icall.eq.0) lprn=.false.
1400 do i=iatsc_s,iatsc_e
1402 if (itypi.eq.21) cycle
1407 dxi=dc_norm(1,nres+i)
1408 dyi=dc_norm(2,nres+i)
1409 dzi=dc_norm(3,nres+i)
1410 c dsci_inv=dsc_inv(itypi)
1411 dsci_inv=vbld_inv(i+nres)
1412 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1413 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1415 C Calculate SC interaction energy.
1417 do iint=1,nint_gr(i)
1418 do j=istart(i,iint),iend(i,iint)
1419 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1420 call dyn_ssbond_ene(i,j,evdwij)
1422 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1423 & 'evdw',i,j,evdwij,' ss'
1427 if (itypj.eq.21) cycle
1428 c dscj_inv=dsc_inv(itypj)
1429 dscj_inv=vbld_inv(j+nres)
1430 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1431 c & 1.0d0/vbld(j+nres)
1432 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1433 sig0ij=sigma(itypi,itypj)
1434 chi1=chi(itypi,itypj)
1435 chi2=chi(itypj,itypi)
1442 alf12=0.5D0*(alf1+alf2)
1443 C For diagnostics only!!!
1456 dxj=dc_norm(1,nres+j)
1457 dyj=dc_norm(2,nres+j)
1458 dzj=dc_norm(3,nres+j)
1459 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1460 c write (iout,*) "j",j," dc_norm",
1461 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1462 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1464 C Calculate angle-dependent terms of energy and contributions to their
1468 sig=sig0ij*dsqrt(sigsq)
1469 rij_shift=1.0D0/rij-sig+sig0ij
1470 c for diagnostics; uncomment
1471 c rij_shift=1.2*sig0ij
1472 C I hate to put IF's in the loops, but here don't have another choice!!!!
1473 if (rij_shift.le.0.0D0) then
1475 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1476 cd & restyp(itypi),i,restyp(itypj),j,
1477 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1481 c---------------------------------------------------------------
1482 rij_shift=1.0D0/rij_shift
1483 fac=rij_shift**expon
1484 e1=fac*fac*aa(itypi,itypj)
1485 e2=fac*bb(itypi,itypj)
1486 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1487 eps2der=evdwij*eps3rt
1488 eps3der=evdwij*eps2rt
1489 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1490 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1491 evdwij=evdwij*eps2rt*eps3rt
1494 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1495 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1496 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1497 & restyp(itypi),i,restyp(itypj),j,
1498 & epsi,sigm,chi1,chi2,chip1,chip2,
1499 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1500 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1504 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1507 C Calculate gradient components.
1508 e1=e1*eps1*eps2rt**2*eps3rt**2
1509 fac=-expon*(e1+evdwij)*rij_shift
1513 C Calculate the radial part of the gradient
1517 C Calculate angular part of the gradient.
1523 c write (iout,*) "Number of loop steps in EGB:",ind
1524 cccc energy_dec=.false.
1527 C-----------------------------------------------------------------------------
1528 subroutine egbv(evdw)
1530 C This subroutine calculates the interaction energy of nonbonded side chains
1531 C assuming the Gay-Berne-Vorobjev potential of interaction.
1533 implicit real*8 (a-h,o-z)
1534 include 'DIMENSIONS'
1535 include 'COMMON.GEO'
1536 include 'COMMON.VAR'
1537 include 'COMMON.LOCAL'
1538 include 'COMMON.CHAIN'
1539 include 'COMMON.DERIV'
1540 include 'COMMON.NAMES'
1541 include 'COMMON.INTERACT'
1542 include 'COMMON.IOUNITS'
1543 include 'COMMON.CALC'
1544 common /srutu/ icall
1547 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1550 c if (icall.eq.0) lprn=.true.
1552 do i=iatsc_s,iatsc_e
1554 if (itypi.eq.21) cycle
1559 dxi=dc_norm(1,nres+i)
1560 dyi=dc_norm(2,nres+i)
1561 dzi=dc_norm(3,nres+i)
1562 c dsci_inv=dsc_inv(itypi)
1563 dsci_inv=vbld_inv(i+nres)
1565 C Calculate SC interaction energy.
1567 do iint=1,nint_gr(i)
1568 do j=istart(i,iint),iend(i,iint)
1571 if (itypj.eq.21) cycle
1572 c dscj_inv=dsc_inv(itypj)
1573 dscj_inv=vbld_inv(j+nres)
1574 sig0ij=sigma(itypi,itypj)
1575 r0ij=r0(itypi,itypj)
1576 chi1=chi(itypi,itypj)
1577 chi2=chi(itypj,itypi)
1584 alf12=0.5D0*(alf1+alf2)
1585 C For diagnostics only!!!
1598 dxj=dc_norm(1,nres+j)
1599 dyj=dc_norm(2,nres+j)
1600 dzj=dc_norm(3,nres+j)
1601 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1603 C Calculate angle-dependent terms of energy and contributions to their
1607 sig=sig0ij*dsqrt(sigsq)
1608 rij_shift=1.0D0/rij-sig+r0ij
1609 C I hate to put IF's in the loops, but here don't have another choice!!!!
1610 if (rij_shift.le.0.0D0) then
1615 c---------------------------------------------------------------
1616 rij_shift=1.0D0/rij_shift
1617 fac=rij_shift**expon
1618 e1=fac*fac*aa(itypi,itypj)
1619 e2=fac*bb(itypi,itypj)
1620 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1621 eps2der=evdwij*eps3rt
1622 eps3der=evdwij*eps2rt
1623 fac_augm=rrij**expon
1624 e_augm=augm(itypi,itypj)*fac_augm
1625 evdwij=evdwij*eps2rt*eps3rt
1626 evdw=evdw+evdwij+e_augm
1628 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1629 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1630 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1631 & restyp(itypi),i,restyp(itypj),j,
1632 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1633 & chi1,chi2,chip1,chip2,
1634 & eps1,eps2rt**2,eps3rt**2,
1635 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1638 C Calculate gradient components.
1639 e1=e1*eps1*eps2rt**2*eps3rt**2
1640 fac=-expon*(e1+evdwij)*rij_shift
1642 fac=rij*fac-2*expon*rrij*e_augm
1643 C Calculate the radial part of the gradient
1647 C Calculate angular part of the gradient.
1653 C-----------------------------------------------------------------------------
1654 subroutine sc_angular
1655 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1656 C om12. Called by ebp, egb, and egbv.
1658 include 'COMMON.CALC'
1659 include 'COMMON.IOUNITS'
1663 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1664 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1665 om12=dxi*dxj+dyi*dyj+dzi*dzj
1667 C Calculate eps1(om12) and its derivative in om12
1668 faceps1=1.0D0-om12*chiom12
1669 faceps1_inv=1.0D0/faceps1
1670 eps1=dsqrt(faceps1_inv)
1671 C Following variable is eps1*deps1/dom12
1672 eps1_om12=faceps1_inv*chiom12
1677 c write (iout,*) "om12",om12," eps1",eps1
1678 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1683 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1684 sigsq=1.0D0-facsig*faceps1_inv
1685 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1686 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1687 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1693 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1694 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1696 C Calculate eps2 and its derivatives in om1, om2, and om12.
1699 chipom12=chip12*om12
1700 facp=1.0D0-om12*chipom12
1702 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1703 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1704 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1705 C Following variable is the square root of eps2
1706 eps2rt=1.0D0-facp1*facp_inv
1707 C Following three variables are the derivatives of the square root of eps
1708 C in om1, om2, and om12.
1709 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1710 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1711 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1712 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1713 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1714 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1715 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1716 c & " eps2rt_om12",eps2rt_om12
1717 C Calculate whole angle-dependent part of epsilon and contributions
1718 C to its derivatives
1721 C----------------------------------------------------------------------------
1723 implicit real*8 (a-h,o-z)
1724 include 'DIMENSIONS'
1725 include 'COMMON.CHAIN'
1726 include 'COMMON.DERIV'
1727 include 'COMMON.CALC'
1728 include 'COMMON.IOUNITS'
1729 double precision dcosom1(3),dcosom2(3)
1730 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1731 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1732 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1733 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1737 c eom12=evdwij*eps1_om12
1739 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1740 c & " sigder",sigder
1741 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1742 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1744 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1745 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1748 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1750 c write (iout,*) "gg",(gg(k),k=1,3)
1752 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1753 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1754 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1755 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1756 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1757 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1758 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1759 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1760 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1761 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1764 C Calculate the components of the gradient in DC and X
1768 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1772 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1773 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1777 C-----------------------------------------------------------------------
1778 subroutine e_softsphere(evdw)
1780 C This subroutine calculates the interaction energy of nonbonded side chains
1781 C assuming the LJ potential of interaction.
1783 implicit real*8 (a-h,o-z)
1784 include 'DIMENSIONS'
1785 parameter (accur=1.0d-10)
1786 include 'COMMON.GEO'
1787 include 'COMMON.VAR'
1788 include 'COMMON.LOCAL'
1789 include 'COMMON.CHAIN'
1790 include 'COMMON.DERIV'
1791 include 'COMMON.INTERACT'
1792 include 'COMMON.TORSION'
1793 include 'COMMON.SBRIDGE'
1794 include 'COMMON.NAMES'
1795 include 'COMMON.IOUNITS'
1796 include 'COMMON.CONTACTS'
1798 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1800 do i=iatsc_s,iatsc_e
1802 if (itypi.eq.21) cycle
1808 C Calculate SC interaction energy.
1810 do iint=1,nint_gr(i)
1811 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1812 cd & 'iend=',iend(i,iint)
1813 do j=istart(i,iint),iend(i,iint)
1815 if (itypj.eq.21) cycle
1819 rij=xj*xj+yj*yj+zj*zj
1820 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1821 r0ij=r0(itypi,itypj)
1823 c print *,i,j,r0ij,dsqrt(rij)
1824 if (rij.lt.r0ijsq) then
1825 evdwij=0.25d0*(rij-r0ijsq)**2
1833 C Calculate the components of the gradient in DC and X
1839 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1840 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1841 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1842 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1846 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1854 C--------------------------------------------------------------------------
1855 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1858 C Soft-sphere potential of p-p interaction
1860 implicit real*8 (a-h,o-z)
1861 include 'DIMENSIONS'
1862 include 'COMMON.CONTROL'
1863 include 'COMMON.IOUNITS'
1864 include 'COMMON.GEO'
1865 include 'COMMON.VAR'
1866 include 'COMMON.LOCAL'
1867 include 'COMMON.CHAIN'
1868 include 'COMMON.DERIV'
1869 include 'COMMON.INTERACT'
1870 include 'COMMON.CONTACTS'
1871 include 'COMMON.TORSION'
1872 include 'COMMON.VECTORS'
1873 include 'COMMON.FFIELD'
1875 cd write(iout,*) 'In EELEC_soft_sphere'
1882 do i=iatel_s,iatel_e
1883 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
1887 xmedi=c(1,i)+0.5d0*dxi
1888 ymedi=c(2,i)+0.5d0*dyi
1889 zmedi=c(3,i)+0.5d0*dzi
1891 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1892 do j=ielstart(i),ielend(i)
1893 if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
1897 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1898 r0ij=rpp(iteli,itelj)
1903 xj=c(1,j)+0.5D0*dxj-xmedi
1904 yj=c(2,j)+0.5D0*dyj-ymedi
1905 zj=c(3,j)+0.5D0*dzj-zmedi
1906 rij=xj*xj+yj*yj+zj*zj
1907 if (rij.lt.r0ijsq) then
1908 evdw1ij=0.25d0*(rij-r0ijsq)**2
1916 C Calculate contributions to the Cartesian gradient.
1922 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1923 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1926 * Loop over residues i+1 thru j-1.
1930 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1935 cgrad do i=nnt,nct-1
1937 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1939 cgrad do j=i+1,nct-1
1941 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
1947 c------------------------------------------------------------------------------
1948 subroutine vec_and_deriv
1949 implicit real*8 (a-h,o-z)
1950 include 'DIMENSIONS'
1954 include 'COMMON.IOUNITS'
1955 include 'COMMON.GEO'
1956 include 'COMMON.VAR'
1957 include 'COMMON.LOCAL'
1958 include 'COMMON.CHAIN'
1959 include 'COMMON.VECTORS'
1960 include 'COMMON.SETUP'
1961 include 'COMMON.TIME1'
1962 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1963 C Compute the local reference systems. For reference system (i), the
1964 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1965 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1967 do i=ivec_start,ivec_end
1971 if (i.eq.nres-1) then
1972 C Case of the last full residue
1973 C Compute the Z-axis
1974 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1975 costh=dcos(pi-theta(nres))
1976 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1980 C Compute the derivatives of uz
1982 uzder(2,1,1)=-dc_norm(3,i-1)
1983 uzder(3,1,1)= dc_norm(2,i-1)
1984 uzder(1,2,1)= dc_norm(3,i-1)
1986 uzder(3,2,1)=-dc_norm(1,i-1)
1987 uzder(1,3,1)=-dc_norm(2,i-1)
1988 uzder(2,3,1)= dc_norm(1,i-1)
1991 uzder(2,1,2)= dc_norm(3,i)
1992 uzder(3,1,2)=-dc_norm(2,i)
1993 uzder(1,2,2)=-dc_norm(3,i)
1995 uzder(3,2,2)= dc_norm(1,i)
1996 uzder(1,3,2)= dc_norm(2,i)
1997 uzder(2,3,2)=-dc_norm(1,i)
1999 C Compute the Y-axis
2002 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2004 C Compute the derivatives of uy
2007 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2008 & -dc_norm(k,i)*dc_norm(j,i-1)
2009 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2011 uyder(j,j,1)=uyder(j,j,1)-costh
2012 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2017 uygrad(l,k,j,i)=uyder(l,k,j)
2018 uzgrad(l,k,j,i)=uzder(l,k,j)
2022 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2023 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2024 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2025 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2028 C Compute the Z-axis
2029 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2030 costh=dcos(pi-theta(i+2))
2031 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2035 C Compute the derivatives of uz
2037 uzder(2,1,1)=-dc_norm(3,i+1)
2038 uzder(3,1,1)= dc_norm(2,i+1)
2039 uzder(1,2,1)= dc_norm(3,i+1)
2041 uzder(3,2,1)=-dc_norm(1,i+1)
2042 uzder(1,3,1)=-dc_norm(2,i+1)
2043 uzder(2,3,1)= dc_norm(1,i+1)
2046 uzder(2,1,2)= dc_norm(3,i)
2047 uzder(3,1,2)=-dc_norm(2,i)
2048 uzder(1,2,2)=-dc_norm(3,i)
2050 uzder(3,2,2)= dc_norm(1,i)
2051 uzder(1,3,2)= dc_norm(2,i)
2052 uzder(2,3,2)=-dc_norm(1,i)
2054 C Compute the Y-axis
2057 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2059 C Compute the derivatives of uy
2062 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2063 & -dc_norm(k,i)*dc_norm(j,i+1)
2064 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2066 uyder(j,j,1)=uyder(j,j,1)-costh
2067 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2072 uygrad(l,k,j,i)=uyder(l,k,j)
2073 uzgrad(l,k,j,i)=uzder(l,k,j)
2077 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2078 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2079 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2080 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2084 vbld_inv_temp(1)=vbld_inv(i+1)
2085 if (i.lt.nres-1) then
2086 vbld_inv_temp(2)=vbld_inv(i+2)
2088 vbld_inv_temp(2)=vbld_inv(i)
2093 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2094 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2099 #if defined(PARVEC) && defined(MPI)
2100 if (nfgtasks1.gt.1) then
2102 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2103 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2104 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2105 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2106 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2108 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2109 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2111 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2112 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2113 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2114 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2115 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2116 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2117 time_gather=time_gather+MPI_Wtime()-time00
2119 c if (fg_rank.eq.0) then
2120 c write (iout,*) "Arrays UY and UZ"
2122 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2129 C-----------------------------------------------------------------------------
2130 subroutine check_vecgrad
2131 implicit real*8 (a-h,o-z)
2132 include 'DIMENSIONS'
2133 include 'COMMON.IOUNITS'
2134 include 'COMMON.GEO'
2135 include 'COMMON.VAR'
2136 include 'COMMON.LOCAL'
2137 include 'COMMON.CHAIN'
2138 include 'COMMON.VECTORS'
2139 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2140 dimension uyt(3,maxres),uzt(3,maxres)
2141 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2142 double precision delta /1.0d-7/
2145 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2146 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2147 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2148 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2149 cd & (dc_norm(if90,i),if90=1,3)
2150 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2151 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2152 cd write(iout,'(a)')
2158 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2159 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2172 cd write (iout,*) 'i=',i
2174 erij(k)=dc_norm(k,i)
2178 dc_norm(k,i)=erij(k)
2180 dc_norm(j,i)=dc_norm(j,i)+delta
2181 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2183 c dc_norm(k,i)=dc_norm(k,i)/fac
2185 c write (iout,*) (dc_norm(k,i),k=1,3)
2186 c write (iout,*) (erij(k),k=1,3)
2189 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2190 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2191 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2192 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2194 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2195 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2196 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2199 dc_norm(k,i)=erij(k)
2202 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2203 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2204 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2205 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2206 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2207 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2208 cd write (iout,'(a)')
2213 C--------------------------------------------------------------------------
2214 subroutine set_matrices
2215 implicit real*8 (a-h,o-z)
2216 include 'DIMENSIONS'
2219 include "COMMON.SETUP"
2221 integer status(MPI_STATUS_SIZE)
2223 include 'COMMON.IOUNITS'
2224 include 'COMMON.GEO'
2225 include 'COMMON.VAR'
2226 include 'COMMON.LOCAL'
2227 include 'COMMON.CHAIN'
2228 include 'COMMON.DERIV'
2229 include 'COMMON.INTERACT'
2230 include 'COMMON.CONTACTS'
2231 include 'COMMON.TORSION'
2232 include 'COMMON.VECTORS'
2233 include 'COMMON.FFIELD'
2234 double precision auxvec(2),auxmat(2,2)
2236 C Compute the virtual-bond-torsional-angle dependent quantities needed
2237 C to calculate the el-loc multibody terms of various order.
2240 do i=ivec_start+2,ivec_end+2
2244 if (i .lt. nres+1) then
2281 if (i .gt. 3 .and. i .lt. nres+1) then
2282 obrot_der(1,i-2)=-sin1
2283 obrot_der(2,i-2)= cos1
2284 Ugder(1,1,i-2)= sin1
2285 Ugder(1,2,i-2)=-cos1
2286 Ugder(2,1,i-2)=-cos1
2287 Ugder(2,2,i-2)=-sin1
2290 obrot2_der(1,i-2)=-dwasin2
2291 obrot2_der(2,i-2)= dwacos2
2292 Ug2der(1,1,i-2)= dwasin2
2293 Ug2der(1,2,i-2)=-dwacos2
2294 Ug2der(2,1,i-2)=-dwacos2
2295 Ug2der(2,2,i-2)=-dwasin2
2297 obrot_der(1,i-2)=0.0d0
2298 obrot_der(2,i-2)=0.0d0
2299 Ugder(1,1,i-2)=0.0d0
2300 Ugder(1,2,i-2)=0.0d0
2301 Ugder(2,1,i-2)=0.0d0
2302 Ugder(2,2,i-2)=0.0d0
2303 obrot2_der(1,i-2)=0.0d0
2304 obrot2_der(2,i-2)=0.0d0
2305 Ug2der(1,1,i-2)=0.0d0
2306 Ug2der(1,2,i-2)=0.0d0
2307 Ug2der(2,1,i-2)=0.0d0
2308 Ug2der(2,2,i-2)=0.0d0
2310 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2311 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2312 iti = itortyp(itype(i-2))
2316 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2317 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2318 iti1 = itortyp(itype(i-1))
2322 cd write (iout,*) '*******i',i,' iti1',iti
2323 cd write (iout,*) 'b1',b1(:,iti)
2324 cd write (iout,*) 'b2',b2(:,iti)
2325 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2326 c if (i .gt. iatel_s+2) then
2327 if (i .gt. nnt+2) then
2328 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2329 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2330 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2332 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2333 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2334 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2335 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2336 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2347 DtUg2(l,k,i-2)=0.0d0
2351 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2352 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2354 muder(k,i-2)=Ub2der(k,i-2)
2356 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2357 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2358 iti1 = itortyp(itype(i-1))
2363 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2365 cd write (iout,*) 'mu ',mu(:,i-2)
2366 cd write (iout,*) 'mu1',mu1(:,i-2)
2367 cd write (iout,*) 'mu2',mu2(:,i-2)
2368 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2370 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2371 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2372 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2373 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2374 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2375 C Vectors and matrices dependent on a single virtual-bond dihedral.
2376 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2377 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2378 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2379 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2380 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2381 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2382 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2383 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2384 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2387 C Matrices dependent on two consecutive virtual-bond dihedrals.
2388 C The order of matrices is from left to right.
2389 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2391 c do i=max0(ivec_start,2),ivec_end
2393 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2394 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2395 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2396 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2397 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2398 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2399 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2400 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2403 #if defined(MPI) && defined(PARMAT)
2405 c if (fg_rank.eq.0) then
2406 write (iout,*) "Arrays UG and UGDER before GATHER"
2408 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2409 & ((ug(l,k,i),l=1,2),k=1,2),
2410 & ((ugder(l,k,i),l=1,2),k=1,2)
2412 write (iout,*) "Arrays UG2 and UG2DER"
2414 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2415 & ((ug2(l,k,i),l=1,2),k=1,2),
2416 & ((ug2der(l,k,i),l=1,2),k=1,2)
2418 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2420 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2421 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2422 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2424 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2426 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2427 & costab(i),sintab(i),costab2(i),sintab2(i)
2429 write (iout,*) "Array MUDER"
2431 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2435 if (nfgtasks.gt.1) then
2437 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2438 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2439 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2441 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2442 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2444 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2445 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2447 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2448 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2450 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2451 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2453 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2454 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2456 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2457 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2459 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2460 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2461 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2462 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2463 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2464 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2465 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2466 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2467 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2468 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2469 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2470 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2471 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2473 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2474 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2476 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2477 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2479 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2480 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2482 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2483 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2485 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2486 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2488 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2489 & ivec_count(fg_rank1),
2490 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2492 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2493 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2495 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2496 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2498 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2499 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2501 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2502 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2504 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2505 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2507 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2508 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2510 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2511 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2513 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2514 & ivec_count(fg_rank1),
2515 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2517 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2518 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2520 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2521 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2523 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2524 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2526 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2527 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2529 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2530 & ivec_count(fg_rank1),
2531 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2533 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2534 & ivec_count(fg_rank1),
2535 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2537 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2538 & ivec_count(fg_rank1),
2539 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2540 & MPI_MAT2,FG_COMM1,IERR)
2541 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2542 & ivec_count(fg_rank1),
2543 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2544 & MPI_MAT2,FG_COMM1,IERR)
2547 c Passes matrix info through the ring
2550 if (irecv.lt.0) irecv=nfgtasks1-1
2553 if (inext.ge.nfgtasks1) inext=0
2555 c write (iout,*) "isend",isend," irecv",irecv
2557 lensend=lentyp(isend)
2558 lenrecv=lentyp(irecv)
2559 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2560 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2561 c & MPI_ROTAT1(lensend),inext,2200+isend,
2562 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2563 c & iprev,2200+irecv,FG_COMM,status,IERR)
2564 c write (iout,*) "Gather ROTAT1"
2566 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2567 c & MPI_ROTAT2(lensend),inext,3300+isend,
2568 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2569 c & iprev,3300+irecv,FG_COMM,status,IERR)
2570 c write (iout,*) "Gather ROTAT2"
2572 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2573 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2574 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2575 & iprev,4400+irecv,FG_COMM,status,IERR)
2576 c write (iout,*) "Gather ROTAT_OLD"
2578 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2579 & MPI_PRECOMP11(lensend),inext,5500+isend,
2580 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2581 & iprev,5500+irecv,FG_COMM,status,IERR)
2582 c write (iout,*) "Gather PRECOMP11"
2584 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2585 & MPI_PRECOMP12(lensend),inext,6600+isend,
2586 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2587 & iprev,6600+irecv,FG_COMM,status,IERR)
2588 c write (iout,*) "Gather PRECOMP12"
2590 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2592 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2593 & MPI_ROTAT2(lensend),inext,7700+isend,
2594 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2595 & iprev,7700+irecv,FG_COMM,status,IERR)
2596 c write (iout,*) "Gather PRECOMP21"
2598 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2599 & MPI_PRECOMP22(lensend),inext,8800+isend,
2600 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2601 & iprev,8800+irecv,FG_COMM,status,IERR)
2602 c write (iout,*) "Gather PRECOMP22"
2604 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2605 & MPI_PRECOMP23(lensend),inext,9900+isend,
2606 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2607 & MPI_PRECOMP23(lenrecv),
2608 & iprev,9900+irecv,FG_COMM,status,IERR)
2609 c write (iout,*) "Gather PRECOMP23"
2614 if (irecv.lt.0) irecv=nfgtasks1-1
2617 time_gather=time_gather+MPI_Wtime()-time00
2620 c if (fg_rank.eq.0) then
2621 write (iout,*) "Arrays UG and UGDER"
2623 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2624 & ((ug(l,k,i),l=1,2),k=1,2),
2625 & ((ugder(l,k,i),l=1,2),k=1,2)
2627 write (iout,*) "Arrays UG2 and UG2DER"
2629 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2630 & ((ug2(l,k,i),l=1,2),k=1,2),
2631 & ((ug2der(l,k,i),l=1,2),k=1,2)
2633 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2635 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2636 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2637 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2639 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2641 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2642 & costab(i),sintab(i),costab2(i),sintab2(i)
2644 write (iout,*) "Array MUDER"
2646 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2652 cd iti = itortyp(itype(i))
2655 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2656 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2661 C--------------------------------------------------------------------------
2662 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2664 C This subroutine calculates the average interaction energy and its gradient
2665 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2666 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2667 C The potential depends both on the distance of peptide-group centers and on
2668 C the orientation of the CA-CA virtual bonds.
2670 implicit real*8 (a-h,o-z)
2674 include 'DIMENSIONS'
2675 include 'COMMON.CONTROL'
2676 include 'COMMON.SETUP'
2677 include 'COMMON.IOUNITS'
2678 include 'COMMON.GEO'
2679 include 'COMMON.VAR'
2680 include 'COMMON.LOCAL'
2681 include 'COMMON.CHAIN'
2682 include 'COMMON.DERIV'
2683 include 'COMMON.INTERACT'
2684 include 'COMMON.CONTACTS'
2685 include 'COMMON.TORSION'
2686 include 'COMMON.VECTORS'
2687 include 'COMMON.FFIELD'
2688 include 'COMMON.TIME1'
2689 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2690 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2691 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2692 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2693 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2694 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2696 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2698 double precision scal_el /1.0d0/
2700 double precision scal_el /0.5d0/
2703 C 13-go grudnia roku pamietnego...
2704 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2705 & 0.0d0,1.0d0,0.0d0,
2706 & 0.0d0,0.0d0,1.0d0/
2707 cd write(iout,*) 'In EELEC'
2709 cd write(iout,*) 'Type',i
2710 cd write(iout,*) 'B1',B1(:,i)
2711 cd write(iout,*) 'B2',B2(:,i)
2712 cd write(iout,*) 'CC',CC(:,:,i)
2713 cd write(iout,*) 'DD',DD(:,:,i)
2714 cd write(iout,*) 'EE',EE(:,:,i)
2716 cd call check_vecgrad
2718 if (icheckgrad.eq.1) then
2720 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2722 dc_norm(k,i)=dc(k,i)*fac
2724 c write (iout,*) 'i',i,' fac',fac
2727 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2728 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2729 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2730 c call vec_and_deriv
2736 time_mat=time_mat+MPI_Wtime()-time01
2740 cd write (iout,*) 'i=',i
2742 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2745 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2746 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2759 cd print '(a)','Enter EELEC'
2760 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2762 gel_loc_loc(i)=0.0d0
2767 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2769 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2771 do i=iturn3_start,iturn3_end
2772 if (itype(i).eq.21 .or. itype(i+1).eq.21
2773 & .or. itype(i+2).eq.21 .or. itype(i+3).eq.21) cycle
2777 dx_normi=dc_norm(1,i)
2778 dy_normi=dc_norm(2,i)
2779 dz_normi=dc_norm(3,i)
2780 xmedi=c(1,i)+0.5d0*dxi
2781 ymedi=c(2,i)+0.5d0*dyi
2782 zmedi=c(3,i)+0.5d0*dzi
2784 call eelecij(i,i+2,ees,evdw1,eel_loc)
2785 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2786 num_cont_hb(i)=num_conti
2788 do i=iturn4_start,iturn4_end
2789 if (itype(i).eq.21 .or. itype(i+1).eq.21
2790 & .or. itype(i+3).eq.21
2791 & .or. itype(i+4).eq.21) cycle
2795 dx_normi=dc_norm(1,i)
2796 dy_normi=dc_norm(2,i)
2797 dz_normi=dc_norm(3,i)
2798 xmedi=c(1,i)+0.5d0*dxi
2799 ymedi=c(2,i)+0.5d0*dyi
2800 zmedi=c(3,i)+0.5d0*dzi
2801 num_conti=num_cont_hb(i)
2802 call eelecij(i,i+3,ees,evdw1,eel_loc)
2803 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.21)
2804 & call eturn4(i,eello_turn4)
2805 num_cont_hb(i)=num_conti
2808 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2810 do i=iatel_s,iatel_e
2811 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
2815 dx_normi=dc_norm(1,i)
2816 dy_normi=dc_norm(2,i)
2817 dz_normi=dc_norm(3,i)
2818 xmedi=c(1,i)+0.5d0*dxi
2819 ymedi=c(2,i)+0.5d0*dyi
2820 zmedi=c(3,i)+0.5d0*dzi
2821 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2822 num_conti=num_cont_hb(i)
2823 do j=ielstart(i),ielend(i)
2824 c write (iout,*) i,j,itype(i),itype(j)
2825 if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
2826 call eelecij(i,j,ees,evdw1,eel_loc)
2828 num_cont_hb(i)=num_conti
2830 c write (iout,*) "Number of loop steps in EELEC:",ind
2832 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2833 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2835 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2836 ccc eel_loc=eel_loc+eello_turn3
2837 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2840 C-------------------------------------------------------------------------------
2841 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2842 implicit real*8 (a-h,o-z)
2843 include 'DIMENSIONS'
2847 include 'COMMON.CONTROL'
2848 include 'COMMON.IOUNITS'
2849 include 'COMMON.GEO'
2850 include 'COMMON.VAR'
2851 include 'COMMON.LOCAL'
2852 include 'COMMON.CHAIN'
2853 include 'COMMON.DERIV'
2854 include 'COMMON.INTERACT'
2855 include 'COMMON.CONTACTS'
2856 include 'COMMON.TORSION'
2857 include 'COMMON.VECTORS'
2858 include 'COMMON.FFIELD'
2859 include 'COMMON.TIME1'
2860 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2861 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2862 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2863 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2864 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2865 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2867 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2869 double precision scal_el /1.0d0/
2871 double precision scal_el /0.5d0/
2874 C 13-go grudnia roku pamietnego...
2875 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2876 & 0.0d0,1.0d0,0.0d0,
2877 & 0.0d0,0.0d0,1.0d0/
2878 c time00=MPI_Wtime()
2879 cd write (iout,*) "eelecij",i,j
2883 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2884 aaa=app(iteli,itelj)
2885 bbb=bpp(iteli,itelj)
2886 ael6i=ael6(iteli,itelj)
2887 ael3i=ael3(iteli,itelj)
2891 dx_normj=dc_norm(1,j)
2892 dy_normj=dc_norm(2,j)
2893 dz_normj=dc_norm(3,j)
2894 xj=c(1,j)+0.5D0*dxj-xmedi
2895 yj=c(2,j)+0.5D0*dyj-ymedi
2896 zj=c(3,j)+0.5D0*dzj-zmedi
2897 rij=xj*xj+yj*yj+zj*zj
2903 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2904 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2905 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2906 fac=cosa-3.0D0*cosb*cosg
2908 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2909 if (j.eq.i+2) ev1=scal_el*ev1
2914 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2917 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2918 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2921 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2922 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2923 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2924 cd & xmedi,ymedi,zmedi,xj,yj,zj
2926 if (energy_dec) then
2927 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
2928 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2932 C Calculate contributions to the Cartesian gradient.
2935 facvdw=-6*rrmij*(ev1+evdwij)
2936 facel=-3*rrmij*(el1+eesij)
2942 * Radial derivatives. First process both termini of the fragment (i,j)
2948 c ghalf=0.5D0*ggg(k)
2949 c gelc(k,i)=gelc(k,i)+ghalf
2950 c gelc(k,j)=gelc(k,j)+ghalf
2952 c 9/28/08 AL Gradient compotents will be summed only at the end
2954 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2955 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2958 * Loop over residues i+1 thru j-1.
2962 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2969 c ghalf=0.5D0*ggg(k)
2970 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2971 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2973 c 9/28/08 AL Gradient compotents will be summed only at the end
2975 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2976 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2979 * Loop over residues i+1 thru j-1.
2983 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2990 fac=-3*rrmij*(facvdw+facvdw+facel)
2995 * Radial derivatives. First process both termini of the fragment (i,j)
3001 c ghalf=0.5D0*ggg(k)
3002 c gelc(k,i)=gelc(k,i)+ghalf
3003 c gelc(k,j)=gelc(k,j)+ghalf
3005 c 9/28/08 AL Gradient compotents will be summed only at the end
3007 gelc_long(k,j)=gelc(k,j)+ggg(k)
3008 gelc_long(k,i)=gelc(k,i)-ggg(k)
3011 * Loop over residues i+1 thru j-1.
3015 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3018 c 9/28/08 AL Gradient compotents will be summed only at the end
3023 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3024 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3030 ecosa=2.0D0*fac3*fac1+fac4
3033 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3034 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3036 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3037 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3039 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3040 cd & (dcosg(k),k=1,3)
3042 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3045 c ghalf=0.5D0*ggg(k)
3046 c gelc(k,i)=gelc(k,i)+ghalf
3047 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3048 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3049 c gelc(k,j)=gelc(k,j)+ghalf
3050 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3051 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3055 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3060 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3061 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3063 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3064 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3065 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3066 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3068 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3069 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3070 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3072 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3073 C energy of a peptide unit is assumed in the form of a second-order
3074 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3075 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3076 C are computed for EVERY pair of non-contiguous peptide groups.
3078 if (j.lt.nres-1) then
3089 muij(kkk)=mu(k,i)*mu(l,j)
3092 cd write (iout,*) 'EELEC: i',i,' j',j
3093 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3094 cd write(iout,*) 'muij',muij
3095 ury=scalar(uy(1,i),erij)
3096 urz=scalar(uz(1,i),erij)
3097 vry=scalar(uy(1,j),erij)
3098 vrz=scalar(uz(1,j),erij)
3099 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3100 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3101 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3102 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3103 fac=dsqrt(-ael6i)*r3ij
3108 cd write (iout,'(4i5,4f10.5)')
3109 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3110 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3111 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3112 cd & uy(:,j),uz(:,j)
3113 cd write (iout,'(4f10.5)')
3114 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3115 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3116 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3117 cd write (iout,'(9f10.5/)')
3118 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3119 C Derivatives of the elements of A in virtual-bond vectors
3120 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3122 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3123 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3124 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3125 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3126 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3127 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3128 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3129 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3130 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3131 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3132 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3133 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3135 C Compute radial contributions to the gradient
3153 C Add the contributions coming from er
3156 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3157 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3158 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3159 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3162 C Derivatives in DC(i)
3163 cgrad ghalf1=0.5d0*agg(k,1)
3164 cgrad ghalf2=0.5d0*agg(k,2)
3165 cgrad ghalf3=0.5d0*agg(k,3)
3166 cgrad ghalf4=0.5d0*agg(k,4)
3167 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3168 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3169 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3170 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3171 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3172 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3173 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3174 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3175 C Derivatives in DC(i+1)
3176 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3177 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3178 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3179 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3180 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3181 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3182 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3183 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3184 C Derivatives in DC(j)
3185 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3186 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3187 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3188 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3189 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3190 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3191 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3192 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3193 C Derivatives in DC(j+1) or DC(nres-1)
3194 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3195 & -3.0d0*vryg(k,3)*ury)
3196 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3197 & -3.0d0*vrzg(k,3)*ury)
3198 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3199 & -3.0d0*vryg(k,3)*urz)
3200 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3201 & -3.0d0*vrzg(k,3)*urz)
3202 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3204 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3217 aggi(k,l)=-aggi(k,l)
3218 aggi1(k,l)=-aggi1(k,l)
3219 aggj(k,l)=-aggj(k,l)
3220 aggj1(k,l)=-aggj1(k,l)
3223 if (j.lt.nres-1) then
3229 aggi(k,l)=-aggi(k,l)
3230 aggi1(k,l)=-aggi1(k,l)
3231 aggj(k,l)=-aggj(k,l)
3232 aggj1(k,l)=-aggj1(k,l)
3243 aggi(k,l)=-aggi(k,l)
3244 aggi1(k,l)=-aggi1(k,l)
3245 aggj(k,l)=-aggj(k,l)
3246 aggj1(k,l)=-aggj1(k,l)
3251 IF (wel_loc.gt.0.0d0) THEN
3252 C Contribution to the local-electrostatic energy coming from the i-j pair
3253 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3255 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3257 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3258 & 'eelloc',i,j,eel_loc_ij
3260 eel_loc=eel_loc+eel_loc_ij
3261 C Partial derivatives in virtual-bond dihedral angles gamma
3263 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3264 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3265 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3266 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3267 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3268 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3269 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3271 ggg(l)=agg(l,1)*muij(1)+
3272 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3273 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3274 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3275 cgrad ghalf=0.5d0*ggg(l)
3276 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3277 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3281 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3284 C Remaining derivatives of eello
3286 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3287 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3288 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3289 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3290 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3291 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3292 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3293 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3296 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3297 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3298 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3299 & .and. num_conti.le.maxconts) then
3300 c write (iout,*) i,j," entered corr"
3302 C Calculate the contact function. The ith column of the array JCONT will
3303 C contain the numbers of atoms that make contacts with the atom I (of numbers
3304 C greater than I). The arrays FACONT and GACONT will contain the values of
3305 C the contact function and its derivative.
3306 c r0ij=1.02D0*rpp(iteli,itelj)
3307 c r0ij=1.11D0*rpp(iteli,itelj)
3308 r0ij=2.20D0*rpp(iteli,itelj)
3309 c r0ij=1.55D0*rpp(iteli,itelj)
3310 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3311 if (fcont.gt.0.0D0) then
3312 num_conti=num_conti+1
3313 if (num_conti.gt.maxconts) then
3314 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3315 & ' will skip next contacts for this conf.'
3317 jcont_hb(num_conti,i)=j
3318 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3319 cd & " jcont_hb",jcont_hb(num_conti,i)
3320 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3321 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3322 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3324 d_cont(num_conti,i)=rij
3325 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3326 C --- Electrostatic-interaction matrix ---
3327 a_chuj(1,1,num_conti,i)=a22
3328 a_chuj(1,2,num_conti,i)=a23
3329 a_chuj(2,1,num_conti,i)=a32
3330 a_chuj(2,2,num_conti,i)=a33
3331 C --- Gradient of rij
3333 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3340 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3341 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3342 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3343 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3344 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3349 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3350 C Calculate contact energies
3352 wij=cosa-3.0D0*cosb*cosg
3355 c fac3=dsqrt(-ael6i)/r0ij**3
3356 fac3=dsqrt(-ael6i)*r3ij
3357 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3358 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3359 if (ees0tmp.gt.0) then
3360 ees0pij=dsqrt(ees0tmp)
3364 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3365 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3366 if (ees0tmp.gt.0) then
3367 ees0mij=dsqrt(ees0tmp)
3372 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3373 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3374 C Diagnostics. Comment out or remove after debugging!
3375 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3376 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3377 c ees0m(num_conti,i)=0.0D0
3379 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3380 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3381 C Angular derivatives of the contact function
3382 ees0pij1=fac3/ees0pij
3383 ees0mij1=fac3/ees0mij
3384 fac3p=-3.0D0*fac3*rrmij
3385 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3386 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3388 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3389 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3390 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3391 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3392 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3393 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3394 ecosap=ecosa1+ecosa2
3395 ecosbp=ecosb1+ecosb2
3396 ecosgp=ecosg1+ecosg2
3397 ecosam=ecosa1-ecosa2
3398 ecosbm=ecosb1-ecosb2
3399 ecosgm=ecosg1-ecosg2
3408 facont_hb(num_conti,i)=fcont
3409 fprimcont=fprimcont/rij
3410 cd facont_hb(num_conti,i)=1.0D0
3411 C Following line is for diagnostics.
3414 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3415 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3418 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3419 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3421 gggp(1)=gggp(1)+ees0pijp*xj
3422 gggp(2)=gggp(2)+ees0pijp*yj
3423 gggp(3)=gggp(3)+ees0pijp*zj
3424 gggm(1)=gggm(1)+ees0mijp*xj
3425 gggm(2)=gggm(2)+ees0mijp*yj
3426 gggm(3)=gggm(3)+ees0mijp*zj
3427 C Derivatives due to the contact function
3428 gacont_hbr(1,num_conti,i)=fprimcont*xj
3429 gacont_hbr(2,num_conti,i)=fprimcont*yj
3430 gacont_hbr(3,num_conti,i)=fprimcont*zj
3433 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3434 c following the change of gradient-summation algorithm.
3436 cgrad ghalfp=0.5D0*gggp(k)
3437 cgrad ghalfm=0.5D0*gggm(k)
3438 gacontp_hb1(k,num_conti,i)=!ghalfp
3439 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3440 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3441 gacontp_hb2(k,num_conti,i)=!ghalfp
3442 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3443 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3444 gacontp_hb3(k,num_conti,i)=gggp(k)
3445 gacontm_hb1(k,num_conti,i)=!ghalfm
3446 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3447 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3448 gacontm_hb2(k,num_conti,i)=!ghalfm
3449 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3450 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3451 gacontm_hb3(k,num_conti,i)=gggm(k)
3453 C Diagnostics. Comment out or remove after debugging!
3455 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3456 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3457 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3458 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3459 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3460 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3463 endif ! num_conti.le.maxconts
3466 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3469 ghalf=0.5d0*agg(l,k)
3470 aggi(l,k)=aggi(l,k)+ghalf
3471 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3472 aggj(l,k)=aggj(l,k)+ghalf
3475 if (j.eq.nres-1 .and. i.lt.j-2) then
3478 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3483 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3486 C-----------------------------------------------------------------------------
3487 subroutine eturn3(i,eello_turn3)
3488 C Third- and fourth-order contributions from turns
3489 implicit real*8 (a-h,o-z)
3490 include 'DIMENSIONS'
3491 include 'COMMON.IOUNITS'
3492 include 'COMMON.GEO'
3493 include 'COMMON.VAR'
3494 include 'COMMON.LOCAL'
3495 include 'COMMON.CHAIN'
3496 include 'COMMON.DERIV'
3497 include 'COMMON.INTERACT'
3498 include 'COMMON.CONTACTS'
3499 include 'COMMON.TORSION'
3500 include 'COMMON.VECTORS'
3501 include 'COMMON.FFIELD'
3502 include 'COMMON.CONTROL'
3504 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3505 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3506 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3507 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3508 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3509 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3510 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3513 c write (iout,*) "eturn3",i,j,j1,j2
3518 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3520 C Third-order contributions
3527 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3528 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3529 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3530 call transpose2(auxmat(1,1),auxmat1(1,1))
3531 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3532 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3533 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3534 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3535 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3536 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3537 cd & ' eello_turn3_num',4*eello_turn3_num
3538 C Derivatives in gamma(i)
3539 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3540 call transpose2(auxmat2(1,1),auxmat3(1,1))
3541 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3542 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3543 C Derivatives in gamma(i+1)
3544 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3545 call transpose2(auxmat2(1,1),auxmat3(1,1))
3546 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3547 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3548 & +0.5d0*(pizda(1,1)+pizda(2,2))
3549 C Cartesian derivatives
3551 c ghalf1=0.5d0*agg(l,1)
3552 c ghalf2=0.5d0*agg(l,2)
3553 c ghalf3=0.5d0*agg(l,3)
3554 c ghalf4=0.5d0*agg(l,4)
3555 a_temp(1,1)=aggi(l,1)!+ghalf1
3556 a_temp(1,2)=aggi(l,2)!+ghalf2
3557 a_temp(2,1)=aggi(l,3)!+ghalf3
3558 a_temp(2,2)=aggi(l,4)!+ghalf4
3559 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3560 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3561 & +0.5d0*(pizda(1,1)+pizda(2,2))
3562 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3563 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3564 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3565 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3566 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3567 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3568 & +0.5d0*(pizda(1,1)+pizda(2,2))
3569 a_temp(1,1)=aggj(l,1)!+ghalf1
3570 a_temp(1,2)=aggj(l,2)!+ghalf2
3571 a_temp(2,1)=aggj(l,3)!+ghalf3
3572 a_temp(2,2)=aggj(l,4)!+ghalf4
3573 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3574 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3575 & +0.5d0*(pizda(1,1)+pizda(2,2))
3576 a_temp(1,1)=aggj1(l,1)
3577 a_temp(1,2)=aggj1(l,2)
3578 a_temp(2,1)=aggj1(l,3)
3579 a_temp(2,2)=aggj1(l,4)
3580 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3581 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3582 & +0.5d0*(pizda(1,1)+pizda(2,2))
3586 C-------------------------------------------------------------------------------
3587 subroutine eturn4(i,eello_turn4)
3588 C Third- and fourth-order contributions from turns
3589 implicit real*8 (a-h,o-z)
3590 include 'DIMENSIONS'
3591 include 'COMMON.IOUNITS'
3592 include 'COMMON.GEO'
3593 include 'COMMON.VAR'
3594 include 'COMMON.LOCAL'
3595 include 'COMMON.CHAIN'
3596 include 'COMMON.DERIV'
3597 include 'COMMON.INTERACT'
3598 include 'COMMON.CONTACTS'
3599 include 'COMMON.TORSION'
3600 include 'COMMON.VECTORS'
3601 include 'COMMON.FFIELD'
3602 include 'COMMON.CONTROL'
3604 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3605 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3606 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3607 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3608 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3609 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3610 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3613 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3615 C Fourth-order contributions
3623 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3624 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3625 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3630 iti1=itortyp(itype(i+1))
3631 iti2=itortyp(itype(i+2))
3632 iti3=itortyp(itype(i+3))
3633 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3634 call transpose2(EUg(1,1,i+1),e1t(1,1))
3635 call transpose2(Eug(1,1,i+2),e2t(1,1))
3636 call transpose2(Eug(1,1,i+3),e3t(1,1))
3637 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3638 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3639 s1=scalar2(b1(1,iti2),auxvec(1))
3640 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3641 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3642 s2=scalar2(b1(1,iti1),auxvec(1))
3643 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3644 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3645 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3646 eello_turn4=eello_turn4-(s1+s2+s3)
3647 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3648 & 'eturn4',i,j,-(s1+s2+s3)
3649 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3650 cd & ' eello_turn4_num',8*eello_turn4_num
3651 C Derivatives in gamma(i)
3652 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3653 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3654 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3655 s1=scalar2(b1(1,iti2),auxvec(1))
3656 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3657 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3658 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3659 C Derivatives in gamma(i+1)
3660 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3661 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3662 s2=scalar2(b1(1,iti1),auxvec(1))
3663 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3664 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3665 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3666 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3667 C Derivatives in gamma(i+2)
3668 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3669 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3670 s1=scalar2(b1(1,iti2),auxvec(1))
3671 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3672 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3673 s2=scalar2(b1(1,iti1),auxvec(1))
3674 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3675 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3676 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3677 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3678 C Cartesian derivatives
3679 C Derivatives of this turn contributions in DC(i+2)
3680 if (j.lt.nres-1) then
3682 a_temp(1,1)=agg(l,1)
3683 a_temp(1,2)=agg(l,2)
3684 a_temp(2,1)=agg(l,3)
3685 a_temp(2,2)=agg(l,4)
3686 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3687 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3688 s1=scalar2(b1(1,iti2),auxvec(1))
3689 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3690 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3691 s2=scalar2(b1(1,iti1),auxvec(1))
3692 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3693 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3694 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3696 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3699 C Remaining derivatives of this turn contribution
3701 a_temp(1,1)=aggi(l,1)
3702 a_temp(1,2)=aggi(l,2)
3703 a_temp(2,1)=aggi(l,3)
3704 a_temp(2,2)=aggi(l,4)
3705 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3706 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3707 s1=scalar2(b1(1,iti2),auxvec(1))
3708 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3709 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3710 s2=scalar2(b1(1,iti1),auxvec(1))
3711 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3712 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3713 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3714 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3715 a_temp(1,1)=aggi1(l,1)
3716 a_temp(1,2)=aggi1(l,2)
3717 a_temp(2,1)=aggi1(l,3)
3718 a_temp(2,2)=aggi1(l,4)
3719 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3720 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3721 s1=scalar2(b1(1,iti2),auxvec(1))
3722 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3723 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3724 s2=scalar2(b1(1,iti1),auxvec(1))
3725 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3726 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3727 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3728 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3729 a_temp(1,1)=aggj(l,1)
3730 a_temp(1,2)=aggj(l,2)
3731 a_temp(2,1)=aggj(l,3)
3732 a_temp(2,2)=aggj(l,4)
3733 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3734 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3735 s1=scalar2(b1(1,iti2),auxvec(1))
3736 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3737 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3738 s2=scalar2(b1(1,iti1),auxvec(1))
3739 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3740 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3741 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3742 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3743 a_temp(1,1)=aggj1(l,1)
3744 a_temp(1,2)=aggj1(l,2)
3745 a_temp(2,1)=aggj1(l,3)
3746 a_temp(2,2)=aggj1(l,4)
3747 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3748 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3749 s1=scalar2(b1(1,iti2),auxvec(1))
3750 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3751 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3752 s2=scalar2(b1(1,iti1),auxvec(1))
3753 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3754 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3755 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3756 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3757 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3761 C-----------------------------------------------------------------------------
3762 subroutine vecpr(u,v,w)
3763 implicit real*8(a-h,o-z)
3764 dimension u(3),v(3),w(3)
3765 w(1)=u(2)*v(3)-u(3)*v(2)
3766 w(2)=-u(1)*v(3)+u(3)*v(1)
3767 w(3)=u(1)*v(2)-u(2)*v(1)
3770 C-----------------------------------------------------------------------------
3771 subroutine unormderiv(u,ugrad,unorm,ungrad)
3772 C This subroutine computes the derivatives of a normalized vector u, given
3773 C the derivatives computed without normalization conditions, ugrad. Returns
3776 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3777 double precision vec(3)
3778 double precision scalar
3780 c write (2,*) 'ugrad',ugrad
3783 vec(i)=scalar(ugrad(1,i),u(1))
3785 c write (2,*) 'vec',vec
3788 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3791 c write (2,*) 'ungrad',ungrad
3794 C-----------------------------------------------------------------------------
3795 subroutine escp_soft_sphere(evdw2,evdw2_14)
3797 C This subroutine calculates the excluded-volume interaction energy between
3798 C peptide-group centers and side chains and its gradient in virtual-bond and
3799 C side-chain vectors.
3801 implicit real*8 (a-h,o-z)
3802 include 'DIMENSIONS'
3803 include 'COMMON.GEO'
3804 include 'COMMON.VAR'
3805 include 'COMMON.LOCAL'
3806 include 'COMMON.CHAIN'
3807 include 'COMMON.DERIV'
3808 include 'COMMON.INTERACT'
3809 include 'COMMON.FFIELD'
3810 include 'COMMON.IOUNITS'
3811 include 'COMMON.CONTROL'
3816 cd print '(a)','Enter ESCP'
3817 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3818 do i=iatscp_s,iatscp_e
3819 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
3821 xi=0.5D0*(c(1,i)+c(1,i+1))
3822 yi=0.5D0*(c(2,i)+c(2,i+1))
3823 zi=0.5D0*(c(3,i)+c(3,i+1))
3825 do iint=1,nscp_gr(i)
3827 do j=iscpstart(i,iint),iscpend(i,iint)
3828 if (itype(j).eq.21) cycle
3830 C Uncomment following three lines for SC-p interactions
3834 C Uncomment following three lines for Ca-p interactions
3838 rij=xj*xj+yj*yj+zj*zj
3841 if (rij.lt.r0ijsq) then
3842 evdwij=0.25d0*(rij-r0ijsq)**2
3850 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3855 cgrad if (j.lt.i) then
3856 cd write (iout,*) 'j<i'
3857 C Uncomment following three lines for SC-p interactions
3859 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3862 cd write (iout,*) 'j>i'
3864 cgrad ggg(k)=-ggg(k)
3865 C Uncomment following line for SC-p interactions
3866 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3870 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3872 cgrad kstart=min0(i+1,j)
3873 cgrad kend=max0(i-1,j-1)
3874 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3875 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3876 cgrad do k=kstart,kend
3878 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3882 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3883 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3891 C-----------------------------------------------------------------------------
3892 subroutine escp(evdw2,evdw2_14)
3894 C This subroutine calculates the excluded-volume interaction energy between
3895 C peptide-group centers and side chains and its gradient in virtual-bond and
3896 C side-chain vectors.
3898 implicit real*8 (a-h,o-z)
3899 include 'DIMENSIONS'
3900 include 'COMMON.GEO'
3901 include 'COMMON.VAR'
3902 include 'COMMON.LOCAL'
3903 include 'COMMON.CHAIN'
3904 include 'COMMON.DERIV'
3905 include 'COMMON.INTERACT'
3906 include 'COMMON.FFIELD'
3907 include 'COMMON.IOUNITS'
3908 include 'COMMON.CONTROL'
3912 cd print '(a)','Enter ESCP'
3913 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3914 do i=iatscp_s,iatscp_e
3915 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
3917 xi=0.5D0*(c(1,i)+c(1,i+1))
3918 yi=0.5D0*(c(2,i)+c(2,i+1))
3919 zi=0.5D0*(c(3,i)+c(3,i+1))
3921 do iint=1,nscp_gr(i)
3923 do j=iscpstart(i,iint),iscpend(i,iint)
3925 if (itypj.eq.21) cycle
3926 C Uncomment following three lines for SC-p interactions
3930 C Uncomment following three lines for Ca-p interactions
3934 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3936 e1=fac*fac*aad(itypj,iteli)
3937 e2=fac*bad(itypj,iteli)
3938 if (iabs(j-i) .le. 2) then
3941 evdw2_14=evdw2_14+e1+e2
3945 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3946 & 'evdw2',i,j,evdwij
3948 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3950 fac=-(evdwij+e1)*rrij
3954 cgrad if (j.lt.i) then
3955 cd write (iout,*) 'j<i'
3956 C Uncomment following three lines for SC-p interactions
3958 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3961 cd write (iout,*) 'j>i'
3963 cgrad ggg(k)=-ggg(k)
3964 C Uncomment following line for SC-p interactions
3965 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3966 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3970 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3972 cgrad kstart=min0(i+1,j)
3973 cgrad kend=max0(i-1,j-1)
3974 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3975 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3976 cgrad do k=kstart,kend
3978 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3982 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3983 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3991 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3992 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
3993 gradx_scp(j,i)=expon*gradx_scp(j,i)
3996 C******************************************************************************
4000 C To save time the factor EXPON has been extracted from ALL components
4001 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4004 C******************************************************************************
4007 C--------------------------------------------------------------------------
4008 subroutine edis(ehpb)
4010 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4012 implicit real*8 (a-h,o-z)
4013 include 'DIMENSIONS'
4014 include 'COMMON.SBRIDGE'
4015 include 'COMMON.CHAIN'
4016 include 'COMMON.DERIV'
4017 include 'COMMON.VAR'
4018 include 'COMMON.INTERACT'
4019 include 'COMMON.IOUNITS'
4022 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4023 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4024 if (link_end.eq.0) return
4025 do i=link_start,link_end
4026 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4027 C CA-CA distance used in regularization of structure.
4030 C iii and jjj point to the residues for which the distance is assigned.
4031 if (ii.gt.nres) then
4038 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4039 c & dhpb(i),dhpb1(i),forcon(i)
4040 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4041 C distance and angle dependent SS bond potential.
4042 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4043 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4044 if (.not.dyn_ss .and. i.le.nss) then
4045 C 15/02/13 CC dynamic SSbond - additional check
4047 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4048 call ssbond_ene(iii,jjj,eij)
4051 cd write (iout,*) "eij",eij
4053 C Calculate the distance between the two points and its difference from the
4057 C Get the force constant corresponding to this distance.
4059 C Calculate the contribution to energy.
4060 ehpb=ehpb+waga*rdis*rdis
4062 C Evaluate gradient.
4065 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4066 cd & ' waga=',waga,' fac=',fac
4068 ggg(j)=fac*(c(j,jj)-c(j,ii))
4070 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4071 C If this is a SC-SC distance, we need to calculate the contributions to the
4072 C Cartesian gradient in the SC vectors (ghpbx).
4075 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4076 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4079 cgrad do j=iii,jjj-1
4081 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4085 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4086 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4093 C--------------------------------------------------------------------------
4094 subroutine ssbond_ene(i,j,eij)
4096 C Calculate the distance and angle dependent SS-bond potential energy
4097 C using a free-energy function derived based on RHF/6-31G** ab initio
4098 C calculations of diethyl disulfide.
4100 C A. Liwo and U. Kozlowska, 11/24/03
4102 implicit real*8 (a-h,o-z)
4103 include 'DIMENSIONS'
4104 include 'COMMON.SBRIDGE'
4105 include 'COMMON.CHAIN'
4106 include 'COMMON.DERIV'
4107 include 'COMMON.LOCAL'
4108 include 'COMMON.INTERACT'
4109 include 'COMMON.VAR'
4110 include 'COMMON.IOUNITS'
4111 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4116 dxi=dc_norm(1,nres+i)
4117 dyi=dc_norm(2,nres+i)
4118 dzi=dc_norm(3,nres+i)
4119 c dsci_inv=dsc_inv(itypi)
4120 dsci_inv=vbld_inv(nres+i)
4122 c dscj_inv=dsc_inv(itypj)
4123 dscj_inv=vbld_inv(nres+j)
4127 dxj=dc_norm(1,nres+j)
4128 dyj=dc_norm(2,nres+j)
4129 dzj=dc_norm(3,nres+j)
4130 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4135 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4136 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4137 om12=dxi*dxj+dyi*dyj+dzi*dzj
4139 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4140 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4146 deltat12=om2-om1+2.0d0
4148 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4149 & +akct*deltad*deltat12
4150 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4151 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4152 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4153 c & " deltat12",deltat12," eij",eij
4154 ed=2*akcm*deltad+akct*deltat12
4156 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4157 eom1=-2*akth*deltat1-pom1-om2*pom2
4158 eom2= 2*akth*deltat2+pom1-om1*pom2
4161 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4162 ghpbx(k,i)=ghpbx(k,i)-ggk
4163 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4164 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4165 ghpbx(k,j)=ghpbx(k,j)+ggk
4166 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4167 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4168 ghpbc(k,i)=ghpbc(k,i)-ggk
4169 ghpbc(k,j)=ghpbc(k,j)+ggk
4172 C Calculate the components of the gradient in DC and X
4176 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4181 C--------------------------------------------------------------------------
4182 subroutine ebond(estr)
4184 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4186 implicit real*8 (a-h,o-z)
4187 include 'DIMENSIONS'
4188 include 'COMMON.LOCAL'
4189 include 'COMMON.GEO'
4190 include 'COMMON.INTERACT'
4191 include 'COMMON.DERIV'
4192 include 'COMMON.VAR'
4193 include 'COMMON.CHAIN'
4194 include 'COMMON.IOUNITS'
4195 include 'COMMON.NAMES'
4196 include 'COMMON.FFIELD'
4197 include 'COMMON.CONTROL'
4198 include 'COMMON.SETUP'
4199 double precision u(3),ud(3)
4202 do i=ibondp_start,ibondp_end
4203 if (itype(i-1).eq.21 .or. itype(i).eq.21) then
4204 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4206 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4207 & *dc(j,i-1)/vbld(i)
4209 if (energy_dec) write(iout,*)
4210 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4212 diff = vbld(i)-vbldp0
4213 if (energy_dec) write (iout,*)
4214 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4217 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4219 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4222 estr=0.5d0*AKP*estr+estr1
4224 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4226 do i=ibond_start,ibond_end
4228 if (iti.ne.10 .and. iti.ne.21) then
4231 diff=vbld(i+nres)-vbldsc0(1,iti)
4232 if (energy_dec) write (iout,*)
4233 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4234 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4235 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4237 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4241 diff=vbld(i+nres)-vbldsc0(j,iti)
4242 ud(j)=aksc(j,iti)*diff
4243 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4257 uprod2=uprod2*u(k)*u(k)
4261 usumsqder=usumsqder+ud(j)*uprod2
4263 estr=estr+uprod/usum
4265 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4273 C--------------------------------------------------------------------------
4274 subroutine ebend(etheta)
4276 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4277 C angles gamma and its derivatives in consecutive thetas and gammas.
4279 implicit real*8 (a-h,o-z)
4280 include 'DIMENSIONS'
4281 include 'COMMON.LOCAL'
4282 include 'COMMON.GEO'
4283 include 'COMMON.INTERACT'
4284 include 'COMMON.DERIV'
4285 include 'COMMON.VAR'
4286 include 'COMMON.CHAIN'
4287 include 'COMMON.IOUNITS'
4288 include 'COMMON.NAMES'
4289 include 'COMMON.FFIELD'
4290 include 'COMMON.CONTROL'
4291 common /calcthet/ term1,term2,termm,diffak,ratak,
4292 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4293 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4294 double precision y(2),z(2)
4296 c time11=dexp(-2*time)
4299 c write (*,'(a,i2)') 'EBEND ICG=',icg
4300 do i=ithet_start,ithet_end
4301 if (itype(i-1).eq.21) cycle
4302 C Zero the energy function and its derivative at 0 or pi.
4303 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4305 if (i.gt.3 .and. itype(i-2).ne.21) then
4308 if (phii.ne.phii) phii=150.0
4318 if (i.lt.nres .and. itype(i).ne.21) then
4321 if (phii1.ne.phii1) phii1=150.0
4333 C Calculate the "mean" value of theta from the part of the distribution
4334 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4335 C In following comments this theta will be referred to as t_c.
4336 thet_pred_mean=0.0d0
4340 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4342 dthett=thet_pred_mean*ssd
4343 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4344 C Derivatives of the "mean" values in gamma1 and gamma2.
4345 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4346 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4347 if (theta(i).gt.pi-delta) then
4348 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4350 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4351 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4352 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4354 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4356 else if (theta(i).lt.delta) then
4357 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4358 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4359 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4361 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4362 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4365 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4368 etheta=etheta+ethetai
4369 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4371 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4372 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4373 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4375 C Ufff.... We've done all this!!!
4378 C---------------------------------------------------------------------------
4379 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4381 implicit real*8 (a-h,o-z)
4382 include 'DIMENSIONS'
4383 include 'COMMON.LOCAL'
4384 include 'COMMON.IOUNITS'
4385 common /calcthet/ term1,term2,termm,diffak,ratak,
4386 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4387 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4388 C Calculate the contributions to both Gaussian lobes.
4389 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4390 C The "polynomial part" of the "standard deviation" of this part of
4394 sig=sig*thet_pred_mean+polthet(j,it)
4396 C Derivative of the "interior part" of the "standard deviation of the"
4397 C gamma-dependent Gaussian lobe in t_c.
4398 sigtc=3*polthet(3,it)
4400 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4403 C Set the parameters of both Gaussian lobes of the distribution.
4404 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4405 fac=sig*sig+sigc0(it)
4408 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4409 sigsqtc=-4.0D0*sigcsq*sigtc
4410 c print *,i,sig,sigtc,sigsqtc
4411 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4412 sigtc=-sigtc/(fac*fac)
4413 C Following variable is sigma(t_c)**(-2)
4414 sigcsq=sigcsq*sigcsq
4416 sig0inv=1.0D0/sig0i**2
4417 delthec=thetai-thet_pred_mean
4418 delthe0=thetai-theta0i
4419 term1=-0.5D0*sigcsq*delthec*delthec
4420 term2=-0.5D0*sig0inv*delthe0*delthe0
4421 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4422 C NaNs in taking the logarithm. We extract the largest exponent which is added
4423 C to the energy (this being the log of the distribution) at the end of energy
4424 C term evaluation for this virtual-bond angle.
4425 if (term1.gt.term2) then
4427 term2=dexp(term2-termm)
4431 term1=dexp(term1-termm)
4434 C The ratio between the gamma-independent and gamma-dependent lobes of
4435 C the distribution is a Gaussian function of thet_pred_mean too.
4436 diffak=gthet(2,it)-thet_pred_mean
4437 ratak=diffak/gthet(3,it)**2
4438 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4439 C Let's differentiate it in thet_pred_mean NOW.
4441 C Now put together the distribution terms to make complete distribution.
4442 termexp=term1+ak*term2
4443 termpre=sigc+ak*sig0i
4444 C Contribution of the bending energy from this theta is just the -log of
4445 C the sum of the contributions from the two lobes and the pre-exponential
4446 C factor. Simple enough, isn't it?
4447 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4448 C NOW the derivatives!!!
4449 C 6/6/97 Take into account the deformation.
4450 E_theta=(delthec*sigcsq*term1
4451 & +ak*delthe0*sig0inv*term2)/termexp
4452 E_tc=((sigtc+aktc*sig0i)/termpre
4453 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4454 & aktc*term2)/termexp)
4457 c-----------------------------------------------------------------------------
4458 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4459 implicit real*8 (a-h,o-z)
4460 include 'DIMENSIONS'
4461 include 'COMMON.LOCAL'
4462 include 'COMMON.IOUNITS'
4463 common /calcthet/ term1,term2,termm,diffak,ratak,
4464 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4465 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4466 delthec=thetai-thet_pred_mean
4467 delthe0=thetai-theta0i
4468 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4469 t3 = thetai-thet_pred_mean
4473 t14 = t12+t6*sigsqtc
4475 t21 = thetai-theta0i
4481 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4482 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4483 & *(-t12*t9-ak*sig0inv*t27)
4487 C--------------------------------------------------------------------------
4488 subroutine ebend(etheta)
4490 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4491 C angles gamma and its derivatives in consecutive thetas and gammas.
4492 C ab initio-derived potentials from
4493 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4495 implicit real*8 (a-h,o-z)
4496 include 'DIMENSIONS'
4497 include 'COMMON.LOCAL'
4498 include 'COMMON.GEO'
4499 include 'COMMON.INTERACT'
4500 include 'COMMON.DERIV'
4501 include 'COMMON.VAR'
4502 include 'COMMON.CHAIN'
4503 include 'COMMON.IOUNITS'
4504 include 'COMMON.NAMES'
4505 include 'COMMON.FFIELD'
4506 include 'COMMON.CONTROL'
4507 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4508 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4509 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4510 & sinph1ph2(maxdouble,maxdouble)
4511 logical lprn /.false./, lprn1 /.false./
4513 do i=ithet_start,ithet_end
4514 if (itype(i-1).eq.21) cycle
4518 theti2=0.5d0*theta(i)
4519 ityp2=ithetyp(itype(i-1))
4521 coskt(k)=dcos(k*theti2)
4522 sinkt(k)=dsin(k*theti2)
4524 if (i.gt.3 .and. itype(i-2).ne.21) then
4527 if (phii.ne.phii) phii=150.0
4531 ityp1=ithetyp(itype(i-2))
4533 cosph1(k)=dcos(k*phii)
4534 sinph1(k)=dsin(k*phii)
4544 if (i.lt.nres .and. itype(i).ne.21) then
4547 if (phii1.ne.phii1) phii1=150.0
4552 ityp3=ithetyp(itype(i))
4554 cosph2(k)=dcos(k*phii1)
4555 sinph2(k)=dsin(k*phii1)
4565 ethetai=aa0thet(ityp1,ityp2,ityp3)
4568 ccl=cosph1(l)*cosph2(k-l)
4569 ssl=sinph1(l)*sinph2(k-l)
4570 scl=sinph1(l)*cosph2(k-l)
4571 csl=cosph1(l)*sinph2(k-l)
4572 cosph1ph2(l,k)=ccl-ssl
4573 cosph1ph2(k,l)=ccl+ssl
4574 sinph1ph2(l,k)=scl+csl
4575 sinph1ph2(k,l)=scl-csl
4579 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4580 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4581 write (iout,*) "coskt and sinkt"
4583 write (iout,*) k,coskt(k),sinkt(k)
4587 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4588 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4591 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4592 & " ethetai",ethetai
4595 write (iout,*) "cosph and sinph"
4597 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4599 write (iout,*) "cosph1ph2 and sinph2ph2"
4602 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4603 & sinph1ph2(l,k),sinph1ph2(k,l)
4606 write(iout,*) "ethetai",ethetai
4610 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4611 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4612 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4613 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4614 ethetai=ethetai+sinkt(m)*aux
4615 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4616 dephii=dephii+k*sinkt(m)*(
4617 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4618 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4619 dephii1=dephii1+k*sinkt(m)*(
4620 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4621 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4623 & write (iout,*) "m",m," k",k," bbthet",
4624 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4625 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4626 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4627 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4631 & write(iout,*) "ethetai",ethetai
4635 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4636 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4637 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4638 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4639 ethetai=ethetai+sinkt(m)*aux
4640 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4641 dephii=dephii+l*sinkt(m)*(
4642 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4643 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4644 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4645 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4646 dephii1=dephii1+(k-l)*sinkt(m)*(
4647 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4648 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4649 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4650 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4652 write (iout,*) "m",m," k",k," l",l," ffthet",
4653 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4654 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4655 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4656 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4657 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4658 & cosph1ph2(k,l)*sinkt(m),
4659 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4665 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4666 & i,theta(i)*rad2deg,phii*rad2deg,
4667 & phii1*rad2deg,ethetai
4668 etheta=etheta+ethetai
4669 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4670 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4671 gloc(nphi+i-2,icg)=wang*dethetai
4677 c-----------------------------------------------------------------------------
4678 subroutine esc(escloc)
4679 C Calculate the local energy of a side chain and its derivatives in the
4680 C corresponding virtual-bond valence angles THETA and the spherical angles
4682 implicit real*8 (a-h,o-z)
4683 include 'DIMENSIONS'
4684 include 'COMMON.GEO'
4685 include 'COMMON.LOCAL'
4686 include 'COMMON.VAR'
4687 include 'COMMON.INTERACT'
4688 include 'COMMON.DERIV'
4689 include 'COMMON.CHAIN'
4690 include 'COMMON.IOUNITS'
4691 include 'COMMON.NAMES'
4692 include 'COMMON.FFIELD'
4693 include 'COMMON.CONTROL'
4694 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4695 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4696 common /sccalc/ time11,time12,time112,theti,it,nlobit
4699 c write (iout,'(a)') 'ESC'
4700 do i=loc_start,loc_end
4703 if (it.eq.10) goto 1
4705 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4706 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4707 theti=theta(i+1)-pipol
4712 if (x(2).gt.pi-delta) then
4716 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4718 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4719 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4721 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4722 & ddersc0(1),dersc(1))
4723 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4724 & ddersc0(3),dersc(3))
4726 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4728 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4729 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4730 & dersc0(2),esclocbi,dersc02)
4731 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4733 call splinthet(x(2),0.5d0*delta,ss,ssd)
4738 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4740 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4741 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4743 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4745 c write (iout,*) escloci
4746 else if (x(2).lt.delta) then
4750 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4752 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4753 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4755 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4756 & ddersc0(1),dersc(1))
4757 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4758 & ddersc0(3),dersc(3))
4760 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4762 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4763 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4764 & dersc0(2),esclocbi,dersc02)
4765 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4770 call splinthet(x(2),0.5d0*delta,ss,ssd)
4772 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4774 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4775 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4777 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4778 c write (iout,*) escloci
4780 call enesc(x,escloci,dersc,ddummy,.false.)
4783 escloc=escloc+escloci
4784 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4785 & 'escloc',i,escloci
4786 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4788 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4790 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4791 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4796 C---------------------------------------------------------------------------
4797 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4798 implicit real*8 (a-h,o-z)
4799 include 'DIMENSIONS'
4800 include 'COMMON.GEO'
4801 include 'COMMON.LOCAL'
4802 include 'COMMON.IOUNITS'
4803 common /sccalc/ time11,time12,time112,theti,it,nlobit
4804 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4805 double precision contr(maxlob,-1:1)
4807 c write (iout,*) 'it=',it,' nlobit=',nlobit
4811 if (mixed) ddersc(j)=0.0d0
4815 C Because of periodicity of the dependence of the SC energy in omega we have
4816 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4817 C To avoid underflows, first compute & store the exponents.
4825 z(k)=x(k)-censc(k,j,it)
4830 Axk=Axk+gaussc(l,k,j,it)*z(l)
4836 expfac=expfac+Ax(k,j,iii)*z(k)
4844 C As in the case of ebend, we want to avoid underflows in exponentiation and
4845 C subsequent NaNs and INFs in energy calculation.
4846 C Find the largest exponent
4850 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4854 cd print *,'it=',it,' emin=',emin
4856 C Compute the contribution to SC energy and derivatives
4861 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
4862 if(adexp.ne.adexp) adexp=1.0
4865 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4867 cd print *,'j=',j,' expfac=',expfac
4868 escloc_i=escloc_i+expfac
4870 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4874 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4875 & +gaussc(k,2,j,it))*expfac
4882 dersc(1)=dersc(1)/cos(theti)**2
4883 ddersc(1)=ddersc(1)/cos(theti)**2
4886 escloci=-(dlog(escloc_i)-emin)
4888 dersc(j)=dersc(j)/escloc_i
4892 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4897 C------------------------------------------------------------------------------
4898 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4899 implicit real*8 (a-h,o-z)
4900 include 'DIMENSIONS'
4901 include 'COMMON.GEO'
4902 include 'COMMON.LOCAL'
4903 include 'COMMON.IOUNITS'
4904 common /sccalc/ time11,time12,time112,theti,it,nlobit
4905 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4906 double precision contr(maxlob)
4917 z(k)=x(k)-censc(k,j,it)
4923 Axk=Axk+gaussc(l,k,j,it)*z(l)
4929 expfac=expfac+Ax(k,j)*z(k)
4934 C As in the case of ebend, we want to avoid underflows in exponentiation and
4935 C subsequent NaNs and INFs in energy calculation.
4936 C Find the largest exponent
4939 if (emin.gt.contr(j)) emin=contr(j)
4943 C Compute the contribution to SC energy and derivatives
4947 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4948 escloc_i=escloc_i+expfac
4950 dersc(k)=dersc(k)+Ax(k,j)*expfac
4952 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4953 & +gaussc(1,2,j,it))*expfac
4957 dersc(1)=dersc(1)/cos(theti)**2
4958 dersc12=dersc12/cos(theti)**2
4959 escloci=-(dlog(escloc_i)-emin)
4961 dersc(j)=dersc(j)/escloc_i
4963 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4967 c----------------------------------------------------------------------------------
4968 subroutine esc(escloc)
4969 C Calculate the local energy of a side chain and its derivatives in the
4970 C corresponding virtual-bond valence angles THETA and the spherical angles
4971 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4972 C added by Urszula Kozlowska. 07/11/2007
4974 implicit real*8 (a-h,o-z)
4975 include 'DIMENSIONS'
4976 include 'COMMON.GEO'
4977 include 'COMMON.LOCAL'
4978 include 'COMMON.VAR'
4979 include 'COMMON.SCROT'
4980 include 'COMMON.INTERACT'
4981 include 'COMMON.DERIV'
4982 include 'COMMON.CHAIN'
4983 include 'COMMON.IOUNITS'
4984 include 'COMMON.NAMES'
4985 include 'COMMON.FFIELD'
4986 include 'COMMON.CONTROL'
4987 include 'COMMON.VECTORS'
4988 double precision x_prime(3),y_prime(3),z_prime(3)
4989 & , sumene,dsc_i,dp2_i,x(65),
4990 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4991 & de_dxx,de_dyy,de_dzz,de_dt
4992 double precision s1_t,s1_6_t,s2_t,s2_6_t
4994 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4995 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4996 & dt_dCi(3),dt_dCi1(3)
4997 common /sccalc/ time11,time12,time112,theti,it,nlobit
5000 do i=loc_start,loc_end
5001 if (itype(i).eq.21) cycle
5002 costtab(i+1) =dcos(theta(i+1))
5003 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5004 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5005 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5006 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5007 cosfac=dsqrt(cosfac2)
5008 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5009 sinfac=dsqrt(sinfac2)
5011 if (it.eq.10) goto 1
5013 C Compute the axes of tghe local cartesian coordinates system; store in
5014 c x_prime, y_prime and z_prime
5021 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5022 C & dc_norm(3,i+nres)
5024 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5025 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5028 z_prime(j) = -uz(j,i-1)
5031 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5032 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5033 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5034 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5035 c & " xy",scalar(x_prime(1),y_prime(1)),
5036 c & " xz",scalar(x_prime(1),z_prime(1)),
5037 c & " yy",scalar(y_prime(1),y_prime(1)),
5038 c & " yz",scalar(y_prime(1),z_prime(1)),
5039 c & " zz",scalar(z_prime(1),z_prime(1))
5041 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5042 C to local coordinate system. Store in xx, yy, zz.
5048 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5049 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5050 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5057 C Compute the energy of the ith side cbain
5059 c write (2,*) "xx",xx," yy",yy," zz",zz
5062 x(j) = sc_parmin(j,it)
5065 Cc diagnostics - remove later
5067 yy1 = dsin(alph(2))*dcos(omeg(2))
5068 zz1 = -dsin(alph(2))*dsin(omeg(2))
5069 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5070 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5072 C," --- ", xx_w,yy_w,zz_w
5075 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5076 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5078 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5079 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5081 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5082 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5083 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5084 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5085 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5087 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5088 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5089 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5090 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5091 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5093 dsc_i = 0.743d0+x(61)
5095 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5096 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5097 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5098 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5099 s1=(1+x(63))/(0.1d0 + dscp1)
5100 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5101 s2=(1+x(65))/(0.1d0 + dscp2)
5102 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5103 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5104 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5105 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5107 c & dscp1,dscp2,sumene
5108 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5109 escloc = escloc + sumene
5110 c write (2,*) "i",i," escloc",sumene,escloc
5113 C This section to check the numerical derivatives of the energy of ith side
5114 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5115 C #define DEBUG in the code to turn it on.
5117 write (2,*) "sumene =",sumene
5121 write (2,*) xx,yy,zz
5122 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5123 de_dxx_num=(sumenep-sumene)/aincr
5125 write (2,*) "xx+ sumene from enesc=",sumenep
5128 write (2,*) xx,yy,zz
5129 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5130 de_dyy_num=(sumenep-sumene)/aincr
5132 write (2,*) "yy+ sumene from enesc=",sumenep
5135 write (2,*) xx,yy,zz
5136 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5137 de_dzz_num=(sumenep-sumene)/aincr
5139 write (2,*) "zz+ sumene from enesc=",sumenep
5140 costsave=cost2tab(i+1)
5141 sintsave=sint2tab(i+1)
5142 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5143 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5144 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5145 de_dt_num=(sumenep-sumene)/aincr
5146 write (2,*) " t+ sumene from enesc=",sumenep
5147 cost2tab(i+1)=costsave
5148 sint2tab(i+1)=sintsave
5149 C End of diagnostics section.
5152 C Compute the gradient of esc
5154 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5155 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5156 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5157 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5158 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5159 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5160 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5161 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5162 pom1=(sumene3*sint2tab(i+1)+sumene1)
5163 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5164 pom2=(sumene4*cost2tab(i+1)+sumene2)
5165 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5166 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5167 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5168 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5170 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5171 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5172 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5174 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5175 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5176 & +(pom1+pom2)*pom_dx
5178 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5181 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5182 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5183 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5185 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5186 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5187 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5188 & +x(59)*zz**2 +x(60)*xx*zz
5189 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5190 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5191 & +(pom1-pom2)*pom_dy
5193 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5196 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5197 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5198 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5199 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5200 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5201 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5202 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5203 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5205 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5208 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5209 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5210 & +pom1*pom_dt1+pom2*pom_dt2
5212 write(2,*), "de_dt = ", de_dt,de_dt_num
5216 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5217 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5218 cosfac2xx=cosfac2*xx
5219 sinfac2yy=sinfac2*yy
5221 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5223 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5225 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5226 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5227 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5228 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5229 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5230 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5231 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5232 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5233 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5234 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5238 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5239 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5242 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5243 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5244 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5246 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5247 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5251 dXX_Ctab(k,i)=dXX_Ci(k)
5252 dXX_C1tab(k,i)=dXX_Ci1(k)
5253 dYY_Ctab(k,i)=dYY_Ci(k)
5254 dYY_C1tab(k,i)=dYY_Ci1(k)
5255 dZZ_Ctab(k,i)=dZZ_Ci(k)
5256 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5257 dXX_XYZtab(k,i)=dXX_XYZ(k)
5258 dYY_XYZtab(k,i)=dYY_XYZ(k)
5259 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5263 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5264 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5265 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5266 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5267 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5269 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5270 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5271 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5272 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5273 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5274 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5275 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5276 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5278 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5279 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5281 C to check gradient call subroutine check_grad
5287 c------------------------------------------------------------------------------
5288 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5290 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5291 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5292 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5293 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5295 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5296 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5298 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5299 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5300 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5301 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5302 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5304 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5305 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5306 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5307 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5308 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5310 dsc_i = 0.743d0+x(61)
5312 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5313 & *(xx*cost2+yy*sint2))
5314 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5315 & *(xx*cost2-yy*sint2))
5316 s1=(1+x(63))/(0.1d0 + dscp1)
5317 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5318 s2=(1+x(65))/(0.1d0 + dscp2)
5319 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5320 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5321 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5326 c------------------------------------------------------------------------------
5327 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5329 C This procedure calculates two-body contact function g(rij) and its derivative:
5332 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5335 C where x=(rij-r0ij)/delta
5337 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5340 double precision rij,r0ij,eps0ij,fcont,fprimcont
5341 double precision x,x2,x4,delta
5345 if (x.lt.-1.0D0) then
5348 else if (x.le.1.0D0) then
5351 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5352 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5359 c------------------------------------------------------------------------------
5360 subroutine splinthet(theti,delta,ss,ssder)
5361 implicit real*8 (a-h,o-z)
5362 include 'DIMENSIONS'
5363 include 'COMMON.VAR'
5364 include 'COMMON.GEO'
5367 if (theti.gt.pipol) then
5368 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5370 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5375 c------------------------------------------------------------------------------
5376 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5378 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5379 double precision ksi,ksi2,ksi3,a1,a2,a3
5380 a1=fprim0*delta/(f1-f0)
5386 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5387 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5390 c------------------------------------------------------------------------------
5391 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5393 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5394 double precision ksi,ksi2,ksi3,a1,a2,a3
5399 a2=3*(f1x-f0x)-2*fprim0x*delta
5400 a3=fprim0x*delta-2*(f1x-f0x)
5401 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5404 C-----------------------------------------------------------------------------
5406 C-----------------------------------------------------------------------------
5407 subroutine etor(etors,edihcnstr)
5408 implicit real*8 (a-h,o-z)
5409 include 'DIMENSIONS'
5410 include 'COMMON.VAR'
5411 include 'COMMON.GEO'
5412 include 'COMMON.LOCAL'
5413 include 'COMMON.TORSION'
5414 include 'COMMON.INTERACT'
5415 include 'COMMON.DERIV'
5416 include 'COMMON.CHAIN'
5417 include 'COMMON.NAMES'
5418 include 'COMMON.IOUNITS'
5419 include 'COMMON.FFIELD'
5420 include 'COMMON.TORCNSTR'
5421 include 'COMMON.CONTROL'
5423 C Set lprn=.true. for debugging
5427 do i=iphi_start,iphi_end
5429 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
5430 & .or. itype(i).eq.21) cycle
5431 itori=itortyp(itype(i-2))
5432 itori1=itortyp(itype(i-1))
5435 C Proline-Proline pair is a special case...
5436 if (itori.eq.3 .and. itori1.eq.3) then
5437 if (phii.gt.-dwapi3) then
5439 fac=1.0D0/(1.0D0-cosphi)
5440 etorsi=v1(1,3,3)*fac
5441 etorsi=etorsi+etorsi
5442 etors=etors+etorsi-v1(1,3,3)
5443 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5444 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5447 v1ij=v1(j+1,itori,itori1)
5448 v2ij=v2(j+1,itori,itori1)
5451 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5452 if (energy_dec) etors_ii=etors_ii+
5453 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5454 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5458 v1ij=v1(j,itori,itori1)
5459 v2ij=v2(j,itori,itori1)
5462 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5463 if (energy_dec) etors_ii=etors_ii+
5464 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5465 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5468 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5471 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5472 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5473 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5474 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5475 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5477 ! 6/20/98 - dihedral angle constraints
5480 itori=idih_constr(i)
5483 if (difi.gt.drange(i)) then
5485 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5486 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5487 else if (difi.lt.-drange(i)) then
5489 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5490 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5492 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5493 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5495 ! write (iout,*) 'edihcnstr',edihcnstr
5498 c------------------------------------------------------------------------------
5499 subroutine etor_d(etors_d)
5503 c----------------------------------------------------------------------------
5505 subroutine etor(etors,edihcnstr)
5506 implicit real*8 (a-h,o-z)
5507 include 'DIMENSIONS'
5508 include 'COMMON.VAR'
5509 include 'COMMON.GEO'
5510 include 'COMMON.LOCAL'
5511 include 'COMMON.TORSION'
5512 include 'COMMON.INTERACT'
5513 include 'COMMON.DERIV'
5514 include 'COMMON.CHAIN'
5515 include 'COMMON.NAMES'
5516 include 'COMMON.IOUNITS'
5517 include 'COMMON.FFIELD'
5518 include 'COMMON.TORCNSTR'
5519 include 'COMMON.CONTROL'
5521 C Set lprn=.true. for debugging
5525 do i=iphi_start,iphi_end
5526 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
5527 & .or. itype(i).eq.21) cycle
5529 itori=itortyp(itype(i-2))
5530 itori1=itortyp(itype(i-1))
5533 C Regular cosine and sine terms
5534 do j=1,nterm(itori,itori1)
5535 v1ij=v1(j,itori,itori1)
5536 v2ij=v2(j,itori,itori1)
5539 etors=etors+v1ij*cosphi+v2ij*sinphi
5540 if (energy_dec) etors_ii=etors_ii+
5541 & v1ij*cosphi+v2ij*sinphi
5542 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5546 C E = SUM ----------------------------------- - v1
5547 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5549 cosphi=dcos(0.5d0*phii)
5550 sinphi=dsin(0.5d0*phii)
5551 do j=1,nlor(itori,itori1)
5552 vl1ij=vlor1(j,itori,itori1)
5553 vl2ij=vlor2(j,itori,itori1)
5554 vl3ij=vlor3(j,itori,itori1)
5555 pom=vl2ij*cosphi+vl3ij*sinphi
5556 pom1=1.0d0/(pom*pom+1.0d0)
5557 etors=etors+vl1ij*pom1
5558 if (energy_dec) etors_ii=etors_ii+
5561 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5563 C Subtract the constant term
5564 etors=etors-v0(itori,itori1)
5565 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5566 & 'etor',i,etors_ii-v0(itori,itori1)
5568 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5569 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5570 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5571 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5572 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5574 ! 6/20/98 - dihedral angle constraints
5576 c do i=1,ndih_constr
5577 do i=idihconstr_start,idihconstr_end
5578 itori=idih_constr(i)
5580 difi=pinorm(phii-phi0(i))
5581 if (difi.gt.drange(i)) then
5583 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5584 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5585 else if (difi.lt.-drange(i)) then
5587 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5588 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5592 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5593 cd & rad2deg*phi0(i), rad2deg*drange(i),
5594 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5596 cd write (iout,*) 'edihcnstr',edihcnstr
5599 c----------------------------------------------------------------------------
5600 subroutine etor_d(etors_d)
5601 C 6/23/01 Compute double torsional energy
5602 implicit real*8 (a-h,o-z)
5603 include 'DIMENSIONS'
5604 include 'COMMON.VAR'
5605 include 'COMMON.GEO'
5606 include 'COMMON.LOCAL'
5607 include 'COMMON.TORSION'
5608 include 'COMMON.INTERACT'
5609 include 'COMMON.DERIV'
5610 include 'COMMON.CHAIN'
5611 include 'COMMON.NAMES'
5612 include 'COMMON.IOUNITS'
5613 include 'COMMON.FFIELD'
5614 include 'COMMON.TORCNSTR'
5616 C Set lprn=.true. for debugging
5620 do i=iphid_start,iphid_end
5621 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
5622 & .or. itype(i).eq.21 .or. itype(i+1).eq.21) cycle
5623 itori=itortyp(itype(i-2))
5624 itori1=itortyp(itype(i-1))
5625 itori2=itortyp(itype(i))
5630 C Regular cosine and sine terms
5631 do j=1,ntermd_1(itori,itori1,itori2)
5632 v1cij=v1c(1,j,itori,itori1,itori2)
5633 v1sij=v1s(1,j,itori,itori1,itori2)
5634 v2cij=v1c(2,j,itori,itori1,itori2)
5635 v2sij=v1s(2,j,itori,itori1,itori2)
5636 cosphi1=dcos(j*phii)
5637 sinphi1=dsin(j*phii)
5638 cosphi2=dcos(j*phii1)
5639 sinphi2=dsin(j*phii1)
5640 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5641 & v2cij*cosphi2+v2sij*sinphi2
5642 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5643 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5645 do k=2,ntermd_2(itori,itori1,itori2)
5647 v1cdij = v2c(k,l,itori,itori1,itori2)
5648 v2cdij = v2c(l,k,itori,itori1,itori2)
5649 v1sdij = v2s(k,l,itori,itori1,itori2)
5650 v2sdij = v2s(l,k,itori,itori1,itori2)
5651 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5652 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5653 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5654 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5655 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5656 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5657 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5658 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5659 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5660 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5663 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5664 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5669 c------------------------------------------------------------------------------
5670 subroutine eback_sc_corr(esccor)
5671 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5672 c conformational states; temporarily implemented as differences
5673 c between UNRES torsional potentials (dependent on three types of
5674 c residues) and the torsional potentials dependent on all 20 types
5675 c of residues computed from AM1 energy surfaces of terminally-blocked
5676 c amino-acid residues.
5677 implicit real*8 (a-h,o-z)
5678 include 'DIMENSIONS'
5679 include 'COMMON.VAR'
5680 include 'COMMON.GEO'
5681 include 'COMMON.LOCAL'
5682 include 'COMMON.TORSION'
5683 include 'COMMON.SCCOR'
5684 include 'COMMON.INTERACT'
5685 include 'COMMON.DERIV'
5686 include 'COMMON.CHAIN'
5687 include 'COMMON.NAMES'
5688 include 'COMMON.IOUNITS'
5689 include 'COMMON.FFIELD'
5690 include 'COMMON.CONTROL'
5692 C Set lprn=.true. for debugging
5695 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5697 do i=iphi_start,iphi_end
5698 if (itype(i-2).eq.21 .or. itype(i-1).eq.21) cycle
5705 v1ij=v1sccor(j,itori,itori1)
5706 v2ij=v2sccor(j,itori,itori1)
5709 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5710 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5713 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5714 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5715 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5716 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5720 c----------------------------------------------------------------------------
5721 subroutine multibody(ecorr)
5722 C This subroutine calculates multi-body contributions to energy following
5723 C the idea of Skolnick et al. If side chains I and J make a contact and
5724 C at the same time side chains I+1 and J+1 make a contact, an extra
5725 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5726 implicit real*8 (a-h,o-z)
5727 include 'DIMENSIONS'
5728 include 'COMMON.IOUNITS'
5729 include 'COMMON.DERIV'
5730 include 'COMMON.INTERACT'
5731 include 'COMMON.CONTACTS'
5732 double precision gx(3),gx1(3)
5735 C Set lprn=.true. for debugging
5739 write (iout,'(a)') 'Contact function values:'
5741 write (iout,'(i2,20(1x,i2,f10.5))')
5742 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5757 num_conti=num_cont(i)
5758 num_conti1=num_cont(i1)
5763 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5764 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5765 cd & ' ishift=',ishift
5766 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5767 C The system gains extra energy.
5768 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5769 endif ! j1==j+-ishift
5778 c------------------------------------------------------------------------------
5779 double precision function esccorr(i,j,k,l,jj,kk)
5780 implicit real*8 (a-h,o-z)
5781 include 'DIMENSIONS'
5782 include 'COMMON.IOUNITS'
5783 include 'COMMON.DERIV'
5784 include 'COMMON.INTERACT'
5785 include 'COMMON.CONTACTS'
5786 double precision gx(3),gx1(3)
5791 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5792 C Calculate the multi-body contribution to energy.
5793 C Calculate multi-body contributions to the gradient.
5794 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5795 cd & k,l,(gacont(m,kk,k),m=1,3)
5797 gx(m) =ekl*gacont(m,jj,i)
5798 gx1(m)=eij*gacont(m,kk,k)
5799 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5800 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5801 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5802 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5806 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5811 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5817 c------------------------------------------------------------------------------
5818 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5819 C This subroutine calculates multi-body contributions to hydrogen-bonding
5820 implicit real*8 (a-h,o-z)
5821 include 'DIMENSIONS'
5822 include 'COMMON.IOUNITS'
5825 parameter (max_cont=maxconts)
5826 parameter (max_dim=26)
5827 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5828 double precision zapas(max_dim,maxconts,max_fg_procs),
5829 & zapas_recv(max_dim,maxconts,max_fg_procs)
5830 common /przechowalnia/ zapas
5831 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5832 & status_array(MPI_STATUS_SIZE,maxconts*2)
5834 include 'COMMON.SETUP'
5835 include 'COMMON.FFIELD'
5836 include 'COMMON.DERIV'
5837 include 'COMMON.INTERACT'
5838 include 'COMMON.CONTACTS'
5839 include 'COMMON.CONTROL'
5840 include 'COMMON.LOCAL'
5841 double precision gx(3),gx1(3),time00
5844 C Set lprn=.true. for debugging
5849 if (nfgtasks.le.1) goto 30
5851 write (iout,'(a)') 'Contact function values before RECEIVE:'
5853 write (iout,'(2i3,50(1x,i2,f5.2))')
5854 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5855 & j=1,num_cont_hb(i))
5859 do i=1,ntask_cont_from
5862 do i=1,ntask_cont_to
5865 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5867 C Make the list of contacts to send to send to other procesors
5868 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5870 do i=iturn3_start,iturn3_end
5871 c write (iout,*) "make contact list turn3",i," num_cont",
5873 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5875 do i=iturn4_start,iturn4_end
5876 c write (iout,*) "make contact list turn4",i," num_cont",
5878 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5882 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5884 do j=1,num_cont_hb(i)
5887 iproc=iint_sent_local(k,jjc,ii)
5888 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5889 if (iproc.gt.0) then
5890 ncont_sent(iproc)=ncont_sent(iproc)+1
5891 nn=ncont_sent(iproc)
5893 zapas(2,nn,iproc)=jjc
5894 zapas(3,nn,iproc)=facont_hb(j,i)
5895 zapas(4,nn,iproc)=ees0p(j,i)
5896 zapas(5,nn,iproc)=ees0m(j,i)
5897 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5898 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5899 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5900 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5901 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5902 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5903 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5904 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5905 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5906 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5907 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
5908 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
5909 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
5910 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
5911 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
5912 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
5913 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
5914 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
5915 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
5916 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
5917 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
5924 & "Numbers of contacts to be sent to other processors",
5925 & (ncont_sent(i),i=1,ntask_cont_to)
5926 write (iout,*) "Contacts sent"
5927 do ii=1,ntask_cont_to
5929 iproc=itask_cont_to(ii)
5930 write (iout,*) nn," contacts to processor",iproc,
5931 & " of CONT_TO_COMM group"
5933 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
5941 CorrelID1=nfgtasks+fg_rank+1
5943 C Receive the numbers of needed contacts from other processors
5944 do ii=1,ntask_cont_from
5945 iproc=itask_cont_from(ii)
5947 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
5948 & FG_COMM,req(ireq),IERR)
5950 c write (iout,*) "IRECV ended"
5952 C Send the number of contacts needed by other processors
5953 do ii=1,ntask_cont_to
5954 iproc=itask_cont_to(ii)
5956 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
5957 & FG_COMM,req(ireq),IERR)
5959 c write (iout,*) "ISEND ended"
5960 c write (iout,*) "number of requests (nn)",ireq
5963 & call MPI_Waitall(ireq,req,status_array,ierr)
5965 c & "Numbers of contacts to be received from other processors",
5966 c & (ncont_recv(i),i=1,ntask_cont_from)
5970 do ii=1,ntask_cont_from
5971 iproc=itask_cont_from(ii)
5973 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
5974 c & " of CONT_TO_COMM group"
5978 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
5979 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
5980 c write (iout,*) "ireq,req",ireq,req(ireq)
5983 C Send the contacts to processors that need them
5984 do ii=1,ntask_cont_to
5985 iproc=itask_cont_to(ii)
5987 c write (iout,*) nn," contacts to processor",iproc,
5988 c & " of CONT_TO_COMM group"
5991 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
5992 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
5993 c write (iout,*) "ireq,req",ireq,req(ireq)
5995 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
5999 c write (iout,*) "number of requests (contacts)",ireq
6000 c write (iout,*) "req",(req(i),i=1,4)
6003 & call MPI_Waitall(ireq,req,status_array,ierr)
6004 do iii=1,ntask_cont_from
6005 iproc=itask_cont_from(iii)
6008 write (iout,*) "Received",nn," contacts from processor",iproc,
6009 & " of CONT_FROM_COMM group"
6012 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6017 ii=zapas_recv(1,i,iii)
6018 c Flag the received contacts to prevent double-counting
6019 jj=-zapas_recv(2,i,iii)
6020 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6022 nnn=num_cont_hb(ii)+1
6025 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6026 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6027 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6028 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6029 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6030 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6031 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6032 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6033 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6034 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6035 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6036 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6037 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6038 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6039 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6040 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6041 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6042 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6043 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6044 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6045 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6046 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6047 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6048 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6053 write (iout,'(a)') 'Contact function values after receive:'
6055 write (iout,'(2i3,50(1x,i3,f5.2))')
6056 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6057 & j=1,num_cont_hb(i))
6064 write (iout,'(a)') 'Contact function values:'
6066 write (iout,'(2i3,50(1x,i3,f5.2))')
6067 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6068 & j=1,num_cont_hb(i))
6072 C Remove the loop below after debugging !!!
6079 C Calculate the local-electrostatic correlation terms
6080 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6082 num_conti=num_cont_hb(i)
6083 num_conti1=num_cont_hb(i+1)
6090 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6091 c & ' jj=',jj,' kk=',kk
6092 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6093 & .or. j.lt.0 .and. j1.gt.0) .and.
6094 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6095 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6096 C The system gains extra energy.
6097 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6098 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6099 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6101 else if (j1.eq.j) then
6102 C Contacts I-J and I-(J+1) occur simultaneously.
6103 C The system loses extra energy.
6104 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6109 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6110 c & ' jj=',jj,' kk=',kk
6112 C Contacts I-J and (I+1)-J occur simultaneously.
6113 C The system loses extra energy.
6114 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6121 c------------------------------------------------------------------------------
6122 subroutine add_hb_contact(ii,jj,itask)
6123 implicit real*8 (a-h,o-z)
6124 include "DIMENSIONS"
6125 include "COMMON.IOUNITS"
6128 parameter (max_cont=maxconts)
6129 parameter (max_dim=26)
6130 include "COMMON.CONTACTS"
6131 double precision zapas(max_dim,maxconts,max_fg_procs),
6132 & zapas_recv(max_dim,maxconts,max_fg_procs)
6133 common /przechowalnia/ zapas
6134 integer i,j,ii,jj,iproc,itask(4),nn
6135 c write (iout,*) "itask",itask
6138 if (iproc.gt.0) then
6139 do j=1,num_cont_hb(ii)
6141 c write (iout,*) "i",ii," j",jj," jjc",jjc
6143 ncont_sent(iproc)=ncont_sent(iproc)+1
6144 nn=ncont_sent(iproc)
6145 zapas(1,nn,iproc)=ii
6146 zapas(2,nn,iproc)=jjc
6147 zapas(3,nn,iproc)=facont_hb(j,ii)
6148 zapas(4,nn,iproc)=ees0p(j,ii)
6149 zapas(5,nn,iproc)=ees0m(j,ii)
6150 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6151 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6152 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6153 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6154 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6155 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6156 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6157 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6158 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6159 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6160 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6161 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6162 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6163 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6164 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6165 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6166 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6167 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6168 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6169 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6170 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6178 c------------------------------------------------------------------------------
6179 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6181 C This subroutine calculates multi-body contributions to hydrogen-bonding
6182 implicit real*8 (a-h,o-z)
6183 include 'DIMENSIONS'
6184 include 'COMMON.IOUNITS'
6187 parameter (max_cont=maxconts)
6188 parameter (max_dim=70)
6189 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6190 double precision zapas(max_dim,maxconts,max_fg_procs),
6191 & zapas_recv(max_dim,maxconts,max_fg_procs)
6192 common /przechowalnia/ zapas
6193 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6194 & status_array(MPI_STATUS_SIZE,maxconts*2)
6196 include 'COMMON.SETUP'
6197 include 'COMMON.FFIELD'
6198 include 'COMMON.DERIV'
6199 include 'COMMON.LOCAL'
6200 include 'COMMON.INTERACT'
6201 include 'COMMON.CONTACTS'
6202 include 'COMMON.CHAIN'
6203 include 'COMMON.CONTROL'
6204 double precision gx(3),gx1(3)
6205 integer num_cont_hb_old(maxres)
6207 double precision eello4,eello5,eelo6,eello_turn6
6208 external eello4,eello5,eello6,eello_turn6
6209 C Set lprn=.true. for debugging
6214 num_cont_hb_old(i)=num_cont_hb(i)
6218 if (nfgtasks.le.1) goto 30
6220 write (iout,'(a)') 'Contact function values before RECEIVE:'
6222 write (iout,'(2i3,50(1x,i2,f5.2))')
6223 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6224 & j=1,num_cont_hb(i))
6228 do i=1,ntask_cont_from
6231 do i=1,ntask_cont_to
6234 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6236 C Make the list of contacts to send to send to other procesors
6237 do i=iturn3_start,iturn3_end
6238 c write (iout,*) "make contact list turn3",i," num_cont",
6240 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6242 do i=iturn4_start,iturn4_end
6243 c write (iout,*) "make contact list turn4",i," num_cont",
6245 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6249 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6251 do j=1,num_cont_hb(i)
6254 iproc=iint_sent_local(k,jjc,ii)
6255 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6256 if (iproc.ne.0) then
6257 ncont_sent(iproc)=ncont_sent(iproc)+1
6258 nn=ncont_sent(iproc)
6260 zapas(2,nn,iproc)=jjc
6261 zapas(3,nn,iproc)=d_cont(j,i)
6265 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6270 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6278 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6289 & "Numbers of contacts to be sent to other processors",
6290 & (ncont_sent(i),i=1,ntask_cont_to)
6291 write (iout,*) "Contacts sent"
6292 do ii=1,ntask_cont_to
6294 iproc=itask_cont_to(ii)
6295 write (iout,*) nn," contacts to processor",iproc,
6296 & " of CONT_TO_COMM group"
6298 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6306 CorrelID1=nfgtasks+fg_rank+1
6308 C Receive the numbers of needed contacts from other processors
6309 do ii=1,ntask_cont_from
6310 iproc=itask_cont_from(ii)
6312 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6313 & FG_COMM,req(ireq),IERR)
6315 c write (iout,*) "IRECV ended"
6317 C Send the number of contacts needed by other processors
6318 do ii=1,ntask_cont_to
6319 iproc=itask_cont_to(ii)
6321 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6322 & FG_COMM,req(ireq),IERR)
6324 c write (iout,*) "ISEND ended"
6325 c write (iout,*) "number of requests (nn)",ireq
6328 & call MPI_Waitall(ireq,req,status_array,ierr)
6330 c & "Numbers of contacts to be received from other processors",
6331 c & (ncont_recv(i),i=1,ntask_cont_from)
6335 do ii=1,ntask_cont_from
6336 iproc=itask_cont_from(ii)
6338 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6339 c & " of CONT_TO_COMM group"
6343 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6344 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6345 c write (iout,*) "ireq,req",ireq,req(ireq)
6348 C Send the contacts to processors that need them
6349 do ii=1,ntask_cont_to
6350 iproc=itask_cont_to(ii)
6352 c write (iout,*) nn," contacts to processor",iproc,
6353 c & " of CONT_TO_COMM group"
6356 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6357 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6358 c write (iout,*) "ireq,req",ireq,req(ireq)
6360 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6364 c write (iout,*) "number of requests (contacts)",ireq
6365 c write (iout,*) "req",(req(i),i=1,4)
6368 & call MPI_Waitall(ireq,req,status_array,ierr)
6369 do iii=1,ntask_cont_from
6370 iproc=itask_cont_from(iii)
6373 write (iout,*) "Received",nn," contacts from processor",iproc,
6374 & " of CONT_FROM_COMM group"
6377 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6382 ii=zapas_recv(1,i,iii)
6383 c Flag the received contacts to prevent double-counting
6384 jj=-zapas_recv(2,i,iii)
6385 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6387 nnn=num_cont_hb(ii)+1
6390 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6394 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6399 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6407 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6416 write (iout,'(a)') 'Contact function values after receive:'
6418 write (iout,'(2i3,50(1x,i3,5f6.3))')
6419 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6420 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6427 write (iout,'(a)') 'Contact function values:'
6429 write (iout,'(2i3,50(1x,i2,5f6.3))')
6430 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6431 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6437 C Remove the loop below after debugging !!!
6444 C Calculate the dipole-dipole interaction energies
6445 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6446 do i=iatel_s,iatel_e+1
6447 num_conti=num_cont_hb(i)
6456 C Calculate the local-electrostatic correlation terms
6457 c write (iout,*) "gradcorr5 in eello5 before loop"
6459 c write (iout,'(i5,3f10.5)')
6460 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6462 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6463 c write (iout,*) "corr loop i",i
6465 num_conti=num_cont_hb(i)
6466 num_conti1=num_cont_hb(i+1)
6473 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6474 c & ' jj=',jj,' kk=',kk
6475 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6476 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6477 & .or. j.lt.0 .and. j1.gt.0) .and.
6478 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6479 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6480 C The system gains extra energy.
6482 sqd1=dsqrt(d_cont(jj,i))
6483 sqd2=dsqrt(d_cont(kk,i1))
6484 sred_geom = sqd1*sqd2
6485 IF (sred_geom.lt.cutoff_corr) THEN
6486 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6488 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6489 cd & ' jj=',jj,' kk=',kk
6490 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6491 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6493 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6494 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6497 cd write (iout,*) 'sred_geom=',sred_geom,
6498 cd & ' ekont=',ekont,' fprim=',fprimcont,
6499 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6500 cd write (iout,*) "g_contij",g_contij
6501 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6502 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6503 call calc_eello(i,jp,i+1,jp1,jj,kk)
6504 if (wcorr4.gt.0.0d0)
6505 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6506 if (energy_dec.and.wcorr4.gt.0.0d0)
6507 1 write (iout,'(a6,4i5,0pf7.3)')
6508 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6509 c write (iout,*) "gradcorr5 before eello5"
6511 c write (iout,'(i5,3f10.5)')
6512 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6514 if (wcorr5.gt.0.0d0)
6515 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6516 c write (iout,*) "gradcorr5 after eello5"
6518 c write (iout,'(i5,3f10.5)')
6519 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6521 if (energy_dec.and.wcorr5.gt.0.0d0)
6522 1 write (iout,'(a6,4i5,0pf7.3)')
6523 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6524 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6525 cd write(2,*)'ijkl',i,jp,i+1,jp1
6526 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6527 & .or. wturn6.eq.0.0d0))then
6528 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6529 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6530 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6531 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6532 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6533 cd & 'ecorr6=',ecorr6
6534 cd write (iout,'(4e15.5)') sred_geom,
6535 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6536 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6537 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6538 else if (wturn6.gt.0.0d0
6539 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6540 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6541 eturn6=eturn6+eello_turn6(i,jj,kk)
6542 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6543 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6544 cd write (2,*) 'multibody_eello:eturn6',eturn6
6553 num_cont_hb(i)=num_cont_hb_old(i)
6555 c write (iout,*) "gradcorr5 in eello5"
6557 c write (iout,'(i5,3f10.5)')
6558 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6562 c------------------------------------------------------------------------------
6563 subroutine add_hb_contact_eello(ii,jj,itask)
6564 implicit real*8 (a-h,o-z)
6565 include "DIMENSIONS"
6566 include "COMMON.IOUNITS"
6569 parameter (max_cont=maxconts)
6570 parameter (max_dim=70)
6571 include "COMMON.CONTACTS"
6572 double precision zapas(max_dim,maxconts,max_fg_procs),
6573 & zapas_recv(max_dim,maxconts,max_fg_procs)
6574 common /przechowalnia/ zapas
6575 integer i,j,ii,jj,iproc,itask(4),nn
6576 c write (iout,*) "itask",itask
6579 if (iproc.gt.0) then
6580 do j=1,num_cont_hb(ii)
6582 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6584 ncont_sent(iproc)=ncont_sent(iproc)+1
6585 nn=ncont_sent(iproc)
6586 zapas(1,nn,iproc)=ii
6587 zapas(2,nn,iproc)=jjc
6588 zapas(3,nn,iproc)=d_cont(j,ii)
6592 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6597 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6605 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6617 c------------------------------------------------------------------------------
6618 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6619 implicit real*8 (a-h,o-z)
6620 include 'DIMENSIONS'
6621 include 'COMMON.IOUNITS'
6622 include 'COMMON.DERIV'
6623 include 'COMMON.INTERACT'
6624 include 'COMMON.CONTACTS'
6625 double precision gx(3),gx1(3)
6635 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6636 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6637 C Following 4 lines for diagnostics.
6642 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6643 c & 'Contacts ',i,j,
6644 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6645 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6647 C Calculate the multi-body contribution to energy.
6648 c ecorr=ecorr+ekont*ees
6649 C Calculate multi-body contributions to the gradient.
6650 coeffpees0pij=coeffp*ees0pij
6651 coeffmees0mij=coeffm*ees0mij
6652 coeffpees0pkl=coeffp*ees0pkl
6653 coeffmees0mkl=coeffm*ees0mkl
6655 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6656 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6657 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6658 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6659 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6660 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6661 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6662 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6663 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6664 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6665 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6666 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6667 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6668 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6669 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6670 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6671 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6672 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6673 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6674 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6675 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6676 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6677 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6678 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6679 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6684 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6685 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6686 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6687 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6692 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6693 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6694 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6695 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6698 c write (iout,*) "ehbcorr",ekont*ees
6703 C---------------------------------------------------------------------------
6704 subroutine dipole(i,j,jj)
6705 implicit real*8 (a-h,o-z)
6706 include 'DIMENSIONS'
6707 include 'COMMON.IOUNITS'
6708 include 'COMMON.CHAIN'
6709 include 'COMMON.FFIELD'
6710 include 'COMMON.DERIV'
6711 include 'COMMON.INTERACT'
6712 include 'COMMON.CONTACTS'
6713 include 'COMMON.TORSION'
6714 include 'COMMON.VAR'
6715 include 'COMMON.GEO'
6716 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6718 iti1 = itortyp(itype(i+1))
6719 if (j.lt.nres-1) then
6720 itj1 = itortyp(itype(j+1))
6725 dipi(iii,1)=Ub2(iii,i)
6726 dipderi(iii)=Ub2der(iii,i)
6727 dipi(iii,2)=b1(iii,iti1)
6728 dipj(iii,1)=Ub2(iii,j)
6729 dipderj(iii)=Ub2der(iii,j)
6730 dipj(iii,2)=b1(iii,itj1)
6734 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6737 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6744 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6748 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6753 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6754 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6756 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6758 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6760 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6765 C---------------------------------------------------------------------------
6766 subroutine calc_eello(i,j,k,l,jj,kk)
6768 C This subroutine computes matrices and vectors needed to calculate
6769 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6771 implicit real*8 (a-h,o-z)
6772 include 'DIMENSIONS'
6773 include 'COMMON.IOUNITS'
6774 include 'COMMON.CHAIN'
6775 include 'COMMON.DERIV'
6776 include 'COMMON.INTERACT'
6777 include 'COMMON.CONTACTS'
6778 include 'COMMON.TORSION'
6779 include 'COMMON.VAR'
6780 include 'COMMON.GEO'
6781 include 'COMMON.FFIELD'
6782 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6783 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6786 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6787 cd & ' jj=',jj,' kk=',kk
6788 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6789 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6790 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6793 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6794 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6797 call transpose2(aa1(1,1),aa1t(1,1))
6798 call transpose2(aa2(1,1),aa2t(1,1))
6801 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6802 & aa1tder(1,1,lll,kkk))
6803 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6804 & aa2tder(1,1,lll,kkk))
6808 C parallel orientation of the two CA-CA-CA frames.
6810 iti=itortyp(itype(i))
6814 itk1=itortyp(itype(k+1))
6815 itj=itortyp(itype(j))
6816 if (l.lt.nres-1) then
6817 itl1=itortyp(itype(l+1))
6821 C A1 kernel(j+1) A2T
6823 cd write (iout,'(3f10.5,5x,3f10.5)')
6824 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6826 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6827 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6828 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6829 C Following matrices are needed only for 6-th order cumulants
6830 IF (wcorr6.gt.0.0d0) THEN
6831 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6832 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6833 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6834 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6835 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6836 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6837 & ADtEAderx(1,1,1,1,1,1))
6839 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6840 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6841 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6842 & ADtEA1derx(1,1,1,1,1,1))
6844 C End 6-th order cumulants
6847 cd write (2,*) 'In calc_eello6'
6849 cd write (2,*) 'iii=',iii
6851 cd write (2,*) 'kkk=',kkk
6853 cd write (2,'(3(2f10.5),5x)')
6854 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6859 call transpose2(EUgder(1,1,k),auxmat(1,1))
6860 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6861 call transpose2(EUg(1,1,k),auxmat(1,1))
6862 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6863 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6867 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6868 & EAEAderx(1,1,lll,kkk,iii,1))
6872 C A1T kernel(i+1) A2
6873 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6874 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6875 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6876 C Following matrices are needed only for 6-th order cumulants
6877 IF (wcorr6.gt.0.0d0) THEN
6878 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6879 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6880 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6881 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6882 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6883 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6884 & ADtEAderx(1,1,1,1,1,2))
6885 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6886 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6887 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6888 & ADtEA1derx(1,1,1,1,1,2))
6890 C End 6-th order cumulants
6891 call transpose2(EUgder(1,1,l),auxmat(1,1))
6892 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6893 call transpose2(EUg(1,1,l),auxmat(1,1))
6894 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6895 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6899 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6900 & EAEAderx(1,1,lll,kkk,iii,2))
6905 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6906 C They are needed only when the fifth- or the sixth-order cumulants are
6908 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6909 call transpose2(AEA(1,1,1),auxmat(1,1))
6910 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6911 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6912 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6913 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6914 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6915 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6916 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6917 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6918 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6919 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6920 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6921 call transpose2(AEA(1,1,2),auxmat(1,1))
6922 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6923 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6924 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6925 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6926 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6927 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6928 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6929 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6930 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6931 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6932 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6933 C Calculate the Cartesian derivatives of the vectors.
6937 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6938 call matvec2(auxmat(1,1),b1(1,iti),
6939 & AEAb1derx(1,lll,kkk,iii,1,1))
6940 call matvec2(auxmat(1,1),Ub2(1,i),
6941 & AEAb2derx(1,lll,kkk,iii,1,1))
6942 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6943 & AEAb1derx(1,lll,kkk,iii,2,1))
6944 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6945 & AEAb2derx(1,lll,kkk,iii,2,1))
6946 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6947 call matvec2(auxmat(1,1),b1(1,itj),
6948 & AEAb1derx(1,lll,kkk,iii,1,2))
6949 call matvec2(auxmat(1,1),Ub2(1,j),
6950 & AEAb2derx(1,lll,kkk,iii,1,2))
6951 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6952 & AEAb1derx(1,lll,kkk,iii,2,2))
6953 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6954 & AEAb2derx(1,lll,kkk,iii,2,2))
6961 C Antiparallel orientation of the two CA-CA-CA frames.
6963 iti=itortyp(itype(i))
6967 itk1=itortyp(itype(k+1))
6968 itl=itortyp(itype(l))
6969 itj=itortyp(itype(j))
6970 if (j.lt.nres-1) then
6971 itj1=itortyp(itype(j+1))
6975 C A2 kernel(j-1)T A1T
6976 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6977 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6978 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6979 C Following matrices are needed only for 6-th order cumulants
6980 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6981 & j.eq.i+4 .and. l.eq.i+3)) THEN
6982 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6983 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6984 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6985 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6986 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6987 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6988 & ADtEAderx(1,1,1,1,1,1))
6989 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6990 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6991 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6992 & ADtEA1derx(1,1,1,1,1,1))
6994 C End 6-th order cumulants
6995 call transpose2(EUgder(1,1,k),auxmat(1,1))
6996 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6997 call transpose2(EUg(1,1,k),auxmat(1,1))
6998 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6999 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7003 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7004 & EAEAderx(1,1,lll,kkk,iii,1))
7008 C A2T kernel(i+1)T A1
7009 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7010 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7011 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7012 C Following matrices are needed only for 6-th order cumulants
7013 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7014 & j.eq.i+4 .and. l.eq.i+3)) THEN
7015 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7016 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7017 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7018 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7019 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7020 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7021 & ADtEAderx(1,1,1,1,1,2))
7022 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7023 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7024 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7025 & ADtEA1derx(1,1,1,1,1,2))
7027 C End 6-th order cumulants
7028 call transpose2(EUgder(1,1,j),auxmat(1,1))
7029 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7030 call transpose2(EUg(1,1,j),auxmat(1,1))
7031 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7032 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7036 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7037 & EAEAderx(1,1,lll,kkk,iii,2))
7042 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7043 C They are needed only when the fifth- or the sixth-order cumulants are
7045 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7046 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7047 call transpose2(AEA(1,1,1),auxmat(1,1))
7048 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7049 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7050 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7051 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7052 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7053 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7054 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7055 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7056 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7057 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7058 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7059 call transpose2(AEA(1,1,2),auxmat(1,1))
7060 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7061 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7062 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7063 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7064 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7065 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7066 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7067 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7068 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7069 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7070 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7071 C Calculate the Cartesian derivatives of the vectors.
7075 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7076 call matvec2(auxmat(1,1),b1(1,iti),
7077 & AEAb1derx(1,lll,kkk,iii,1,1))
7078 call matvec2(auxmat(1,1),Ub2(1,i),
7079 & AEAb2derx(1,lll,kkk,iii,1,1))
7080 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7081 & AEAb1derx(1,lll,kkk,iii,2,1))
7082 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7083 & AEAb2derx(1,lll,kkk,iii,2,1))
7084 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7085 call matvec2(auxmat(1,1),b1(1,itl),
7086 & AEAb1derx(1,lll,kkk,iii,1,2))
7087 call matvec2(auxmat(1,1),Ub2(1,l),
7088 & AEAb2derx(1,lll,kkk,iii,1,2))
7089 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7090 & AEAb1derx(1,lll,kkk,iii,2,2))
7091 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7092 & AEAb2derx(1,lll,kkk,iii,2,2))
7101 C---------------------------------------------------------------------------
7102 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7103 & KK,KKderg,AKA,AKAderg,AKAderx)
7107 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7108 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7109 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7114 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7116 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7119 cd if (lprn) write (2,*) 'In kernel'
7121 cd if (lprn) write (2,*) 'kkk=',kkk
7123 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7124 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7126 cd write (2,*) 'lll=',lll
7127 cd write (2,*) 'iii=1'
7129 cd write (2,'(3(2f10.5),5x)')
7130 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7133 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7134 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7136 cd write (2,*) 'lll=',lll
7137 cd write (2,*) 'iii=2'
7139 cd write (2,'(3(2f10.5),5x)')
7140 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7147 C---------------------------------------------------------------------------
7148 double precision function eello4(i,j,k,l,jj,kk)
7149 implicit real*8 (a-h,o-z)
7150 include 'DIMENSIONS'
7151 include 'COMMON.IOUNITS'
7152 include 'COMMON.CHAIN'
7153 include 'COMMON.DERIV'
7154 include 'COMMON.INTERACT'
7155 include 'COMMON.CONTACTS'
7156 include 'COMMON.TORSION'
7157 include 'COMMON.VAR'
7158 include 'COMMON.GEO'
7159 double precision pizda(2,2),ggg1(3),ggg2(3)
7160 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7164 cd print *,'eello4:',i,j,k,l,jj,kk
7165 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7166 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7167 cold eij=facont_hb(jj,i)
7168 cold ekl=facont_hb(kk,k)
7170 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7171 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7172 gcorr_loc(k-1)=gcorr_loc(k-1)
7173 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7175 gcorr_loc(l-1)=gcorr_loc(l-1)
7176 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7178 gcorr_loc(j-1)=gcorr_loc(j-1)
7179 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7184 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7185 & -EAEAderx(2,2,lll,kkk,iii,1)
7186 cd derx(lll,kkk,iii)=0.0d0
7190 cd gcorr_loc(l-1)=0.0d0
7191 cd gcorr_loc(j-1)=0.0d0
7192 cd gcorr_loc(k-1)=0.0d0
7194 cd write (iout,*)'Contacts have occurred for peptide groups',
7195 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7196 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7197 if (j.lt.nres-1) then
7204 if (l.lt.nres-1) then
7212 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7213 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7214 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7215 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7216 cgrad ghalf=0.5d0*ggg1(ll)
7217 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7218 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7219 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7220 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7221 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7222 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7223 cgrad ghalf=0.5d0*ggg2(ll)
7224 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7225 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7226 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7227 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7228 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7229 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7233 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7238 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7243 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7248 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7252 cd write (2,*) iii,gcorr_loc(iii)
7255 cd write (2,*) 'ekont',ekont
7256 cd write (iout,*) 'eello4',ekont*eel4
7259 C---------------------------------------------------------------------------
7260 double precision function eello5(i,j,k,l,jj,kk)
7261 implicit real*8 (a-h,o-z)
7262 include 'DIMENSIONS'
7263 include 'COMMON.IOUNITS'
7264 include 'COMMON.CHAIN'
7265 include 'COMMON.DERIV'
7266 include 'COMMON.INTERACT'
7267 include 'COMMON.CONTACTS'
7268 include 'COMMON.TORSION'
7269 include 'COMMON.VAR'
7270 include 'COMMON.GEO'
7271 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7272 double precision ggg1(3),ggg2(3)
7273 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7278 C /l\ / \ \ / \ / \ / C
7279 C / \ / \ \ / \ / \ / C
7280 C j| o |l1 | o | o| o | | o |o C
7281 C \ |/k\| |/ \| / |/ \| |/ \| C
7282 C \i/ \ / \ / / \ / \ C
7284 C (I) (II) (III) (IV) C
7286 C eello5_1 eello5_2 eello5_3 eello5_4 C
7288 C Antiparallel chains C
7291 C /j\ / \ \ / \ / \ / C
7292 C / \ / \ \ / \ / \ / C
7293 C j1| o |l | o | o| o | | o |o C
7294 C \ |/k\| |/ \| / |/ \| |/ \| C
7295 C \i/ \ / \ / / \ / \ C
7297 C (I) (II) (III) (IV) C
7299 C eello5_1 eello5_2 eello5_3 eello5_4 C
7301 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7303 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7304 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7309 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7311 itk=itortyp(itype(k))
7312 itl=itortyp(itype(l))
7313 itj=itortyp(itype(j))
7318 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7319 cd & eel5_3_num,eel5_4_num)
7323 derx(lll,kkk,iii)=0.0d0
7327 cd eij=facont_hb(jj,i)
7328 cd ekl=facont_hb(kk,k)
7330 cd write (iout,*)'Contacts have occurred for peptide groups',
7331 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7333 C Contribution from the graph I.
7334 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7335 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7336 call transpose2(EUg(1,1,k),auxmat(1,1))
7337 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7338 vv(1)=pizda(1,1)-pizda(2,2)
7339 vv(2)=pizda(1,2)+pizda(2,1)
7340 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7341 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7342 C Explicit gradient in virtual-dihedral angles.
7343 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7344 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7345 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7346 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7347 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7348 vv(1)=pizda(1,1)-pizda(2,2)
7349 vv(2)=pizda(1,2)+pizda(2,1)
7350 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7351 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7352 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7353 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7354 vv(1)=pizda(1,1)-pizda(2,2)
7355 vv(2)=pizda(1,2)+pizda(2,1)
7357 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7358 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7359 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7361 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7362 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7363 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7365 C Cartesian gradient
7369 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7371 vv(1)=pizda(1,1)-pizda(2,2)
7372 vv(2)=pizda(1,2)+pizda(2,1)
7373 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7374 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7375 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7381 C Contribution from graph II
7382 call transpose2(EE(1,1,itk),auxmat(1,1))
7383 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7384 vv(1)=pizda(1,1)+pizda(2,2)
7385 vv(2)=pizda(2,1)-pizda(1,2)
7386 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7387 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7388 C Explicit gradient in virtual-dihedral angles.
7389 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7390 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7391 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7392 vv(1)=pizda(1,1)+pizda(2,2)
7393 vv(2)=pizda(2,1)-pizda(1,2)
7395 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7396 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7397 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7399 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7400 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7401 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7403 C Cartesian gradient
7407 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7409 vv(1)=pizda(1,1)+pizda(2,2)
7410 vv(2)=pizda(2,1)-pizda(1,2)
7411 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7412 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7413 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7421 C Parallel orientation
7422 C Contribution from graph III
7423 call transpose2(EUg(1,1,l),auxmat(1,1))
7424 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7425 vv(1)=pizda(1,1)-pizda(2,2)
7426 vv(2)=pizda(1,2)+pizda(2,1)
7427 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7428 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7429 C Explicit gradient in virtual-dihedral angles.
7430 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7431 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7432 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7433 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7434 vv(1)=pizda(1,1)-pizda(2,2)
7435 vv(2)=pizda(1,2)+pizda(2,1)
7436 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7437 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7438 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7439 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7440 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7441 vv(1)=pizda(1,1)-pizda(2,2)
7442 vv(2)=pizda(1,2)+pizda(2,1)
7443 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7444 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7445 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7446 C Cartesian gradient
7450 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7452 vv(1)=pizda(1,1)-pizda(2,2)
7453 vv(2)=pizda(1,2)+pizda(2,1)
7454 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7455 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7456 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7461 C Contribution from graph IV
7463 call transpose2(EE(1,1,itl),auxmat(1,1))
7464 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7465 vv(1)=pizda(1,1)+pizda(2,2)
7466 vv(2)=pizda(2,1)-pizda(1,2)
7467 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7468 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7469 C Explicit gradient in virtual-dihedral angles.
7470 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7471 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7472 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7473 vv(1)=pizda(1,1)+pizda(2,2)
7474 vv(2)=pizda(2,1)-pizda(1,2)
7475 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7476 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7477 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7478 C Cartesian gradient
7482 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7484 vv(1)=pizda(1,1)+pizda(2,2)
7485 vv(2)=pizda(2,1)-pizda(1,2)
7486 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7487 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7488 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7493 C Antiparallel orientation
7494 C Contribution from graph III
7496 call transpose2(EUg(1,1,j),auxmat(1,1))
7497 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7498 vv(1)=pizda(1,1)-pizda(2,2)
7499 vv(2)=pizda(1,2)+pizda(2,1)
7500 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7501 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7502 C Explicit gradient in virtual-dihedral angles.
7503 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7504 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7505 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7506 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7507 vv(1)=pizda(1,1)-pizda(2,2)
7508 vv(2)=pizda(1,2)+pizda(2,1)
7509 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7510 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7511 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7512 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7513 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7514 vv(1)=pizda(1,1)-pizda(2,2)
7515 vv(2)=pizda(1,2)+pizda(2,1)
7516 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7517 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7518 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7519 C Cartesian gradient
7523 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7525 vv(1)=pizda(1,1)-pizda(2,2)
7526 vv(2)=pizda(1,2)+pizda(2,1)
7527 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7528 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7529 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7534 C Contribution from graph IV
7536 call transpose2(EE(1,1,itj),auxmat(1,1))
7537 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7538 vv(1)=pizda(1,1)+pizda(2,2)
7539 vv(2)=pizda(2,1)-pizda(1,2)
7540 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7541 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7542 C Explicit gradient in virtual-dihedral angles.
7543 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7544 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7545 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7546 vv(1)=pizda(1,1)+pizda(2,2)
7547 vv(2)=pizda(2,1)-pizda(1,2)
7548 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7549 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7550 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7551 C Cartesian gradient
7555 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7557 vv(1)=pizda(1,1)+pizda(2,2)
7558 vv(2)=pizda(2,1)-pizda(1,2)
7559 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7560 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7561 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7567 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7568 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7569 cd write (2,*) 'ijkl',i,j,k,l
7570 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7571 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7573 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7574 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7575 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7576 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7577 if (j.lt.nres-1) then
7584 if (l.lt.nres-1) then
7594 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7595 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7596 C summed up outside the subrouine as for the other subroutines
7597 C handling long-range interactions. The old code is commented out
7598 C with "cgrad" to keep track of changes.
7600 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7601 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7602 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7603 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7604 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7605 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7606 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7607 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7608 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7609 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7611 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7612 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7613 cgrad ghalf=0.5d0*ggg1(ll)
7615 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7616 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7617 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7618 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7619 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7620 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7621 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7622 cgrad ghalf=0.5d0*ggg2(ll)
7624 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7625 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7626 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7627 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7628 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7629 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7634 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7635 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7640 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7641 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7647 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7652 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7656 cd write (2,*) iii,g_corr5_loc(iii)
7659 cd write (2,*) 'ekont',ekont
7660 cd write (iout,*) 'eello5',ekont*eel5
7663 c--------------------------------------------------------------------------
7664 double precision function eello6(i,j,k,l,jj,kk)
7665 implicit real*8 (a-h,o-z)
7666 include 'DIMENSIONS'
7667 include 'COMMON.IOUNITS'
7668 include 'COMMON.CHAIN'
7669 include 'COMMON.DERIV'
7670 include 'COMMON.INTERACT'
7671 include 'COMMON.CONTACTS'
7672 include 'COMMON.TORSION'
7673 include 'COMMON.VAR'
7674 include 'COMMON.GEO'
7675 include 'COMMON.FFIELD'
7676 double precision ggg1(3),ggg2(3)
7677 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7682 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7690 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7691 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7695 derx(lll,kkk,iii)=0.0d0
7699 cd eij=facont_hb(jj,i)
7700 cd ekl=facont_hb(kk,k)
7706 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7707 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7708 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7709 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7710 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7711 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7713 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7714 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7715 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7716 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7717 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7718 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7722 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7724 C If turn contributions are considered, they will be handled separately.
7725 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7726 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7727 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7728 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7729 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7730 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7731 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7733 if (j.lt.nres-1) then
7740 if (l.lt.nres-1) then
7748 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7749 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7750 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7751 cgrad ghalf=0.5d0*ggg1(ll)
7753 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7754 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7755 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7756 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7757 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7758 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7759 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7760 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7761 cgrad ghalf=0.5d0*ggg2(ll)
7762 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7764 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7765 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7766 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7767 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7768 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7769 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7774 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7775 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7780 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7781 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7787 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7792 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7796 cd write (2,*) iii,g_corr6_loc(iii)
7799 cd write (2,*) 'ekont',ekont
7800 cd write (iout,*) 'eello6',ekont*eel6
7803 c--------------------------------------------------------------------------
7804 double precision function eello6_graph1(i,j,k,l,imat,swap)
7805 implicit real*8 (a-h,o-z)
7806 include 'DIMENSIONS'
7807 include 'COMMON.IOUNITS'
7808 include 'COMMON.CHAIN'
7809 include 'COMMON.DERIV'
7810 include 'COMMON.INTERACT'
7811 include 'COMMON.CONTACTS'
7812 include 'COMMON.TORSION'
7813 include 'COMMON.VAR'
7814 include 'COMMON.GEO'
7815 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7819 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7821 C Parallel Antiparallel C
7827 C \ j|/k\| / \ |/k\|l / C
7832 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7833 itk=itortyp(itype(k))
7834 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7835 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7836 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7837 call transpose2(EUgC(1,1,k),auxmat(1,1))
7838 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7839 vv1(1)=pizda1(1,1)-pizda1(2,2)
7840 vv1(2)=pizda1(1,2)+pizda1(2,1)
7841 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7842 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7843 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7844 s5=scalar2(vv(1),Dtobr2(1,i))
7845 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7846 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7847 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7848 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7849 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7850 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7851 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7852 & +scalar2(vv(1),Dtobr2der(1,i)))
7853 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7854 vv1(1)=pizda1(1,1)-pizda1(2,2)
7855 vv1(2)=pizda1(1,2)+pizda1(2,1)
7856 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7857 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7859 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7860 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7861 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7862 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7863 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7865 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7866 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7867 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7868 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7869 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7871 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7872 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7873 vv1(1)=pizda1(1,1)-pizda1(2,2)
7874 vv1(2)=pizda1(1,2)+pizda1(2,1)
7875 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7876 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7877 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7878 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7887 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7888 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7889 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7890 call transpose2(EUgC(1,1,k),auxmat(1,1))
7891 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7893 vv1(1)=pizda1(1,1)-pizda1(2,2)
7894 vv1(2)=pizda1(1,2)+pizda1(2,1)
7895 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7896 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7897 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7898 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7899 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7900 s5=scalar2(vv(1),Dtobr2(1,i))
7901 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7907 c----------------------------------------------------------------------------
7908 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7909 implicit real*8 (a-h,o-z)
7910 include 'DIMENSIONS'
7911 include 'COMMON.IOUNITS'
7912 include 'COMMON.CHAIN'
7913 include 'COMMON.DERIV'
7914 include 'COMMON.INTERACT'
7915 include 'COMMON.CONTACTS'
7916 include 'COMMON.TORSION'
7917 include 'COMMON.VAR'
7918 include 'COMMON.GEO'
7920 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7921 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7924 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7926 C Parallel Antiparallel C
7932 C \ j|/k\| \ |/k\|l C
7937 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7938 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7939 C AL 7/4/01 s1 would occur in the sixth-order moment,
7940 C but not in a cluster cumulant
7942 s1=dip(1,jj,i)*dip(1,kk,k)
7944 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7945 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7946 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7947 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7948 call transpose2(EUg(1,1,k),auxmat(1,1))
7949 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7950 vv(1)=pizda(1,1)-pizda(2,2)
7951 vv(2)=pizda(1,2)+pizda(2,1)
7952 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7953 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7955 eello6_graph2=-(s1+s2+s3+s4)
7957 eello6_graph2=-(s2+s3+s4)
7960 C Derivatives in gamma(i-1)
7963 s1=dipderg(1,jj,i)*dip(1,kk,k)
7965 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7966 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7967 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7968 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7970 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7972 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7974 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7976 C Derivatives in gamma(k-1)
7978 s1=dip(1,jj,i)*dipderg(1,kk,k)
7980 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7981 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7982 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7983 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7984 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7985 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7986 vv(1)=pizda(1,1)-pizda(2,2)
7987 vv(2)=pizda(1,2)+pizda(2,1)
7988 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7990 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7992 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7994 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7995 C Derivatives in gamma(j-1) or gamma(l-1)
7998 s1=dipderg(3,jj,i)*dip(1,kk,k)
8000 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8001 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8002 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8003 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8004 vv(1)=pizda(1,1)-pizda(2,2)
8005 vv(2)=pizda(1,2)+pizda(2,1)
8006 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8009 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8011 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8014 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8015 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8017 C Derivatives in gamma(l-1) or gamma(j-1)
8020 s1=dip(1,jj,i)*dipderg(3,kk,k)
8022 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8023 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8024 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8025 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8026 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8027 vv(1)=pizda(1,1)-pizda(2,2)
8028 vv(2)=pizda(1,2)+pizda(2,1)
8029 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8032 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8034 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8037 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8038 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8040 C Cartesian derivatives.
8042 write (2,*) 'In eello6_graph2'
8044 write (2,*) 'iii=',iii
8046 write (2,*) 'kkk=',kkk
8048 write (2,'(3(2f10.5),5x)')
8049 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8059 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8061 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8064 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8066 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8067 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8069 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8070 call transpose2(EUg(1,1,k),auxmat(1,1))
8071 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8073 vv(1)=pizda(1,1)-pizda(2,2)
8074 vv(2)=pizda(1,2)+pizda(2,1)
8075 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8076 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8078 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8080 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8083 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8085 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8092 c----------------------------------------------------------------------------
8093 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8094 implicit real*8 (a-h,o-z)
8095 include 'DIMENSIONS'
8096 include 'COMMON.IOUNITS'
8097 include 'COMMON.CHAIN'
8098 include 'COMMON.DERIV'
8099 include 'COMMON.INTERACT'
8100 include 'COMMON.CONTACTS'
8101 include 'COMMON.TORSION'
8102 include 'COMMON.VAR'
8103 include 'COMMON.GEO'
8104 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8106 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8108 C Parallel Antiparallel C
8114 C j|/k\| / |/k\|l / C
8119 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8121 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8122 C energy moment and not to the cluster cumulant.
8123 iti=itortyp(itype(i))
8124 if (j.lt.nres-1) then
8125 itj1=itortyp(itype(j+1))
8129 itk=itortyp(itype(k))
8130 itk1=itortyp(itype(k+1))
8131 if (l.lt.nres-1) then
8132 itl1=itortyp(itype(l+1))
8137 s1=dip(4,jj,i)*dip(4,kk,k)
8139 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8140 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8141 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8142 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8143 call transpose2(EE(1,1,itk),auxmat(1,1))
8144 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8145 vv(1)=pizda(1,1)+pizda(2,2)
8146 vv(2)=pizda(2,1)-pizda(1,2)
8147 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8148 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8149 cd & "sum",-(s2+s3+s4)
8151 eello6_graph3=-(s1+s2+s3+s4)
8153 eello6_graph3=-(s2+s3+s4)
8156 C Derivatives in gamma(k-1)
8157 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8158 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8159 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8160 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8161 C Derivatives in gamma(l-1)
8162 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8163 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8164 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8165 vv(1)=pizda(1,1)+pizda(2,2)
8166 vv(2)=pizda(2,1)-pizda(1,2)
8167 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8168 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8169 C Cartesian derivatives.
8175 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8177 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8180 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8182 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8183 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8185 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8186 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8188 vv(1)=pizda(1,1)+pizda(2,2)
8189 vv(2)=pizda(2,1)-pizda(1,2)
8190 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8192 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8194 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8197 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8199 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8201 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8207 c----------------------------------------------------------------------------
8208 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8209 implicit real*8 (a-h,o-z)
8210 include 'DIMENSIONS'
8211 include 'COMMON.IOUNITS'
8212 include 'COMMON.CHAIN'
8213 include 'COMMON.DERIV'
8214 include 'COMMON.INTERACT'
8215 include 'COMMON.CONTACTS'
8216 include 'COMMON.TORSION'
8217 include 'COMMON.VAR'
8218 include 'COMMON.GEO'
8219 include 'COMMON.FFIELD'
8220 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8221 & auxvec1(2),auxmat1(2,2)
8223 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8225 C Parallel Antiparallel C
8231 C \ j|/k\| \ |/k\|l C
8236 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8238 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8239 C energy moment and not to the cluster cumulant.
8240 cd write (2,*) 'eello_graph4: wturn6',wturn6
8241 iti=itortyp(itype(i))
8242 itj=itortyp(itype(j))
8243 if (j.lt.nres-1) then
8244 itj1=itortyp(itype(j+1))
8248 itk=itortyp(itype(k))
8249 if (k.lt.nres-1) then
8250 itk1=itortyp(itype(k+1))
8254 itl=itortyp(itype(l))
8255 if (l.lt.nres-1) then
8256 itl1=itortyp(itype(l+1))
8260 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8261 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8262 cd & ' itl',itl,' itl1',itl1
8265 s1=dip(3,jj,i)*dip(3,kk,k)
8267 s1=dip(2,jj,j)*dip(2,kk,l)
8270 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8271 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8273 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8274 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8276 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8277 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8279 call transpose2(EUg(1,1,k),auxmat(1,1))
8280 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8281 vv(1)=pizda(1,1)-pizda(2,2)
8282 vv(2)=pizda(2,1)+pizda(1,2)
8283 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8284 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8286 eello6_graph4=-(s1+s2+s3+s4)
8288 eello6_graph4=-(s2+s3+s4)
8290 C Derivatives in gamma(i-1)
8294 s1=dipderg(2,jj,i)*dip(3,kk,k)
8296 s1=dipderg(4,jj,j)*dip(2,kk,l)
8299 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8301 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8302 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8304 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8305 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8307 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8308 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8309 cd write (2,*) 'turn6 derivatives'
8311 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8313 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8317 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8319 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8323 C Derivatives in gamma(k-1)
8326 s1=dip(3,jj,i)*dipderg(2,kk,k)
8328 s1=dip(2,jj,j)*dipderg(4,kk,l)
8331 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8332 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8334 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8335 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8337 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8338 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8340 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8341 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8342 vv(1)=pizda(1,1)-pizda(2,2)
8343 vv(2)=pizda(2,1)+pizda(1,2)
8344 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8345 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8347 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8349 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8353 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8355 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8358 C Derivatives in gamma(j-1) or gamma(l-1)
8359 if (l.eq.j+1 .and. l.gt.1) then
8360 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8361 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8362 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8363 vv(1)=pizda(1,1)-pizda(2,2)
8364 vv(2)=pizda(2,1)+pizda(1,2)
8365 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8366 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8367 else if (j.gt.1) then
8368 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8369 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8370 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8371 vv(1)=pizda(1,1)-pizda(2,2)
8372 vv(2)=pizda(2,1)+pizda(1,2)
8373 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8374 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8375 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8377 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8380 C Cartesian derivatives.
8387 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8389 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8393 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8395 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8399 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8401 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8403 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8404 & b1(1,itj1),auxvec(1))
8405 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8407 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8408 & b1(1,itl1),auxvec(1))
8409 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8411 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8413 vv(1)=pizda(1,1)-pizda(2,2)
8414 vv(2)=pizda(2,1)+pizda(1,2)
8415 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8417 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8419 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8422 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8425 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8428 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8430 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8432 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8436 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8438 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8441 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8443 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8451 c----------------------------------------------------------------------------
8452 double precision function eello_turn6(i,jj,kk)
8453 implicit real*8 (a-h,o-z)
8454 include 'DIMENSIONS'
8455 include 'COMMON.IOUNITS'
8456 include 'COMMON.CHAIN'
8457 include 'COMMON.DERIV'
8458 include 'COMMON.INTERACT'
8459 include 'COMMON.CONTACTS'
8460 include 'COMMON.TORSION'
8461 include 'COMMON.VAR'
8462 include 'COMMON.GEO'
8463 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8464 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8466 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8467 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8468 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8469 C the respective energy moment and not to the cluster cumulant.
8478 iti=itortyp(itype(i))
8479 itk=itortyp(itype(k))
8480 itk1=itortyp(itype(k+1))
8481 itl=itortyp(itype(l))
8482 itj=itortyp(itype(j))
8483 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8484 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8485 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8490 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8492 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8496 derx_turn(lll,kkk,iii)=0.0d0
8503 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8505 cd write (2,*) 'eello6_5',eello6_5
8507 call transpose2(AEA(1,1,1),auxmat(1,1))
8508 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8509 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8510 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8512 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8513 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8514 s2 = scalar2(b1(1,itk),vtemp1(1))
8516 call transpose2(AEA(1,1,2),atemp(1,1))
8517 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8518 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8519 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8521 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8522 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8523 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8525 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8526 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8527 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8528 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8529 ss13 = scalar2(b1(1,itk),vtemp4(1))
8530 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8532 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8538 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8539 C Derivatives in gamma(i+2)
8543 call transpose2(AEA(1,1,1),auxmatd(1,1))
8544 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8545 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8546 call transpose2(AEAderg(1,1,2),atempd(1,1))
8547 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8548 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8550 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8551 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8552 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8558 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8559 C Derivatives in gamma(i+3)
8561 call transpose2(AEA(1,1,1),auxmatd(1,1))
8562 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8563 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8564 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8566 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8567 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8568 s2d = scalar2(b1(1,itk),vtemp1d(1))
8570 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8571 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8573 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8575 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8576 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8577 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8585 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8586 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8588 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8589 & -0.5d0*ekont*(s2d+s12d)
8591 C Derivatives in gamma(i+4)
8592 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8593 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8594 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8596 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8597 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8598 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8606 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8608 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8610 C Derivatives in gamma(i+5)
8612 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8613 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8614 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8616 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8617 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8618 s2d = scalar2(b1(1,itk),vtemp1d(1))
8620 call transpose2(AEA(1,1,2),atempd(1,1))
8621 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8622 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8624 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8625 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8627 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8628 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8629 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8637 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8638 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8640 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8641 & -0.5d0*ekont*(s2d+s12d)
8643 C Cartesian derivatives
8648 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8649 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8650 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8652 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8653 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8655 s2d = scalar2(b1(1,itk),vtemp1d(1))
8657 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8658 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8659 s8d = -(atempd(1,1)+atempd(2,2))*
8660 & scalar2(cc(1,1,itl),vtemp2(1))
8662 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8664 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8665 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8672 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8675 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8679 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8680 & - 0.5d0*(s8d+s12d)
8682 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8691 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8693 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8694 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8695 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8696 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8697 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8699 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8700 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8701 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8705 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8706 cd & 16*eel_turn6_num
8708 if (j.lt.nres-1) then
8715 if (l.lt.nres-1) then
8723 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8724 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8725 cgrad ghalf=0.5d0*ggg1(ll)
8727 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8728 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8729 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8730 & +ekont*derx_turn(ll,2,1)
8731 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8732 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8733 & +ekont*derx_turn(ll,4,1)
8734 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8735 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8736 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8737 cgrad ghalf=0.5d0*ggg2(ll)
8739 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8740 & +ekont*derx_turn(ll,2,2)
8741 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8742 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8743 & +ekont*derx_turn(ll,4,2)
8744 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8745 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8746 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8751 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8756 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8762 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8767 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8771 cd write (2,*) iii,g_corr6_loc(iii)
8773 eello_turn6=ekont*eel_turn6
8774 cd write (2,*) 'ekont',ekont
8775 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8779 C-----------------------------------------------------------------------------
8780 double precision function scalar(u,v)
8781 !DIR$ INLINEALWAYS scalar
8783 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8786 double precision u(3),v(3)
8787 cd double precision sc
8795 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8798 crc-------------------------------------------------
8799 SUBROUTINE MATVEC2(A1,V1,V2)
8800 !DIR$ INLINEALWAYS MATVEC2
8802 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8804 implicit real*8 (a-h,o-z)
8805 include 'DIMENSIONS'
8806 DIMENSION A1(2,2),V1(2),V2(2)
8810 c 3 VI=VI+A1(I,K)*V1(K)
8814 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8815 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8820 C---------------------------------------
8821 SUBROUTINE MATMAT2(A1,A2,A3)
8823 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8825 implicit real*8 (a-h,o-z)
8826 include 'DIMENSIONS'
8827 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8828 c DIMENSION AI3(2,2)
8832 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8838 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8839 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8840 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8841 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8849 c-------------------------------------------------------------------------
8850 double precision function scalar2(u,v)
8851 !DIR$ INLINEALWAYS scalar2
8853 double precision u(2),v(2)
8856 scalar2=u(1)*v(1)+u(2)*v(2)
8860 C-----------------------------------------------------------------------------
8862 subroutine transpose2(a,at)
8863 !DIR$ INLINEALWAYS transpose2
8865 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8868 double precision a(2,2),at(2,2)
8875 c--------------------------------------------------------------------------
8876 subroutine transpose(n,a,at)
8879 double precision a(n,n),at(n,n)
8887 C---------------------------------------------------------------------------
8888 subroutine prodmat3(a1,a2,kk,transp,prod)
8889 !DIR$ INLINEALWAYS prodmat3
8891 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8895 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8897 crc double precision auxmat(2,2),prod_(2,2)
8900 crc call transpose2(kk(1,1),auxmat(1,1))
8901 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8902 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8904 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8905 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8906 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8907 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8908 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8909 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8910 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8911 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8914 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8915 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8917 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8918 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8919 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8920 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8921 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8922 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8923 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8924 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8927 c call transpose2(a2(1,1),a2t(1,1))
8930 crc print *,((prod_(i,j),i=1,2),j=1,2)
8931 crc print *,((prod(i,j),i=1,2),j=1,2)