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
193 call ebend(ebe,ethetacnstr)
198 c print *,"Processor",myrank," computed UB"
200 C Calculate the SC local energy.
203 c print *,"Processor",myrank," computed USC"
205 C Calculate the virtual-bond torsional energy.
207 cd print *,'nterm=',nterm
209 call etor(etors,edihcnstr)
214 c print *,"Processor",myrank," computed Utor"
216 C 6/23/01 Calculate double-torsional energy
218 if (wtor_d.gt.0) then
223 c print *,"Processor",myrank," computed Utord"
225 C 21/5/07 Calculate local sicdechain correlation energy
227 if (wsccor.gt.0.0d0) then
228 call eback_sc_corr(esccor)
232 c print *,"Processor",myrank," computed Usccorr"
234 C 12/1/95 Multi-body terms
238 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
239 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
240 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
241 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
242 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
249 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
250 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
251 cd write (iout,*) "multibody_hb ecorr",ecorr
253 c print *,"Processor",myrank," computed Ucorr"
255 C If performing constraint dynamics, call the constraint energy
256 C after the equilibration time
257 if(usampl.and.totT.gt.eq_time) then
265 time_enecalc=time_enecalc+MPI_Wtime()-time00
267 c print *,"Processor",myrank," computed Uconstr"
276 energia(2)=evdw2-evdw2_14
293 energia(8)=eello_turn3
294 energia(9)=eello_turn4
301 energia(19)=edihcnstr
303 energia(20)=Uconst+Uconst_back
305 C energia(22)=eliptrans (the energy for lipid transfere implemented in lipid branch)
306 C energia(23)= ... (energy for AFM, steered molecular dynamics)
307 energia(24)=ethetacnstr
308 c Here are the energies showed per procesor if the are more processors
309 c per molecule then we sum it up in sum_energy subroutine
310 c print *," Processor",myrank," calls SUM_ENERGY"
311 call sum_energy(energia,.true.)
312 if (dyn_ss) call dyn_set_nss
313 c print *," Processor",myrank," left SUM_ENERGY"
315 time_sumene=time_sumene+MPI_Wtime()-time00
319 c-------------------------------------------------------------------------------
320 subroutine sum_energy(energia,reduce)
321 implicit real*8 (a-h,o-z)
326 cMS$ATTRIBUTES C :: proc_proc
332 include 'COMMON.SETUP'
333 include 'COMMON.IOUNITS'
334 double precision energia(0:n_ene),enebuff(0:n_ene+1)
335 include 'COMMON.FFIELD'
336 include 'COMMON.DERIV'
337 include 'COMMON.INTERACT'
338 include 'COMMON.SBRIDGE'
339 include 'COMMON.CHAIN'
341 include 'COMMON.CONTROL'
342 include 'COMMON.TIME1'
345 if (nfgtasks.gt.1 .and. reduce) then
347 write (iout,*) "energies before REDUCE"
348 call enerprint(energia)
352 enebuff(i)=energia(i)
355 call MPI_Barrier(FG_COMM,IERR)
356 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
358 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
359 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
361 write (iout,*) "energies after REDUCE"
362 call enerprint(energia)
365 time_Reduce=time_Reduce+MPI_Wtime()-time00
367 if (fg_rank.eq.0) then
371 evdw2=energia(2)+energia(18)
387 eello_turn3=energia(8)
388 eello_turn4=energia(9)
395 edihcnstr=energia(19)
399 ethetacnstr=energia(24)
402 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
403 & +wang*ebe+wtor*etors+wscloc*escloc
404 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
405 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
406 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
407 & +wbond*estr+Uconst+wsccor*esccor+ethetacnstr
409 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
410 & +wang*ebe+wtor*etors+wscloc*escloc
411 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
412 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
413 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
414 & +wbond*estr+Uconst+wsccor*esccor+ethetacnstr
420 if (isnan(etot).ne.0) energia(0)=1.0d+99
422 if (isnan(etot)) energia(0)=1.0d+99
427 idumm=proc_proc(etot,i)
429 call proc_proc(etot,i)
431 if(i.eq.1)energia(0)=1.0d+99
438 c-------------------------------------------------------------------------------
439 subroutine sum_gradient
440 implicit real*8 (a-h,o-z)
445 cMS$ATTRIBUTES C :: proc_proc
450 double precision gradbufc(3,maxres),gradbufx(3,maxres),
451 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
453 include 'COMMON.SETUP'
454 include 'COMMON.IOUNITS'
455 include 'COMMON.FFIELD'
456 include 'COMMON.DERIV'
457 include 'COMMON.INTERACT'
458 include 'COMMON.SBRIDGE'
459 include 'COMMON.CHAIN'
461 include 'COMMON.CONTROL'
462 include 'COMMON.TIME1'
463 include 'COMMON.MAXGRAD'
464 include 'COMMON.SCCOR'
469 write (iout,*) "sum_gradient gvdwc, gvdwx"
471 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
472 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
477 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
478 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
479 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
482 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
483 C in virtual-bond-vector coordinates
486 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
488 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
489 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
491 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
493 c write (iout,'(i5,3f10.5,2x,f10.5)')
494 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
496 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
498 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
499 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
507 gradbufc(j,i)=wsc*gvdwc(j,i)+
508 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
509 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
510 & wel_loc*gel_loc_long(j,i)+
511 & wcorr*gradcorr_long(j,i)+
512 & wcorr5*gradcorr5_long(j,i)+
513 & wcorr6*gradcorr6_long(j,i)+
514 & wturn6*gcorr6_turn_long(j,i)+
521 gradbufc(j,i)=wsc*gvdwc(j,i)+
522 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
523 & welec*gelc_long(j,i)+
525 & wel_loc*gel_loc_long(j,i)+
526 & wcorr*gradcorr_long(j,i)+
527 & wcorr5*gradcorr5_long(j,i)+
528 & wcorr6*gradcorr6_long(j,i)+
529 & wturn6*gcorr6_turn_long(j,i)+
535 if (nfgtasks.gt.1) then
538 write (iout,*) "gradbufc before allreduce"
540 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
546 gradbufc_sum(j,i)=gradbufc(j,i)
549 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
550 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
551 c time_reduce=time_reduce+MPI_Wtime()-time00
553 c write (iout,*) "gradbufc_sum after allreduce"
555 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
560 c time_allreduce=time_allreduce+MPI_Wtime()-time00
568 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
569 write (iout,*) (i," jgrad_start",jgrad_start(i),
570 & " jgrad_end ",jgrad_end(i),
571 & i=igrad_start,igrad_end)
574 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
575 c do not parallelize this part.
577 c do i=igrad_start,igrad_end
578 c do j=jgrad_start(i),jgrad_end(i)
580 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
585 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
589 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
593 write (iout,*) "gradbufc after summing"
595 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
602 write (iout,*) "gradbufc"
604 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
610 gradbufc_sum(j,i)=gradbufc(j,i)
615 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
619 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
624 c gradbufc(k,i)=0.0d0
628 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
633 write (iout,*) "gradbufc after summing"
635 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
643 gradbufc(k,nres)=0.0d0
648 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
649 & wel_loc*gel_loc(j,i)+
650 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
651 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
652 & wel_loc*gel_loc_long(j,i)+
653 & wcorr*gradcorr_long(j,i)+
654 & wcorr5*gradcorr5_long(j,i)+
655 & wcorr6*gradcorr6_long(j,i)+
656 & wturn6*gcorr6_turn_long(j,i))+
658 & wcorr*gradcorr(j,i)+
659 & wturn3*gcorr3_turn(j,i)+
660 & wturn4*gcorr4_turn(j,i)+
661 & wcorr5*gradcorr5(j,i)+
662 & wcorr6*gradcorr6(j,i)+
663 & wturn6*gcorr6_turn(j,i)+
664 & wsccor*gsccorc(j,i)
665 & +wscloc*gscloc(j,i)
667 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
668 & wel_loc*gel_loc(j,i)+
669 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
670 & welec*gelc_long(j,i)
671 & wel_loc*gel_loc_long(j,i)+
672 & wcorr*gcorr_long(j,i)+
673 & wcorr5*gradcorr5_long(j,i)+
674 & wcorr6*gradcorr6_long(j,i)+
675 & wturn6*gcorr6_turn_long(j,i))+
677 & wcorr*gradcorr(j,i)+
678 & wturn3*gcorr3_turn(j,i)+
679 & wturn4*gcorr4_turn(j,i)+
680 & wcorr5*gradcorr5(j,i)+
681 & wcorr6*gradcorr6(j,i)+
682 & wturn6*gcorr6_turn(j,i)+
683 & wsccor*gsccorc(j,i)
684 & +wscloc*gscloc(j,i)
686 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
688 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
689 & wsccor*gsccorx(j,i)
690 & +wscloc*gsclocx(j,i)
694 write (iout,*) "gloc before adding corr"
696 write (iout,*) i,gloc(i,icg)
700 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
701 & +wcorr5*g_corr5_loc(i)
702 & +wcorr6*g_corr6_loc(i)
703 & +wturn4*gel_loc_turn4(i)
704 & +wturn3*gel_loc_turn3(i)
705 & +wturn6*gel_loc_turn6(i)
706 & +wel_loc*gel_loc_loc(i)
709 write (iout,*) "gloc after adding corr"
711 write (iout,*) i,gloc(i,icg)
715 if (nfgtasks.gt.1) then
718 gradbufc(j,i)=gradc(j,i,icg)
719 gradbufx(j,i)=gradx(j,i,icg)
723 glocbuf(i)=gloc(i,icg)
727 write (iout,*) "gloc_sc before reduce"
730 write (iout,*) i,j,gloc_sc(j,i,icg)
737 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
741 call MPI_Barrier(FG_COMM,IERR)
742 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
744 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
745 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
746 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
747 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
748 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
749 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
750 time_reduce=time_reduce+MPI_Wtime()-time00
751 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
752 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
753 time_reduce=time_reduce+MPI_Wtime()-time00
756 write (iout,*) "gloc_sc after reduce"
759 write (iout,*) i,j,gloc_sc(j,i,icg)
765 write (iout,*) "gloc after reduce"
767 write (iout,*) i,gloc(i,icg)
772 if (gnorm_check) then
774 c Compute the maximum elements of the gradient
784 gcorr3_turn_max=0.0d0
785 gcorr4_turn_max=0.0d0
788 gcorr6_turn_max=0.0d0
798 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
799 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
800 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
801 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
802 & gvdwc_scp_max=gvdwc_scp_norm
803 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
804 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
805 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
806 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
807 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
808 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
809 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
810 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
811 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
812 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
813 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
814 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
815 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
817 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
818 & gcorr3_turn_max=gcorr3_turn_norm
819 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
821 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
822 & gcorr4_turn_max=gcorr4_turn_norm
823 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
824 if (gradcorr5_norm.gt.gradcorr5_max)
825 & gradcorr5_max=gradcorr5_norm
826 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
827 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
828 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
830 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
831 & gcorr6_turn_max=gcorr6_turn_norm
832 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
833 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
834 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
835 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
836 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
837 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
838 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
839 if (gradx_scp_norm.gt.gradx_scp_max)
840 & gradx_scp_max=gradx_scp_norm
841 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
842 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
843 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
844 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
845 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
846 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
847 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
848 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
852 open(istat,file=statname,position="append")
854 open(istat,file=statname,access="append")
856 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
857 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
858 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
859 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
860 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
861 & gsccorx_max,gsclocx_max
863 if (gvdwc_max.gt.1.0d4) then
864 write (iout,*) "gvdwc gvdwx gradb gradbx"
866 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
867 & gradb(j,i),gradbx(j,i),j=1,3)
869 call pdbout(0.0d0,'cipiszcze',iout)
875 write (iout,*) "gradc gradx gloc"
877 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
878 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
882 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
886 c-------------------------------------------------------------------------------
887 subroutine rescale_weights(t_bath)
888 implicit real*8 (a-h,o-z)
890 include 'COMMON.IOUNITS'
891 include 'COMMON.FFIELD'
892 include 'COMMON.SBRIDGE'
893 double precision kfac /2.4d0/
894 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
896 c facT=2*temp0/(t_bath+temp0)
897 if (rescale_mode.eq.0) then
903 else if (rescale_mode.eq.1) then
904 facT=kfac/(kfac-1.0d0+t_bath/temp0)
905 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
906 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
907 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
908 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
909 else if (rescale_mode.eq.2) then
915 facT=licznik/dlog(dexp(x)+dexp(-x))
916 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
917 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
918 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
919 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
921 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
922 write (*,*) "Wrong RESCALE_MODE",rescale_mode
924 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
928 welec=weights(3)*fact
929 wcorr=weights(4)*fact3
930 wcorr5=weights(5)*fact4
931 wcorr6=weights(6)*fact5
932 wel_loc=weights(7)*fact2
933 wturn3=weights(8)*fact2
934 wturn4=weights(9)*fact3
935 wturn6=weights(10)*fact5
936 wtor=weights(13)*fact
937 wtor_d=weights(14)*fact2
938 wsccor=weights(21)*fact
942 C------------------------------------------------------------------------
943 subroutine enerprint(energia)
944 implicit real*8 (a-h,o-z)
946 include 'COMMON.IOUNITS'
947 include 'COMMON.FFIELD'
948 include 'COMMON.SBRIDGE'
950 double precision energia(0:n_ene)
955 evdw2=energia(2)+energia(18)
967 eello_turn3=energia(8)
968 eello_turn4=energia(9)
969 eello_turn6=energia(10)
975 edihcnstr=energia(19)
979 ethetacnstr=energia(24)
981 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
982 & estr,wbond,ebe,wang,
983 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
985 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
986 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
988 & ethetacnstr,ebr*nss,
990 10 format (/'Virtual-chain energies:'//
991 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
992 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
993 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
994 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
995 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
996 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
997 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
998 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
999 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1000 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1001 & ' (SS bridges & dist. cnstr.)'/
1002 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1003 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1004 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1005 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1006 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1007 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1008 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1009 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1010 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1011 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1012 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1013 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1014 & 'ETOT= ',1pE16.6,' (total)')
1016 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1017 & estr,wbond,ebe,wang,
1018 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1020 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1021 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1023 & ebr*nss,Uconst,etot
1024 10 format (/'Virtual-chain energies:'//
1025 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1026 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1027 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1028 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1029 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1030 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1031 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1032 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1033 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1034 & ' (SS bridges & dist. cnstr.)'/
1035 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1036 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1037 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1038 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1039 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1040 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1041 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1042 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1043 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1044 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1045 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1046 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1047 & 'ETOT= ',1pE16.6,' (total)')
1051 C-----------------------------------------------------------------------
1052 subroutine elj(evdw)
1054 C This subroutine calculates the interaction energy of nonbonded side chains
1055 C assuming the LJ potential of interaction.
1057 implicit real*8 (a-h,o-z)
1058 include 'DIMENSIONS'
1059 parameter (accur=1.0d-10)
1060 include 'COMMON.GEO'
1061 include 'COMMON.VAR'
1062 include 'COMMON.LOCAL'
1063 include 'COMMON.CHAIN'
1064 include 'COMMON.DERIV'
1065 include 'COMMON.INTERACT'
1066 include 'COMMON.TORSION'
1067 include 'COMMON.SBRIDGE'
1068 include 'COMMON.NAMES'
1069 include 'COMMON.IOUNITS'
1070 include 'COMMON.CONTACTS'
1072 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1074 do i=iatsc_s,iatsc_e
1075 itypi=iabs(itype(i))
1076 if (itypi.eq.ntyp1) cycle
1077 itypi1=iabs(itype(i+1))
1084 C Calculate SC interaction energy.
1086 do iint=1,nint_gr(i)
1087 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1088 cd & 'iend=',iend(i,iint)
1089 do j=istart(i,iint),iend(i,iint)
1090 itypj=iabs(itype(j))
1091 if (itypj.eq.ntyp1) cycle
1095 C Change 12/1/95 to calculate four-body interactions
1096 rij=xj*xj+yj*yj+zj*zj
1098 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1099 eps0ij=eps(itypi,itypj)
1101 e1=fac*fac*aa(itypi,itypj)
1102 e2=fac*bb(itypi,itypj)
1104 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1105 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1106 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1107 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1108 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1109 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1112 C Calculate the components of the gradient in DC and X
1114 fac=-rrij*(e1+evdwij)
1119 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1120 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1121 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1122 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1126 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1130 C 12/1/95, revised on 5/20/97
1132 C Calculate the contact function. The ith column of the array JCONT will
1133 C contain the numbers of atoms that make contacts with the atom I (of numbers
1134 C greater than I). The arrays FACONT and GACONT will contain the values of
1135 C the contact function and its derivative.
1137 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1138 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1139 C Uncomment next line, if the correlation interactions are contact function only
1140 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1142 sigij=sigma(itypi,itypj)
1143 r0ij=rs0(itypi,itypj)
1145 C Check whether the SC's are not too far to make a contact.
1148 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1149 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1151 if (fcont.gt.0.0D0) then
1152 C If the SC-SC distance if close to sigma, apply spline.
1153 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1154 cAdam & fcont1,fprimcont1)
1155 cAdam fcont1=1.0d0-fcont1
1156 cAdam if (fcont1.gt.0.0d0) then
1157 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1158 cAdam fcont=fcont*fcont1
1160 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1161 cga eps0ij=1.0d0/dsqrt(eps0ij)
1163 cga gg(k)=gg(k)*eps0ij
1165 cga eps0ij=-evdwij*eps0ij
1166 C Uncomment for AL's type of SC correlation interactions.
1167 cadam eps0ij=-evdwij
1168 num_conti=num_conti+1
1169 jcont(num_conti,i)=j
1170 facont(num_conti,i)=fcont*eps0ij
1171 fprimcont=eps0ij*fprimcont/rij
1173 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1174 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1175 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1176 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1177 gacont(1,num_conti,i)=-fprimcont*xj
1178 gacont(2,num_conti,i)=-fprimcont*yj
1179 gacont(3,num_conti,i)=-fprimcont*zj
1180 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1181 cd write (iout,'(2i3,3f10.5)')
1182 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1188 num_cont(i)=num_conti
1192 gvdwc(j,i)=expon*gvdwc(j,i)
1193 gvdwx(j,i)=expon*gvdwx(j,i)
1196 C******************************************************************************
1200 C To save time, the factor of EXPON has been extracted from ALL components
1201 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1204 C******************************************************************************
1207 C-----------------------------------------------------------------------------
1208 subroutine eljk(evdw)
1210 C This subroutine calculates the interaction energy of nonbonded side chains
1211 C assuming the LJK potential of interaction.
1213 implicit real*8 (a-h,o-z)
1214 include 'DIMENSIONS'
1215 include 'COMMON.GEO'
1216 include 'COMMON.VAR'
1217 include 'COMMON.LOCAL'
1218 include 'COMMON.CHAIN'
1219 include 'COMMON.DERIV'
1220 include 'COMMON.INTERACT'
1221 include 'COMMON.IOUNITS'
1222 include 'COMMON.NAMES'
1225 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1227 do i=iatsc_s,iatsc_e
1228 itypi=iabs(itype(i))
1229 if (itypi.eq.ntyp1) cycle
1230 itypi1=iabs(itype(i+1))
1235 C Calculate SC interaction energy.
1237 do iint=1,nint_gr(i)
1238 do j=istart(i,iint),iend(i,iint)
1239 itypj=iabs(itype(j))
1240 if (itypj.eq.ntyp1) cycle
1244 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1245 fac_augm=rrij**expon
1246 e_augm=augm(itypi,itypj)*fac_augm
1247 r_inv_ij=dsqrt(rrij)
1249 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1250 fac=r_shift_inv**expon
1251 e1=fac*fac*aa(itypi,itypj)
1252 e2=fac*bb(itypi,itypj)
1254 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1255 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1256 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1257 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1258 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1259 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1260 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1263 C Calculate the components of the gradient in DC and X
1265 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1270 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1271 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1272 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1273 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1277 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1285 gvdwc(j,i)=expon*gvdwc(j,i)
1286 gvdwx(j,i)=expon*gvdwx(j,i)
1291 C-----------------------------------------------------------------------------
1292 subroutine ebp(evdw)
1294 C This subroutine calculates the interaction energy of nonbonded side chains
1295 C assuming the Berne-Pechukas potential of interaction.
1297 implicit real*8 (a-h,o-z)
1298 include 'DIMENSIONS'
1299 include 'COMMON.GEO'
1300 include 'COMMON.VAR'
1301 include 'COMMON.LOCAL'
1302 include 'COMMON.CHAIN'
1303 include 'COMMON.DERIV'
1304 include 'COMMON.NAMES'
1305 include 'COMMON.INTERACT'
1306 include 'COMMON.IOUNITS'
1307 include 'COMMON.CALC'
1308 common /srutu/ icall
1309 c double precision rrsave(maxdim)
1312 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1314 c if (icall.eq.0) then
1320 do i=iatsc_s,iatsc_e
1321 itypi=iabs(itype(i))
1322 if (itypi.eq.ntyp1) cycle
1323 itypi1=iabs(itype(i+1))
1327 dxi=dc_norm(1,nres+i)
1328 dyi=dc_norm(2,nres+i)
1329 dzi=dc_norm(3,nres+i)
1330 c dsci_inv=dsc_inv(itypi)
1331 dsci_inv=vbld_inv(i+nres)
1333 C Calculate SC interaction energy.
1335 do iint=1,nint_gr(i)
1336 do j=istart(i,iint),iend(i,iint)
1338 itypj=iabs(itype(j))
1339 if (itypj.eq.ntyp1) cycle
1340 c dscj_inv=dsc_inv(itypj)
1341 dscj_inv=vbld_inv(j+nres)
1342 chi1=chi(itypi,itypj)
1343 chi2=chi(itypj,itypi)
1350 alf12=0.5D0*(alf1+alf2)
1351 C For diagnostics only!!!
1364 dxj=dc_norm(1,nres+j)
1365 dyj=dc_norm(2,nres+j)
1366 dzj=dc_norm(3,nres+j)
1367 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1368 cd if (icall.eq.0) then
1374 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1376 C Calculate whole angle-dependent part of epsilon and contributions
1377 C to its derivatives
1378 fac=(rrij*sigsq)**expon2
1379 e1=fac*fac*aa(itypi,itypj)
1380 e2=fac*bb(itypi,itypj)
1381 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1382 eps2der=evdwij*eps3rt
1383 eps3der=evdwij*eps2rt
1384 evdwij=evdwij*eps2rt*eps3rt
1387 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1388 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1389 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1390 cd & restyp(itypi),i,restyp(itypj),j,
1391 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1392 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1393 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1396 C Calculate gradient components.
1397 e1=e1*eps1*eps2rt**2*eps3rt**2
1398 fac=-expon*(e1+evdwij)
1401 C Calculate radial part of the gradient
1405 C Calculate the angular part of the gradient and sum add the contributions
1406 C to the appropriate components of the Cartesian gradient.
1414 C-----------------------------------------------------------------------------
1415 subroutine egb(evdw)
1417 C This subroutine calculates the interaction energy of nonbonded side chains
1418 C assuming the Gay-Berne potential of interaction.
1420 implicit real*8 (a-h,o-z)
1421 include 'DIMENSIONS'
1422 include 'COMMON.GEO'
1423 include 'COMMON.VAR'
1424 include 'COMMON.LOCAL'
1425 include 'COMMON.CHAIN'
1426 include 'COMMON.DERIV'
1427 include 'COMMON.NAMES'
1428 include 'COMMON.INTERACT'
1429 include 'COMMON.IOUNITS'
1430 include 'COMMON.CALC'
1431 include 'COMMON.CONTROL'
1432 include 'COMMON.SBRIDGE'
1435 c write(iout,*) "Jestem w egb(evdw)"
1438 ccccc energy_dec=.false.
1439 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1442 c if (icall.eq.0) lprn=.false.
1444 do i=iatsc_s,iatsc_e
1445 itypi=iabs(itype(i))
1446 if (itypi.eq.ntyp1) cycle
1447 itypi1=iabs(itype(i+1))
1451 dxi=dc_norm(1,nres+i)
1452 dyi=dc_norm(2,nres+i)
1453 dzi=dc_norm(3,nres+i)
1454 c dsci_inv=dsc_inv(itypi)
1455 dsci_inv=vbld_inv(i+nres)
1456 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1457 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1459 C Calculate SC interaction energy.
1461 do iint=1,nint_gr(i)
1462 do j=istart(i,iint),iend(i,iint)
1463 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1465 c write(iout,*) "PRZED ZWYKLE", evdwij
1466 call dyn_ssbond_ene(i,j,evdwij)
1467 c write(iout,*) "PO ZWYKLE", evdwij
1470 c write(iout,*) "DISULFIDY:", i,j,evdwij
1471 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1472 & 'evdw',i,j,evdwij,' ss'
1473 C triple bond artifac removal
1474 C MODIFIED j+1 to j+2 TO AVOID EBERGY BARRIER FOR X-Cys-Cys-X situations
1475 do k=j+1,iend(i,iint)
1476 C search over all next residues
1477 if (dyn_ss_mask(k)) then
1478 C check if they are cysteins
1479 C write(iout,*) 'k=',k
1481 c write(iout,*) "PRZED TRI", evdwij
1482 evdwij_przed_tri=evdwij
1483 call triple_ssbond_ene(i,j,k,evdwij)
1484 c write(iout,*) "TRISULFIDY:", i,j,k,evdwij
1485 c if(evdwij_przed_tri.ne.evdwij) then
1486 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1489 c write(iout,*) "PO TRI", evdwij
1490 C call the energy function that removes the artifical triple disulfide
1491 C bond the soubroutine is located in ssMD.F
1493 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1494 & 'evdw',i,j,evdwij,'tss'
1495 endif!dyn_ss_mask(k)
1499 itypj=iabs(itype(j))
1500 if (itypj.eq.ntyp1) cycle
1501 c dscj_inv=dsc_inv(itypj)
1502 dscj_inv=vbld_inv(j+nres)
1503 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1504 c & 1.0d0/vbld(j+nres)
1505 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1506 sig0ij=sigma(itypi,itypj)
1507 chi1=chi(itypi,itypj)
1508 chi2=chi(itypj,itypi)
1515 alf12=0.5D0*(alf1+alf2)
1516 C For diagnostics only!!!
1529 dxj=dc_norm(1,nres+j)
1530 dyj=dc_norm(2,nres+j)
1531 dzj=dc_norm(3,nres+j)
1532 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1533 c write (iout,*) "j",j," dc_norm",
1534 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1535 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1537 C Calculate angle-dependent terms of energy and contributions to their
1541 sig=sig0ij*dsqrt(sigsq)
1542 rij_shift=1.0D0/rij-sig+sig0ij
1543 c for diagnostics; uncomment
1544 c rij_shift=1.2*sig0ij
1545 C I hate to put IF's in the loops, but here don't have another choice!!!!
1546 if (rij_shift.le.0.0D0) then
1548 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1549 cd & restyp(itypi),i,restyp(itypj),j,
1550 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1554 c---------------------------------------------------------------
1555 rij_shift=1.0D0/rij_shift
1556 fac=rij_shift**expon
1557 e1=fac*fac*aa(itypi,itypj)
1558 e2=fac*bb(itypi,itypj)
1559 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1560 eps2der=evdwij*eps3rt
1561 eps3der=evdwij*eps2rt
1562 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1563 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1564 evdwij=evdwij*eps2rt*eps3rt
1567 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1568 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1569 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1570 & restyp(itypi),i,restyp(itypj),j,
1571 & epsi,sigm,chi1,chi2,chip1,chip2,
1572 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1573 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1577 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1580 C Calculate gradient components.
1581 e1=e1*eps1*eps2rt**2*eps3rt**2
1582 fac=-expon*(e1+evdwij)*rij_shift
1586 C Calculate the radial part of the gradient
1590 C Calculate angular part of the gradient.
1596 c write (iout,*) "Number of loop steps in EGB:",ind
1597 cccc energy_dec=.false.
1600 C-----------------------------------------------------------------------------
1601 subroutine egbv(evdw)
1603 C This subroutine calculates the interaction energy of nonbonded side chains
1604 C assuming the Gay-Berne-Vorobjev potential of interaction.
1606 implicit real*8 (a-h,o-z)
1607 include 'DIMENSIONS'
1608 include 'COMMON.GEO'
1609 include 'COMMON.VAR'
1610 include 'COMMON.LOCAL'
1611 include 'COMMON.CHAIN'
1612 include 'COMMON.DERIV'
1613 include 'COMMON.NAMES'
1614 include 'COMMON.INTERACT'
1615 include 'COMMON.IOUNITS'
1616 include 'COMMON.CALC'
1617 common /srutu/ icall
1620 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1623 c if (icall.eq.0) lprn=.true.
1625 do i=iatsc_s,iatsc_e
1626 itypi=iabs(itype(i))
1627 if (itypi.eq.ntyp1) cycle
1628 itypi1=iabs(itype(i+1))
1632 dxi=dc_norm(1,nres+i)
1633 dyi=dc_norm(2,nres+i)
1634 dzi=dc_norm(3,nres+i)
1635 c dsci_inv=dsc_inv(itypi)
1636 dsci_inv=vbld_inv(i+nres)
1638 C Calculate SC interaction energy.
1640 do iint=1,nint_gr(i)
1641 do j=istart(i,iint),iend(i,iint)
1643 itypj=iabs(itype(j))
1644 if (itypj.eq.ntyp1) cycle
1645 c dscj_inv=dsc_inv(itypj)
1646 dscj_inv=vbld_inv(j+nres)
1647 sig0ij=sigma(itypi,itypj)
1648 r0ij=r0(itypi,itypj)
1649 chi1=chi(itypi,itypj)
1650 chi2=chi(itypj,itypi)
1657 alf12=0.5D0*(alf1+alf2)
1658 C For diagnostics only!!!
1671 dxj=dc_norm(1,nres+j)
1672 dyj=dc_norm(2,nres+j)
1673 dzj=dc_norm(3,nres+j)
1674 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1676 C Calculate angle-dependent terms of energy and contributions to their
1680 sig=sig0ij*dsqrt(sigsq)
1681 rij_shift=1.0D0/rij-sig+r0ij
1682 C I hate to put IF's in the loops, but here don't have another choice!!!!
1683 if (rij_shift.le.0.0D0) then
1688 c---------------------------------------------------------------
1689 rij_shift=1.0D0/rij_shift
1690 fac=rij_shift**expon
1691 e1=fac*fac*aa(itypi,itypj)
1692 e2=fac*bb(itypi,itypj)
1693 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1694 eps2der=evdwij*eps3rt
1695 eps3der=evdwij*eps2rt
1696 fac_augm=rrij**expon
1697 e_augm=augm(itypi,itypj)*fac_augm
1698 evdwij=evdwij*eps2rt*eps3rt
1699 evdw=evdw+evdwij+e_augm
1701 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1702 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1703 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1704 & restyp(itypi),i,restyp(itypj),j,
1705 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1706 & chi1,chi2,chip1,chip2,
1707 & eps1,eps2rt**2,eps3rt**2,
1708 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1711 C Calculate gradient components.
1712 e1=e1*eps1*eps2rt**2*eps3rt**2
1713 fac=-expon*(e1+evdwij)*rij_shift
1715 fac=rij*fac-2*expon*rrij*e_augm
1716 C Calculate the radial part of the gradient
1720 C Calculate angular part of the gradient.
1726 C-----------------------------------------------------------------------------
1727 subroutine sc_angular
1728 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1729 C om12. Called by ebp, egb, and egbv.
1731 include 'COMMON.CALC'
1732 include 'COMMON.IOUNITS'
1736 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1737 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1738 om12=dxi*dxj+dyi*dyj+dzi*dzj
1740 C Calculate eps1(om12) and its derivative in om12
1741 faceps1=1.0D0-om12*chiom12
1742 faceps1_inv=1.0D0/faceps1
1743 eps1=dsqrt(faceps1_inv)
1744 C Following variable is eps1*deps1/dom12
1745 eps1_om12=faceps1_inv*chiom12
1750 c write (iout,*) "om12",om12," eps1",eps1
1751 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1756 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1757 sigsq=1.0D0-facsig*faceps1_inv
1758 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1759 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1760 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1766 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1767 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1769 C Calculate eps2 and its derivatives in om1, om2, and om12.
1772 chipom12=chip12*om12
1773 facp=1.0D0-om12*chipom12
1775 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1776 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1777 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1778 C Following variable is the square root of eps2
1779 eps2rt=1.0D0-facp1*facp_inv
1780 C Following three variables are the derivatives of the square root of eps
1781 C in om1, om2, and om12.
1782 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1783 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1784 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1785 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1786 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1787 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1788 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1789 c & " eps2rt_om12",eps2rt_om12
1790 C Calculate whole angle-dependent part of epsilon and contributions
1791 C to its derivatives
1794 C----------------------------------------------------------------------------
1796 implicit real*8 (a-h,o-z)
1797 include 'DIMENSIONS'
1798 include 'COMMON.CHAIN'
1799 include 'COMMON.DERIV'
1800 include 'COMMON.CALC'
1801 include 'COMMON.IOUNITS'
1802 double precision dcosom1(3),dcosom2(3)
1803 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1804 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1805 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1806 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1810 c eom12=evdwij*eps1_om12
1812 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1813 c & " sigder",sigder
1814 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1815 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1817 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1818 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1821 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1823 c write (iout,*) "gg",(gg(k),k=1,3)
1825 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1826 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1827 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1828 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1829 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1830 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1831 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1832 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1833 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1834 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1837 C Calculate the components of the gradient in DC and X
1841 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1845 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1846 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1850 C-----------------------------------------------------------------------
1851 subroutine e_softsphere(evdw)
1853 C This subroutine calculates the interaction energy of nonbonded side chains
1854 C assuming the LJ potential of interaction.
1856 implicit real*8 (a-h,o-z)
1857 include 'DIMENSIONS'
1858 parameter (accur=1.0d-10)
1859 include 'COMMON.GEO'
1860 include 'COMMON.VAR'
1861 include 'COMMON.LOCAL'
1862 include 'COMMON.CHAIN'
1863 include 'COMMON.DERIV'
1864 include 'COMMON.INTERACT'
1865 include 'COMMON.TORSION'
1866 include 'COMMON.SBRIDGE'
1867 include 'COMMON.NAMES'
1868 include 'COMMON.IOUNITS'
1869 include 'COMMON.CONTACTS'
1871 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1873 do i=iatsc_s,iatsc_e
1874 itypi=iabs(itype(i))
1875 if (itypi.eq.ntyp1) cycle
1876 itypi1=iabs(itype(i+1))
1881 C Calculate SC interaction energy.
1883 do iint=1,nint_gr(i)
1884 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1885 cd & 'iend=',iend(i,iint)
1886 do j=istart(i,iint),iend(i,iint)
1887 itypj=iabs(itype(j))
1888 if (itypj.eq.ntyp1) cycle
1892 rij=xj*xj+yj*yj+zj*zj
1893 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1894 r0ij=r0(itypi,itypj)
1896 c print *,i,j,r0ij,dsqrt(rij)
1897 if (rij.lt.r0ijsq) then
1898 evdwij=0.25d0*(rij-r0ijsq)**2
1906 C Calculate the components of the gradient in DC and X
1912 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1913 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1914 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1915 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1919 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1927 C--------------------------------------------------------------------------
1928 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1931 C Soft-sphere potential of p-p interaction
1933 implicit real*8 (a-h,o-z)
1934 include 'DIMENSIONS'
1935 include 'COMMON.CONTROL'
1936 include 'COMMON.IOUNITS'
1937 include 'COMMON.GEO'
1938 include 'COMMON.VAR'
1939 include 'COMMON.LOCAL'
1940 include 'COMMON.CHAIN'
1941 include 'COMMON.DERIV'
1942 include 'COMMON.INTERACT'
1943 include 'COMMON.CONTACTS'
1944 include 'COMMON.TORSION'
1945 include 'COMMON.VECTORS'
1946 include 'COMMON.FFIELD'
1948 cd write(iout,*) 'In EELEC_soft_sphere'
1955 do i=iatel_s,iatel_e
1956 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1960 xmedi=c(1,i)+0.5d0*dxi
1961 ymedi=c(2,i)+0.5d0*dyi
1962 zmedi=c(3,i)+0.5d0*dzi
1964 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1965 do j=ielstart(i),ielend(i)
1966 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1970 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1971 r0ij=rpp(iteli,itelj)
1976 xj=c(1,j)+0.5D0*dxj-xmedi
1977 yj=c(2,j)+0.5D0*dyj-ymedi
1978 zj=c(3,j)+0.5D0*dzj-zmedi
1979 rij=xj*xj+yj*yj+zj*zj
1980 if (rij.lt.r0ijsq) then
1981 evdw1ij=0.25d0*(rij-r0ijsq)**2
1989 C Calculate contributions to the Cartesian gradient.
1995 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1996 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1999 * Loop over residues i+1 thru j-1.
2003 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2008 cgrad do i=nnt,nct-1
2010 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2012 cgrad do j=i+1,nct-1
2014 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2020 c------------------------------------------------------------------------------
2021 subroutine vec_and_deriv
2022 implicit real*8 (a-h,o-z)
2023 include 'DIMENSIONS'
2027 include 'COMMON.IOUNITS'
2028 include 'COMMON.GEO'
2029 include 'COMMON.VAR'
2030 include 'COMMON.LOCAL'
2031 include 'COMMON.CHAIN'
2032 include 'COMMON.VECTORS'
2033 include 'COMMON.SETUP'
2034 include 'COMMON.TIME1'
2035 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2036 C Compute the local reference systems. For reference system (i), the
2037 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2038 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2040 do i=ivec_start,ivec_end
2044 if (i.eq.nres-1) then
2045 C Case of the last full residue
2046 C Compute the Z-axis
2047 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2048 costh=dcos(pi-theta(nres))
2049 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2053 C Compute the derivatives of uz
2055 uzder(2,1,1)=-dc_norm(3,i-1)
2056 uzder(3,1,1)= dc_norm(2,i-1)
2057 uzder(1,2,1)= dc_norm(3,i-1)
2059 uzder(3,2,1)=-dc_norm(1,i-1)
2060 uzder(1,3,1)=-dc_norm(2,i-1)
2061 uzder(2,3,1)= dc_norm(1,i-1)
2064 uzder(2,1,2)= dc_norm(3,i)
2065 uzder(3,1,2)=-dc_norm(2,i)
2066 uzder(1,2,2)=-dc_norm(3,i)
2068 uzder(3,2,2)= dc_norm(1,i)
2069 uzder(1,3,2)= dc_norm(2,i)
2070 uzder(2,3,2)=-dc_norm(1,i)
2072 C Compute the Y-axis
2075 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2077 C Compute the derivatives of uy
2080 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2081 & -dc_norm(k,i)*dc_norm(j,i-1)
2082 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2084 uyder(j,j,1)=uyder(j,j,1)-costh
2085 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2090 uygrad(l,k,j,i)=uyder(l,k,j)
2091 uzgrad(l,k,j,i)=uzder(l,k,j)
2095 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2096 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2097 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2098 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2101 C Compute the Z-axis
2102 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2103 costh=dcos(pi-theta(i+2))
2104 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2108 C Compute the derivatives of uz
2110 uzder(2,1,1)=-dc_norm(3,i+1)
2111 uzder(3,1,1)= dc_norm(2,i+1)
2112 uzder(1,2,1)= dc_norm(3,i+1)
2114 uzder(3,2,1)=-dc_norm(1,i+1)
2115 uzder(1,3,1)=-dc_norm(2,i+1)
2116 uzder(2,3,1)= dc_norm(1,i+1)
2119 uzder(2,1,2)= dc_norm(3,i)
2120 uzder(3,1,2)=-dc_norm(2,i)
2121 uzder(1,2,2)=-dc_norm(3,i)
2123 uzder(3,2,2)= dc_norm(1,i)
2124 uzder(1,3,2)= dc_norm(2,i)
2125 uzder(2,3,2)=-dc_norm(1,i)
2127 C Compute the Y-axis
2130 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2132 C Compute the derivatives of uy
2135 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2136 & -dc_norm(k,i)*dc_norm(j,i+1)
2137 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2139 uyder(j,j,1)=uyder(j,j,1)-costh
2140 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2145 uygrad(l,k,j,i)=uyder(l,k,j)
2146 uzgrad(l,k,j,i)=uzder(l,k,j)
2150 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2151 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2152 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2153 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2157 vbld_inv_temp(1)=vbld_inv(i+1)
2158 if (i.lt.nres-1) then
2159 vbld_inv_temp(2)=vbld_inv(i+2)
2161 vbld_inv_temp(2)=vbld_inv(i)
2166 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2167 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2172 #if defined(PARVEC) && defined(MPI)
2173 if (nfgtasks1.gt.1) then
2175 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2176 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2177 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2178 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2179 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2181 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2182 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2184 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2185 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2186 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2187 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2188 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2189 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2190 time_gather=time_gather+MPI_Wtime()-time00
2192 c if (fg_rank.eq.0) then
2193 c write (iout,*) "Arrays UY and UZ"
2195 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2202 C-----------------------------------------------------------------------------
2203 subroutine check_vecgrad
2204 implicit real*8 (a-h,o-z)
2205 include 'DIMENSIONS'
2206 include 'COMMON.IOUNITS'
2207 include 'COMMON.GEO'
2208 include 'COMMON.VAR'
2209 include 'COMMON.LOCAL'
2210 include 'COMMON.CHAIN'
2211 include 'COMMON.VECTORS'
2212 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2213 dimension uyt(3,maxres),uzt(3,maxres)
2214 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2215 double precision delta /1.0d-7/
2218 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2219 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2220 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2221 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2222 cd & (dc_norm(if90,i),if90=1,3)
2223 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2224 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2225 cd write(iout,'(a)')
2231 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2232 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2245 cd write (iout,*) 'i=',i
2247 erij(k)=dc_norm(k,i)
2251 dc_norm(k,i)=erij(k)
2253 dc_norm(j,i)=dc_norm(j,i)+delta
2254 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2256 c dc_norm(k,i)=dc_norm(k,i)/fac
2258 c write (iout,*) (dc_norm(k,i),k=1,3)
2259 c write (iout,*) (erij(k),k=1,3)
2262 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2263 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2264 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2265 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2267 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2268 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2269 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2272 dc_norm(k,i)=erij(k)
2275 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2276 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2277 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2278 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2279 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2280 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2281 cd write (iout,'(a)')
2286 C--------------------------------------------------------------------------
2287 subroutine set_matrices
2288 implicit real*8 (a-h,o-z)
2289 include 'DIMENSIONS'
2292 include "COMMON.SETUP"
2294 integer status(MPI_STATUS_SIZE)
2296 include 'COMMON.IOUNITS'
2297 include 'COMMON.GEO'
2298 include 'COMMON.VAR'
2299 include 'COMMON.LOCAL'
2300 include 'COMMON.CHAIN'
2301 include 'COMMON.DERIV'
2302 include 'COMMON.INTERACT'
2303 include 'COMMON.CONTACTS'
2304 include 'COMMON.TORSION'
2305 include 'COMMON.VECTORS'
2306 include 'COMMON.FFIELD'
2307 double precision auxvec(2),auxmat(2,2)
2309 C Compute the virtual-bond-torsional-angle dependent quantities needed
2310 C to calculate the el-loc multibody terms of various order.
2313 do i=ivec_start+2,ivec_end+2
2317 if (i .lt. nres+1) then
2354 if (i .gt. 3 .and. i .lt. nres+1) then
2355 obrot_der(1,i-2)=-sin1
2356 obrot_der(2,i-2)= cos1
2357 Ugder(1,1,i-2)= sin1
2358 Ugder(1,2,i-2)=-cos1
2359 Ugder(2,1,i-2)=-cos1
2360 Ugder(2,2,i-2)=-sin1
2363 obrot2_der(1,i-2)=-dwasin2
2364 obrot2_der(2,i-2)= dwacos2
2365 Ug2der(1,1,i-2)= dwasin2
2366 Ug2der(1,2,i-2)=-dwacos2
2367 Ug2der(2,1,i-2)=-dwacos2
2368 Ug2der(2,2,i-2)=-dwasin2
2370 obrot_der(1,i-2)=0.0d0
2371 obrot_der(2,i-2)=0.0d0
2372 Ugder(1,1,i-2)=0.0d0
2373 Ugder(1,2,i-2)=0.0d0
2374 Ugder(2,1,i-2)=0.0d0
2375 Ugder(2,2,i-2)=0.0d0
2376 obrot2_der(1,i-2)=0.0d0
2377 obrot2_der(2,i-2)=0.0d0
2378 Ug2der(1,1,i-2)=0.0d0
2379 Ug2der(1,2,i-2)=0.0d0
2380 Ug2der(2,1,i-2)=0.0d0
2381 Ug2der(2,2,i-2)=0.0d0
2383 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2384 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2385 iti = itortyp(itype(i-2))
2389 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2390 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2391 iti1 = itortyp(itype(i-1))
2395 cd write (iout,*) '*******i',i,' iti1',iti
2396 cd write (iout,*) 'b1',b1(:,iti)
2397 cd write (iout,*) 'b2',b2(:,iti)
2398 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2399 c if (i .gt. iatel_s+2) then
2400 if (i .gt. nnt+2) then
2401 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2402 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2403 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2405 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2406 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2407 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2408 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2409 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2420 DtUg2(l,k,i-2)=0.0d0
2424 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2425 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2427 muder(k,i-2)=Ub2der(k,i-2)
2429 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2430 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2431 if (itype(i-1).le.ntyp) then
2432 iti1 = itortyp(itype(i-1))
2440 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2442 cd write (iout,*) 'mu ',mu(:,i-2)
2443 cd write (iout,*) 'mu1',mu1(:,i-2)
2444 cd write (iout,*) 'mu2',mu2(:,i-2)
2445 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2447 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2448 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2449 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2450 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2451 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2452 C Vectors and matrices dependent on a single virtual-bond dihedral.
2453 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2454 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2455 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2456 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2457 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2458 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2459 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2460 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2461 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2464 C Matrices dependent on two consecutive virtual-bond dihedrals.
2465 C The order of matrices is from left to right.
2466 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2468 c do i=max0(ivec_start,2),ivec_end
2470 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2471 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2472 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2473 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2474 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2475 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2476 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2477 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2480 #if defined(MPI) && defined(PARMAT)
2482 c if (fg_rank.eq.0) then
2483 write (iout,*) "Arrays UG and UGDER before GATHER"
2485 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2486 & ((ug(l,k,i),l=1,2),k=1,2),
2487 & ((ugder(l,k,i),l=1,2),k=1,2)
2489 write (iout,*) "Arrays UG2 and UG2DER"
2491 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2492 & ((ug2(l,k,i),l=1,2),k=1,2),
2493 & ((ug2der(l,k,i),l=1,2),k=1,2)
2495 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2497 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2498 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2499 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2501 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2503 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2504 & costab(i),sintab(i),costab2(i),sintab2(i)
2506 write (iout,*) "Array MUDER"
2508 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2512 if (nfgtasks.gt.1) then
2514 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2515 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2516 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2518 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2519 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2521 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2522 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2524 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2525 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2527 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2528 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2530 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2531 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2533 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2534 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2536 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2537 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2538 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2539 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2540 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2541 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2542 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2543 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2544 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2545 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2546 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2547 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2548 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2550 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2551 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2553 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2554 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2556 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2557 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2559 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2560 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2562 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2563 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2565 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2566 & ivec_count(fg_rank1),
2567 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2569 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2570 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2572 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2573 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2575 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2576 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2578 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2579 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2581 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2582 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2584 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2585 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2587 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2588 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2590 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2591 & ivec_count(fg_rank1),
2592 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2594 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2595 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2597 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2598 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2600 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2601 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2603 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2604 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2606 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2607 & ivec_count(fg_rank1),
2608 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2610 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2611 & ivec_count(fg_rank1),
2612 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2614 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2615 & ivec_count(fg_rank1),
2616 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2617 & MPI_MAT2,FG_COMM1,IERR)
2618 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2619 & ivec_count(fg_rank1),
2620 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2621 & MPI_MAT2,FG_COMM1,IERR)
2624 c Passes matrix info through the ring
2627 if (irecv.lt.0) irecv=nfgtasks1-1
2630 if (inext.ge.nfgtasks1) inext=0
2632 c write (iout,*) "isend",isend," irecv",irecv
2634 lensend=lentyp(isend)
2635 lenrecv=lentyp(irecv)
2636 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2637 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2638 c & MPI_ROTAT1(lensend),inext,2200+isend,
2639 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2640 c & iprev,2200+irecv,FG_COMM,status,IERR)
2641 c write (iout,*) "Gather ROTAT1"
2643 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2644 c & MPI_ROTAT2(lensend),inext,3300+isend,
2645 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2646 c & iprev,3300+irecv,FG_COMM,status,IERR)
2647 c write (iout,*) "Gather ROTAT2"
2649 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2650 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2651 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2652 & iprev,4400+irecv,FG_COMM,status,IERR)
2653 c write (iout,*) "Gather ROTAT_OLD"
2655 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2656 & MPI_PRECOMP11(lensend),inext,5500+isend,
2657 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2658 & iprev,5500+irecv,FG_COMM,status,IERR)
2659 c write (iout,*) "Gather PRECOMP11"
2661 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2662 & MPI_PRECOMP12(lensend),inext,6600+isend,
2663 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2664 & iprev,6600+irecv,FG_COMM,status,IERR)
2665 c write (iout,*) "Gather PRECOMP12"
2667 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2669 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2670 & MPI_ROTAT2(lensend),inext,7700+isend,
2671 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2672 & iprev,7700+irecv,FG_COMM,status,IERR)
2673 c write (iout,*) "Gather PRECOMP21"
2675 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2676 & MPI_PRECOMP22(lensend),inext,8800+isend,
2677 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2678 & iprev,8800+irecv,FG_COMM,status,IERR)
2679 c write (iout,*) "Gather PRECOMP22"
2681 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2682 & MPI_PRECOMP23(lensend),inext,9900+isend,
2683 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2684 & MPI_PRECOMP23(lenrecv),
2685 & iprev,9900+irecv,FG_COMM,status,IERR)
2686 c write (iout,*) "Gather PRECOMP23"
2691 if (irecv.lt.0) irecv=nfgtasks1-1
2694 time_gather=time_gather+MPI_Wtime()-time00
2697 c if (fg_rank.eq.0) then
2698 write (iout,*) "Arrays UG and UGDER"
2700 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2701 & ((ug(l,k,i),l=1,2),k=1,2),
2702 & ((ugder(l,k,i),l=1,2),k=1,2)
2704 write (iout,*) "Arrays UG2 and UG2DER"
2706 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2707 & ((ug2(l,k,i),l=1,2),k=1,2),
2708 & ((ug2der(l,k,i),l=1,2),k=1,2)
2710 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2712 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2713 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2714 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2716 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2718 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2719 & costab(i),sintab(i),costab2(i),sintab2(i)
2721 write (iout,*) "Array MUDER"
2723 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2729 cd iti = itortyp(itype(i))
2732 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2733 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2738 C--------------------------------------------------------------------------
2739 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2741 C This subroutine calculates the average interaction energy and its gradient
2742 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2743 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2744 C The potential depends both on the distance of peptide-group centers and on
2745 C the orientation of the CA-CA virtual bonds.
2747 implicit real*8 (a-h,o-z)
2751 include 'DIMENSIONS'
2752 include 'COMMON.CONTROL'
2753 include 'COMMON.SETUP'
2754 include 'COMMON.IOUNITS'
2755 include 'COMMON.GEO'
2756 include 'COMMON.VAR'
2757 include 'COMMON.LOCAL'
2758 include 'COMMON.CHAIN'
2759 include 'COMMON.DERIV'
2760 include 'COMMON.INTERACT'
2761 include 'COMMON.CONTACTS'
2762 include 'COMMON.TORSION'
2763 include 'COMMON.VECTORS'
2764 include 'COMMON.FFIELD'
2765 include 'COMMON.TIME1'
2766 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2767 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2768 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2769 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2770 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2771 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2773 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2775 double precision scal_el /1.0d0/
2777 double precision scal_el /0.5d0/
2780 C 13-go grudnia roku pamietnego...
2781 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2782 & 0.0d0,1.0d0,0.0d0,
2783 & 0.0d0,0.0d0,1.0d0/
2784 cd write(iout,*) 'In EELEC'
2786 cd write(iout,*) 'Type',i
2787 cd write(iout,*) 'B1',B1(:,i)
2788 cd write(iout,*) 'B2',B2(:,i)
2789 cd write(iout,*) 'CC',CC(:,:,i)
2790 cd write(iout,*) 'DD',DD(:,:,i)
2791 cd write(iout,*) 'EE',EE(:,:,i)
2793 cd call check_vecgrad
2795 if (icheckgrad.eq.1) then
2797 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2799 dc_norm(k,i)=dc(k,i)*fac
2801 c write (iout,*) 'i',i,' fac',fac
2804 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2805 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2806 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2807 c call vec_and_deriv
2813 time_mat=time_mat+MPI_Wtime()-time01
2817 cd write (iout,*) 'i=',i
2819 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2822 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2823 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2836 cd print '(a)','Enter EELEC'
2837 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2839 gel_loc_loc(i)=0.0d0
2844 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2846 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2848 do i=iturn3_start,iturn3_end
2849 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2850 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2854 dx_normi=dc_norm(1,i)
2855 dy_normi=dc_norm(2,i)
2856 dz_normi=dc_norm(3,i)
2857 xmedi=c(1,i)+0.5d0*dxi
2858 ymedi=c(2,i)+0.5d0*dyi
2859 zmedi=c(3,i)+0.5d0*dzi
2861 call eelecij(i,i+2,ees,evdw1,eel_loc)
2862 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2863 num_cont_hb(i)=num_conti
2865 do i=iturn4_start,iturn4_end
2866 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2867 & .or. itype(i+3).eq.ntyp1
2868 & .or. itype(i+4).eq.ntyp1) cycle
2872 dx_normi=dc_norm(1,i)
2873 dy_normi=dc_norm(2,i)
2874 dz_normi=dc_norm(3,i)
2875 xmedi=c(1,i)+0.5d0*dxi
2876 ymedi=c(2,i)+0.5d0*dyi
2877 zmedi=c(3,i)+0.5d0*dzi
2878 num_conti=num_cont_hb(i)
2879 call eelecij(i,i+3,ees,evdw1,eel_loc)
2880 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2881 & call eturn4(i,eello_turn4)
2882 num_cont_hb(i)=num_conti
2885 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2887 do i=iatel_s,iatel_e
2888 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2892 dx_normi=dc_norm(1,i)
2893 dy_normi=dc_norm(2,i)
2894 dz_normi=dc_norm(3,i)
2895 xmedi=c(1,i)+0.5d0*dxi
2896 ymedi=c(2,i)+0.5d0*dyi
2897 zmedi=c(3,i)+0.5d0*dzi
2898 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2899 num_conti=num_cont_hb(i)
2900 do j=ielstart(i),ielend(i)
2901 c write (iout,*) i,j,itype(i),itype(j)
2902 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2903 call eelecij(i,j,ees,evdw1,eel_loc)
2905 num_cont_hb(i)=num_conti
2907 c write (iout,*) "Number of loop steps in EELEC:",ind
2909 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2910 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2912 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2913 ccc eel_loc=eel_loc+eello_turn3
2914 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2917 C-------------------------------------------------------------------------------
2918 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2919 implicit real*8 (a-h,o-z)
2920 include 'DIMENSIONS'
2924 include 'COMMON.CONTROL'
2925 include 'COMMON.IOUNITS'
2926 include 'COMMON.GEO'
2927 include 'COMMON.VAR'
2928 include 'COMMON.LOCAL'
2929 include 'COMMON.CHAIN'
2930 include 'COMMON.DERIV'
2931 include 'COMMON.INTERACT'
2932 include 'COMMON.CONTACTS'
2933 include 'COMMON.TORSION'
2934 include 'COMMON.VECTORS'
2935 include 'COMMON.FFIELD'
2936 include 'COMMON.TIME1'
2937 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2938 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2939 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2940 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2941 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2942 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2944 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2946 double precision scal_el /1.0d0/
2948 double precision scal_el /0.5d0/
2951 C 13-go grudnia roku pamietnego...
2952 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2953 & 0.0d0,1.0d0,0.0d0,
2954 & 0.0d0,0.0d0,1.0d0/
2955 c time00=MPI_Wtime()
2956 cd write (iout,*) "eelecij",i,j
2960 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2961 aaa=app(iteli,itelj)
2962 bbb=bpp(iteli,itelj)
2963 ael6i=ael6(iteli,itelj)
2964 ael3i=ael3(iteli,itelj)
2968 dx_normj=dc_norm(1,j)
2969 dy_normj=dc_norm(2,j)
2970 dz_normj=dc_norm(3,j)
2971 xj=c(1,j)+0.5D0*dxj-xmedi
2972 yj=c(2,j)+0.5D0*dyj-ymedi
2973 zj=c(3,j)+0.5D0*dzj-zmedi
2974 rij=xj*xj+yj*yj+zj*zj
2980 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2981 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2982 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2983 fac=cosa-3.0D0*cosb*cosg
2985 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2986 if (j.eq.i+2) ev1=scal_el*ev1
2991 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2994 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2995 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2998 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2999 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3000 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3001 cd & xmedi,ymedi,zmedi,xj,yj,zj
3003 if (energy_dec) then
3004 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3006 &,iteli,itelj,aaa,evdw1
3007 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3011 C Calculate contributions to the Cartesian gradient.
3014 facvdw=-6*rrmij*(ev1+evdwij)
3015 facel=-3*rrmij*(el1+eesij)
3021 * Radial derivatives. First process both termini of the fragment (i,j)
3027 c ghalf=0.5D0*ggg(k)
3028 c gelc(k,i)=gelc(k,i)+ghalf
3029 c gelc(k,j)=gelc(k,j)+ghalf
3031 c 9/28/08 AL Gradient compotents will be summed only at the end
3033 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3034 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3037 * Loop over residues i+1 thru j-1.
3041 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3048 c ghalf=0.5D0*ggg(k)
3049 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3050 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3052 c 9/28/08 AL Gradient compotents will be summed only at the end
3054 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3055 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3058 * Loop over residues i+1 thru j-1.
3062 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3069 fac=-3*rrmij*(facvdw+facvdw+facel)
3074 * Radial derivatives. First process both termini of the fragment (i,j)
3080 c ghalf=0.5D0*ggg(k)
3081 c gelc(k,i)=gelc(k,i)+ghalf
3082 c gelc(k,j)=gelc(k,j)+ghalf
3084 c 9/28/08 AL Gradient compotents will be summed only at the end
3086 gelc_long(k,j)=gelc(k,j)+ggg(k)
3087 gelc_long(k,i)=gelc(k,i)-ggg(k)
3090 * Loop over residues i+1 thru j-1.
3094 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3097 c 9/28/08 AL Gradient compotents will be summed only at the end
3102 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3103 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3109 ecosa=2.0D0*fac3*fac1+fac4
3112 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3113 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3115 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3116 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3118 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3119 cd & (dcosg(k),k=1,3)
3121 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3124 c ghalf=0.5D0*ggg(k)
3125 c gelc(k,i)=gelc(k,i)+ghalf
3126 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3127 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3128 c gelc(k,j)=gelc(k,j)+ghalf
3129 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3130 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3134 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3139 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3140 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3142 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3143 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3144 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3145 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3147 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3148 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3149 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3151 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3152 C energy of a peptide unit is assumed in the form of a second-order
3153 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3154 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3155 C are computed for EVERY pair of non-contiguous peptide groups.
3157 if (j.lt.nres-1) then
3168 muij(kkk)=mu(k,i)*mu(l,j)
3171 cd write (iout,*) 'EELEC: i',i,' j',j
3172 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3173 cd write(iout,*) 'muij',muij
3174 ury=scalar(uy(1,i),erij)
3175 urz=scalar(uz(1,i),erij)
3176 vry=scalar(uy(1,j),erij)
3177 vrz=scalar(uz(1,j),erij)
3178 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3179 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3180 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3181 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3182 fac=dsqrt(-ael6i)*r3ij
3187 cd write (iout,'(4i5,4f10.5)')
3188 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3189 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3190 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3191 cd & uy(:,j),uz(:,j)
3192 cd write (iout,'(4f10.5)')
3193 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3194 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3195 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3196 cd write (iout,'(9f10.5/)')
3197 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3198 C Derivatives of the elements of A in virtual-bond vectors
3199 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3201 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3202 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3203 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3204 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3205 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3206 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3207 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3208 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3209 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3210 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3211 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3212 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3214 C Compute radial contributions to the gradient
3232 C Add the contributions coming from er
3235 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3236 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3237 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3238 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3241 C Derivatives in DC(i)
3242 cgrad ghalf1=0.5d0*agg(k,1)
3243 cgrad ghalf2=0.5d0*agg(k,2)
3244 cgrad ghalf3=0.5d0*agg(k,3)
3245 cgrad ghalf4=0.5d0*agg(k,4)
3246 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3247 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3248 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3249 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3250 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3251 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3252 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3253 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3254 C Derivatives in DC(i+1)
3255 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3256 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3257 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3258 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3259 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3260 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3261 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3262 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3263 C Derivatives in DC(j)
3264 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3265 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3266 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3267 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3268 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3269 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3270 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3271 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3272 C Derivatives in DC(j+1) or DC(nres-1)
3273 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3274 & -3.0d0*vryg(k,3)*ury)
3275 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3276 & -3.0d0*vrzg(k,3)*ury)
3277 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3278 & -3.0d0*vryg(k,3)*urz)
3279 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3280 & -3.0d0*vrzg(k,3)*urz)
3281 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3283 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3296 aggi(k,l)=-aggi(k,l)
3297 aggi1(k,l)=-aggi1(k,l)
3298 aggj(k,l)=-aggj(k,l)
3299 aggj1(k,l)=-aggj1(k,l)
3302 if (j.lt.nres-1) then
3308 aggi(k,l)=-aggi(k,l)
3309 aggi1(k,l)=-aggi1(k,l)
3310 aggj(k,l)=-aggj(k,l)
3311 aggj1(k,l)=-aggj1(k,l)
3322 aggi(k,l)=-aggi(k,l)
3323 aggi1(k,l)=-aggi1(k,l)
3324 aggj(k,l)=-aggj(k,l)
3325 aggj1(k,l)=-aggj1(k,l)
3330 IF (wel_loc.gt.0.0d0) THEN
3331 C Contribution to the local-electrostatic energy coming from the i-j pair
3332 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3334 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3336 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3337 & 'eelloc',i,j,eel_loc_ij
3338 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3340 eel_loc=eel_loc+eel_loc_ij
3341 C Partial derivatives in virtual-bond dihedral angles gamma
3343 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3344 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3345 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3346 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3347 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3348 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3349 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3351 ggg(l)=agg(l,1)*muij(1)+
3352 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3353 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3354 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3355 cgrad ghalf=0.5d0*ggg(l)
3356 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3357 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3361 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3364 C Remaining derivatives of eello
3366 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3367 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3368 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3369 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3370 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3371 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3372 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3373 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3376 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3377 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3378 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3379 & .and. num_conti.le.maxconts) then
3380 c write (iout,*) i,j," entered corr"
3382 C Calculate the contact function. The ith column of the array JCONT will
3383 C contain the numbers of atoms that make contacts with the atom I (of numbers
3384 C greater than I). The arrays FACONT and GACONT will contain the values of
3385 C the contact function and its derivative.
3386 c r0ij=1.02D0*rpp(iteli,itelj)
3387 c r0ij=1.11D0*rpp(iteli,itelj)
3388 r0ij=2.20D0*rpp(iteli,itelj)
3389 c r0ij=1.55D0*rpp(iteli,itelj)
3390 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3391 if (fcont.gt.0.0D0) then
3392 num_conti=num_conti+1
3393 if (num_conti.gt.maxconts) then
3394 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3395 & ' will skip next contacts for this conf.'
3397 jcont_hb(num_conti,i)=j
3398 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3399 cd & " jcont_hb",jcont_hb(num_conti,i)
3400 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3401 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3402 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3404 d_cont(num_conti,i)=rij
3405 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3406 C --- Electrostatic-interaction matrix ---
3407 a_chuj(1,1,num_conti,i)=a22
3408 a_chuj(1,2,num_conti,i)=a23
3409 a_chuj(2,1,num_conti,i)=a32
3410 a_chuj(2,2,num_conti,i)=a33
3411 C --- Gradient of rij
3413 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3420 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3421 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3422 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3423 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3424 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3429 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3430 C Calculate contact energies
3432 wij=cosa-3.0D0*cosb*cosg
3435 c fac3=dsqrt(-ael6i)/r0ij**3
3436 fac3=dsqrt(-ael6i)*r3ij
3437 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3438 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3439 if (ees0tmp.gt.0) then
3440 ees0pij=dsqrt(ees0tmp)
3444 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3445 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3446 if (ees0tmp.gt.0) then
3447 ees0mij=dsqrt(ees0tmp)
3452 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3453 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3454 C Diagnostics. Comment out or remove after debugging!
3455 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3456 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3457 c ees0m(num_conti,i)=0.0D0
3459 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3460 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3461 C Angular derivatives of the contact function
3462 ees0pij1=fac3/ees0pij
3463 ees0mij1=fac3/ees0mij
3464 fac3p=-3.0D0*fac3*rrmij
3465 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3466 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3468 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3469 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3470 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3471 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3472 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3473 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3474 ecosap=ecosa1+ecosa2
3475 ecosbp=ecosb1+ecosb2
3476 ecosgp=ecosg1+ecosg2
3477 ecosam=ecosa1-ecosa2
3478 ecosbm=ecosb1-ecosb2
3479 ecosgm=ecosg1-ecosg2
3488 facont_hb(num_conti,i)=fcont
3489 fprimcont=fprimcont/rij
3490 cd facont_hb(num_conti,i)=1.0D0
3491 C Following line is for diagnostics.
3494 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3495 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3498 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3499 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3501 gggp(1)=gggp(1)+ees0pijp*xj
3502 gggp(2)=gggp(2)+ees0pijp*yj
3503 gggp(3)=gggp(3)+ees0pijp*zj
3504 gggm(1)=gggm(1)+ees0mijp*xj
3505 gggm(2)=gggm(2)+ees0mijp*yj
3506 gggm(3)=gggm(3)+ees0mijp*zj
3507 C Derivatives due to the contact function
3508 gacont_hbr(1,num_conti,i)=fprimcont*xj
3509 gacont_hbr(2,num_conti,i)=fprimcont*yj
3510 gacont_hbr(3,num_conti,i)=fprimcont*zj
3513 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3514 c following the change of gradient-summation algorithm.
3516 cgrad ghalfp=0.5D0*gggp(k)
3517 cgrad ghalfm=0.5D0*gggm(k)
3518 gacontp_hb1(k,num_conti,i)=!ghalfp
3519 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3520 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3521 gacontp_hb2(k,num_conti,i)=!ghalfp
3522 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3523 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3524 gacontp_hb3(k,num_conti,i)=gggp(k)
3525 gacontm_hb1(k,num_conti,i)=!ghalfm
3526 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3527 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3528 gacontm_hb2(k,num_conti,i)=!ghalfm
3529 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3530 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3531 gacontm_hb3(k,num_conti,i)=gggm(k)
3533 C Diagnostics. Comment out or remove after debugging!
3535 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3536 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3537 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3538 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3539 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3540 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3543 endif ! num_conti.le.maxconts
3546 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3549 ghalf=0.5d0*agg(l,k)
3550 aggi(l,k)=aggi(l,k)+ghalf
3551 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3552 aggj(l,k)=aggj(l,k)+ghalf
3555 if (j.eq.nres-1 .and. i.lt.j-2) then
3558 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3563 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3566 C-----------------------------------------------------------------------------
3567 subroutine eturn3(i,eello_turn3)
3568 C Third- and fourth-order contributions from turns
3569 implicit real*8 (a-h,o-z)
3570 include 'DIMENSIONS'
3571 include 'COMMON.IOUNITS'
3572 include 'COMMON.GEO'
3573 include 'COMMON.VAR'
3574 include 'COMMON.LOCAL'
3575 include 'COMMON.CHAIN'
3576 include 'COMMON.DERIV'
3577 include 'COMMON.INTERACT'
3578 include 'COMMON.CONTACTS'
3579 include 'COMMON.TORSION'
3580 include 'COMMON.VECTORS'
3581 include 'COMMON.FFIELD'
3582 include 'COMMON.CONTROL'
3584 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3585 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3586 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3587 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3588 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3589 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3590 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3593 c write (iout,*) "eturn3",i,j,j1,j2
3598 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3600 C Third-order contributions
3607 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3608 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3609 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3610 call transpose2(auxmat(1,1),auxmat1(1,1))
3611 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3612 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3613 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3614 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3615 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3616 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3617 cd & ' eello_turn3_num',4*eello_turn3_num
3618 C Derivatives in gamma(i)
3619 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3620 call transpose2(auxmat2(1,1),auxmat3(1,1))
3621 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3622 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3623 C Derivatives in gamma(i+1)
3624 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3625 call transpose2(auxmat2(1,1),auxmat3(1,1))
3626 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3627 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3628 & +0.5d0*(pizda(1,1)+pizda(2,2))
3629 C Cartesian derivatives
3631 c ghalf1=0.5d0*agg(l,1)
3632 c ghalf2=0.5d0*agg(l,2)
3633 c ghalf3=0.5d0*agg(l,3)
3634 c ghalf4=0.5d0*agg(l,4)
3635 a_temp(1,1)=aggi(l,1)!+ghalf1
3636 a_temp(1,2)=aggi(l,2)!+ghalf2
3637 a_temp(2,1)=aggi(l,3)!+ghalf3
3638 a_temp(2,2)=aggi(l,4)!+ghalf4
3639 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3640 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3641 & +0.5d0*(pizda(1,1)+pizda(2,2))
3642 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3643 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3644 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3645 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3646 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3647 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3648 & +0.5d0*(pizda(1,1)+pizda(2,2))
3649 a_temp(1,1)=aggj(l,1)!+ghalf1
3650 a_temp(1,2)=aggj(l,2)!+ghalf2
3651 a_temp(2,1)=aggj(l,3)!+ghalf3
3652 a_temp(2,2)=aggj(l,4)!+ghalf4
3653 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3654 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3655 & +0.5d0*(pizda(1,1)+pizda(2,2))
3656 a_temp(1,1)=aggj1(l,1)
3657 a_temp(1,2)=aggj1(l,2)
3658 a_temp(2,1)=aggj1(l,3)
3659 a_temp(2,2)=aggj1(l,4)
3660 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3661 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3662 & +0.5d0*(pizda(1,1)+pizda(2,2))
3666 C-------------------------------------------------------------------------------
3667 subroutine eturn4(i,eello_turn4)
3668 C Third- and fourth-order contributions from turns
3669 implicit real*8 (a-h,o-z)
3670 include 'DIMENSIONS'
3671 include 'COMMON.IOUNITS'
3672 include 'COMMON.GEO'
3673 include 'COMMON.VAR'
3674 include 'COMMON.LOCAL'
3675 include 'COMMON.CHAIN'
3676 include 'COMMON.DERIV'
3677 include 'COMMON.INTERACT'
3678 include 'COMMON.CONTACTS'
3679 include 'COMMON.TORSION'
3680 include 'COMMON.VECTORS'
3681 include 'COMMON.FFIELD'
3682 include 'COMMON.CONTROL'
3684 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3685 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3686 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3687 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3688 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3689 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3690 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3693 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3695 C Fourth-order contributions
3703 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3704 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3705 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3710 iti1=itortyp(itype(i+1))
3711 iti2=itortyp(itype(i+2))
3712 iti3=itortyp(itype(i+3))
3713 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3714 call transpose2(EUg(1,1,i+1),e1t(1,1))
3715 call transpose2(Eug(1,1,i+2),e2t(1,1))
3716 call transpose2(Eug(1,1,i+3),e3t(1,1))
3717 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3718 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3719 s1=scalar2(b1(1,iti2),auxvec(1))
3720 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3721 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3722 s2=scalar2(b1(1,iti1),auxvec(1))
3723 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3724 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3725 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3726 eello_turn4=eello_turn4-(s1+s2+s3)
3727 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3728 & 'eturn4',i,j,-(s1+s2+s3)
3729 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3730 cd & ' eello_turn4_num',8*eello_turn4_num
3731 C Derivatives in gamma(i)
3732 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3733 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3734 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3735 s1=scalar2(b1(1,iti2),auxvec(1))
3736 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3737 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3738 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3739 C Derivatives in gamma(i+1)
3740 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3741 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3742 s2=scalar2(b1(1,iti1),auxvec(1))
3743 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3744 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3745 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3746 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3747 C Derivatives in gamma(i+2)
3748 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3749 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3750 s1=scalar2(b1(1,iti2),auxvec(1))
3751 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3752 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3753 s2=scalar2(b1(1,iti1),auxvec(1))
3754 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3755 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3756 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3757 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3758 C Cartesian derivatives
3759 C Derivatives of this turn contributions in DC(i+2)
3760 if (j.lt.nres-1) then
3762 a_temp(1,1)=agg(l,1)
3763 a_temp(1,2)=agg(l,2)
3764 a_temp(2,1)=agg(l,3)
3765 a_temp(2,2)=agg(l,4)
3766 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3767 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3768 s1=scalar2(b1(1,iti2),auxvec(1))
3769 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3770 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3771 s2=scalar2(b1(1,iti1),auxvec(1))
3772 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3773 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3774 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3776 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3779 C Remaining derivatives of this turn contribution
3781 a_temp(1,1)=aggi(l,1)
3782 a_temp(1,2)=aggi(l,2)
3783 a_temp(2,1)=aggi(l,3)
3784 a_temp(2,2)=aggi(l,4)
3785 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3786 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3787 s1=scalar2(b1(1,iti2),auxvec(1))
3788 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3789 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3790 s2=scalar2(b1(1,iti1),auxvec(1))
3791 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3792 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3793 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3794 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3795 a_temp(1,1)=aggi1(l,1)
3796 a_temp(1,2)=aggi1(l,2)
3797 a_temp(2,1)=aggi1(l,3)
3798 a_temp(2,2)=aggi1(l,4)
3799 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3800 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3801 s1=scalar2(b1(1,iti2),auxvec(1))
3802 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3803 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3804 s2=scalar2(b1(1,iti1),auxvec(1))
3805 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3806 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3807 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3808 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3809 a_temp(1,1)=aggj(l,1)
3810 a_temp(1,2)=aggj(l,2)
3811 a_temp(2,1)=aggj(l,3)
3812 a_temp(2,2)=aggj(l,4)
3813 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3814 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3815 s1=scalar2(b1(1,iti2),auxvec(1))
3816 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3817 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3818 s2=scalar2(b1(1,iti1),auxvec(1))
3819 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3820 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3821 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3822 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3823 a_temp(1,1)=aggj1(l,1)
3824 a_temp(1,2)=aggj1(l,2)
3825 a_temp(2,1)=aggj1(l,3)
3826 a_temp(2,2)=aggj1(l,4)
3827 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3828 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3829 s1=scalar2(b1(1,iti2),auxvec(1))
3830 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3831 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3832 s2=scalar2(b1(1,iti1),auxvec(1))
3833 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3834 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3835 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3836 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3837 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3841 C-----------------------------------------------------------------------------
3842 subroutine vecpr(u,v,w)
3843 implicit real*8(a-h,o-z)
3844 dimension u(3),v(3),w(3)
3845 w(1)=u(2)*v(3)-u(3)*v(2)
3846 w(2)=-u(1)*v(3)+u(3)*v(1)
3847 w(3)=u(1)*v(2)-u(2)*v(1)
3850 C-----------------------------------------------------------------------------
3851 subroutine unormderiv(u,ugrad,unorm,ungrad)
3852 C This subroutine computes the derivatives of a normalized vector u, given
3853 C the derivatives computed without normalization conditions, ugrad. Returns
3856 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3857 double precision vec(3)
3858 double precision scalar
3860 c write (2,*) 'ugrad',ugrad
3863 vec(i)=scalar(ugrad(1,i),u(1))
3865 c write (2,*) 'vec',vec
3868 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3871 c write (2,*) 'ungrad',ungrad
3874 C-----------------------------------------------------------------------------
3875 subroutine escp_soft_sphere(evdw2,evdw2_14)
3877 C This subroutine calculates the excluded-volume interaction energy between
3878 C peptide-group centers and side chains and its gradient in virtual-bond and
3879 C side-chain vectors.
3881 implicit real*8 (a-h,o-z)
3882 include 'DIMENSIONS'
3883 include 'COMMON.GEO'
3884 include 'COMMON.VAR'
3885 include 'COMMON.LOCAL'
3886 include 'COMMON.CHAIN'
3887 include 'COMMON.DERIV'
3888 include 'COMMON.INTERACT'
3889 include 'COMMON.FFIELD'
3890 include 'COMMON.IOUNITS'
3891 include 'COMMON.CONTROL'
3896 cd print '(a)','Enter ESCP'
3897 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3898 do i=iatscp_s,iatscp_e
3899 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3901 xi=0.5D0*(c(1,i)+c(1,i+1))
3902 yi=0.5D0*(c(2,i)+c(2,i+1))
3903 zi=0.5D0*(c(3,i)+c(3,i+1))
3905 do iint=1,nscp_gr(i)
3907 do j=iscpstart(i,iint),iscpend(i,iint)
3908 if (itype(j).eq.ntyp1) cycle
3909 itypj=iabs(itype(j))
3910 C Uncomment following three lines for SC-p interactions
3914 C Uncomment following three lines for Ca-p interactions
3918 rij=xj*xj+yj*yj+zj*zj
3921 if (rij.lt.r0ijsq) then
3922 evdwij=0.25d0*(rij-r0ijsq)**2
3930 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3935 cgrad if (j.lt.i) then
3936 cd write (iout,*) 'j<i'
3937 C Uncomment following three lines for SC-p interactions
3939 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3942 cd write (iout,*) 'j>i'
3944 cgrad ggg(k)=-ggg(k)
3945 C Uncomment following line for SC-p interactions
3946 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3950 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3952 cgrad kstart=min0(i+1,j)
3953 cgrad kend=max0(i-1,j-1)
3954 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3955 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3956 cgrad do k=kstart,kend
3958 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3962 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3963 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3971 C-----------------------------------------------------------------------------
3972 subroutine escp(evdw2,evdw2_14)
3974 C This subroutine calculates the excluded-volume interaction energy between
3975 C peptide-group centers and side chains and its gradient in virtual-bond and
3976 C side-chain vectors.
3978 implicit real*8 (a-h,o-z)
3979 include 'DIMENSIONS'
3980 include 'COMMON.GEO'
3981 include 'COMMON.VAR'
3982 include 'COMMON.LOCAL'
3983 include 'COMMON.CHAIN'
3984 include 'COMMON.DERIV'
3985 include 'COMMON.INTERACT'
3986 include 'COMMON.FFIELD'
3987 include 'COMMON.IOUNITS'
3988 include 'COMMON.CONTROL'
3992 cd print '(a)','Enter ESCP'
3993 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3994 do i=iatscp_s,iatscp_e
3995 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3997 xi=0.5D0*(c(1,i)+c(1,i+1))
3998 yi=0.5D0*(c(2,i)+c(2,i+1))
3999 zi=0.5D0*(c(3,i)+c(3,i+1))
4001 do iint=1,nscp_gr(i)
4003 do j=iscpstart(i,iint),iscpend(i,iint)
4004 itypj=iabs(itype(j))
4005 if (itypj.eq.ntyp1) cycle
4006 C Uncomment following three lines for SC-p interactions
4010 C Uncomment following three lines for Ca-p interactions
4014 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4016 e1=fac*fac*aad(itypj,iteli)
4017 e2=fac*bad(itypj,iteli)
4018 if (iabs(j-i) .le. 2) then
4021 evdw2_14=evdw2_14+e1+e2
4025 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4026 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4029 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4031 fac=-(evdwij+e1)*rrij
4035 cgrad if (j.lt.i) then
4036 cd write (iout,*) 'j<i'
4037 C Uncomment following three lines for SC-p interactions
4039 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4042 cd write (iout,*) 'j>i'
4044 cgrad ggg(k)=-ggg(k)
4045 C Uncomment following line for SC-p interactions
4046 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4047 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4051 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4053 cgrad kstart=min0(i+1,j)
4054 cgrad kend=max0(i-1,j-1)
4055 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4056 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4057 cgrad do k=kstart,kend
4059 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4063 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4064 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4072 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4073 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4074 gradx_scp(j,i)=expon*gradx_scp(j,i)
4077 C******************************************************************************
4081 C To save time the factor EXPON has been extracted from ALL components
4082 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4085 C******************************************************************************
4088 C--------------------------------------------------------------------------
4089 subroutine edis(ehpb)
4091 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4093 implicit real*8 (a-h,o-z)
4094 include 'DIMENSIONS'
4095 include 'COMMON.SBRIDGE'
4096 include 'COMMON.CHAIN'
4097 include 'COMMON.DERIV'
4098 include 'COMMON.VAR'
4099 include 'COMMON.INTERACT'
4100 include 'COMMON.IOUNITS'
4101 include 'COMMON.CONTROL'
4107 C write (iout,*) ,"link_end",link_end,constr_dist
4108 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4109 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4110 if (link_end.eq.0) return
4111 do i=link_start,link_end
4112 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4113 C CA-CA distance used in regularization of structure.
4116 C iii and jjj point to the residues for which the distance is assigned.
4117 if (ii.gt.nres) then
4124 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4125 c & dhpb(i),dhpb1(i),forcon(i)
4126 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4127 C distance and angle dependent SS bond potential.
4128 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4129 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4130 if (.not.dyn_ss .and. i.le.nss) then
4131 C 15/02/13 CC dynamic SSbond - additional check
4132 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4133 & iabs(itype(jjj)).eq.1) then
4134 call ssbond_ene(iii,jjj,eij)
4137 cd write (iout,*) "eij",eij
4138 cd & ' waga=',waga,' fac=',fac
4139 else if (ii.gt.nres .and. jj.gt.nres) then
4140 c Restraints from contact prediction
4142 if (constr_dist.eq.11) then
4143 ehpb=ehpb+fordepth(i)**4.0d0
4144 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4145 fac=fordepth(i)**4.0d0
4146 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4147 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
4148 & ehpb,fordepth(i),dd
4150 if (dhpb1(i).gt.0.0d0) then
4151 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4152 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4153 c write (iout,*) "beta nmr",
4154 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4158 C Get the force constant corresponding to this distance.
4160 C Calculate the contribution to energy.
4161 ehpb=ehpb+waga*rdis*rdis
4162 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4164 C Evaluate gradient.
4170 ggg(j)=fac*(c(j,jj)-c(j,ii))
4173 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4174 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4177 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4178 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4181 C Calculate the distance between the two points and its difference from the
4184 if (constr_dist.eq.11) then
4185 ehpb=ehpb+fordepth(i)**4.0d0
4186 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4187 fac=fordepth(i)**4.0d0
4188 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4189 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
4190 & ehpb,fordepth(i),dd
4192 if (dhpb1(i).gt.0.0d0) then
4193 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4194 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4195 c write (iout,*) "alph nmr",
4196 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4199 C Get the force constant corresponding to this distance.
4201 C Calculate the contribution to energy.
4202 ehpb=ehpb+waga*rdis*rdis
4203 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4205 C Evaluate gradient.
4211 ggg(j)=fac*(c(j,jj)-c(j,ii))
4213 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4214 C If this is a SC-SC distance, we need to calculate the contributions to the
4215 C Cartesian gradient in the SC vectors (ghpbx).
4218 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4219 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4222 cgrad do j=iii,jjj-1
4224 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4228 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4229 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4233 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
4236 C--------------------------------------------------------------------------
4237 subroutine ssbond_ene(i,j,eij)
4239 C Calculate the distance and angle dependent SS-bond potential energy
4240 C using a free-energy function derived based on RHF/6-31G** ab initio
4241 C calculations of diethyl disulfide.
4243 C A. Liwo and U. Kozlowska, 11/24/03
4245 implicit real*8 (a-h,o-z)
4246 include 'DIMENSIONS'
4247 include 'COMMON.SBRIDGE'
4248 include 'COMMON.CHAIN'
4249 include 'COMMON.DERIV'
4250 include 'COMMON.LOCAL'
4251 include 'COMMON.INTERACT'
4252 include 'COMMON.VAR'
4253 include 'COMMON.IOUNITS'
4254 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4255 itypi=iabs(itype(i))
4259 dxi=dc_norm(1,nres+i)
4260 dyi=dc_norm(2,nres+i)
4261 dzi=dc_norm(3,nres+i)
4262 c dsci_inv=dsc_inv(itypi)
4263 dsci_inv=vbld_inv(nres+i)
4264 itypj=iabs(itype(j))
4265 c dscj_inv=dsc_inv(itypj)
4266 dscj_inv=vbld_inv(nres+j)
4270 dxj=dc_norm(1,nres+j)
4271 dyj=dc_norm(2,nres+j)
4272 dzj=dc_norm(3,nres+j)
4273 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4278 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4279 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4280 om12=dxi*dxj+dyi*dyj+dzi*dzj
4282 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4283 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4289 deltat12=om2-om1+2.0d0
4291 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4292 & +akct*deltad*deltat12
4293 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4294 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4295 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4296 c & " deltat12",deltat12," eij",eij
4297 ed=2*akcm*deltad+akct*deltat12
4299 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4300 eom1=-2*akth*deltat1-pom1-om2*pom2
4301 eom2= 2*akth*deltat2+pom1-om1*pom2
4304 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4305 ghpbx(k,i)=ghpbx(k,i)-ggk
4306 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4307 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4308 ghpbx(k,j)=ghpbx(k,j)+ggk
4309 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4310 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4311 ghpbc(k,i)=ghpbc(k,i)-ggk
4312 ghpbc(k,j)=ghpbc(k,j)+ggk
4315 C Calculate the components of the gradient in DC and X
4319 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4324 C--------------------------------------------------------------------------
4325 subroutine ebond(estr)
4327 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4329 implicit real*8 (a-h,o-z)
4330 include 'DIMENSIONS'
4331 include 'COMMON.LOCAL'
4332 include 'COMMON.GEO'
4333 include 'COMMON.INTERACT'
4334 include 'COMMON.DERIV'
4335 include 'COMMON.VAR'
4336 include 'COMMON.CHAIN'
4337 include 'COMMON.IOUNITS'
4338 include 'COMMON.NAMES'
4339 include 'COMMON.FFIELD'
4340 include 'COMMON.CONTROL'
4341 include 'COMMON.SETUP'
4342 double precision u(3),ud(3)
4345 do i=ibondp_start,ibondp_end
4346 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4347 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4349 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4350 & *dc(j,i-1)/vbld(i)
4352 if (energy_dec) write(iout,*)
4353 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4355 diff = vbld(i)-vbldp0
4356 if (energy_dec) write (iout,*)
4357 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4360 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4362 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4365 estr=0.5d0*AKP*estr+estr1
4367 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4369 do i=ibond_start,ibond_end
4371 if (iti.ne.10 .and. iti.ne.ntyp1) then
4374 diff=vbld(i+nres)-vbldsc0(1,iti)
4375 if (energy_dec) write (iout,*)
4376 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4377 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4378 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4380 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4384 diff=vbld(i+nres)-vbldsc0(j,iti)
4385 ud(j)=aksc(j,iti)*diff
4386 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4400 uprod2=uprod2*u(k)*u(k)
4404 usumsqder=usumsqder+ud(j)*uprod2
4406 estr=estr+uprod/usum
4408 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4416 C--------------------------------------------------------------------------
4417 subroutine ebend(etheta,ethetacnstr)
4419 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4420 C angles gamma and its derivatives in consecutive thetas and gammas.
4422 implicit real*8 (a-h,o-z)
4423 include 'DIMENSIONS'
4424 include 'COMMON.LOCAL'
4425 include 'COMMON.GEO'
4426 include 'COMMON.INTERACT'
4427 include 'COMMON.DERIV'
4428 include 'COMMON.VAR'
4429 include 'COMMON.CHAIN'
4430 include 'COMMON.IOUNITS'
4431 include 'COMMON.NAMES'
4432 include 'COMMON.FFIELD'
4433 include 'COMMON.CONTROL'
4434 include 'COMMON.TORCNSTR'
4435 common /calcthet/ term1,term2,termm,diffak,ratak,
4436 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4437 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4438 double precision y(2),z(2)
4440 c time11=dexp(-2*time)
4443 c write (*,'(a,i2)') 'EBEND ICG=',icg
4444 do i=ithet_start,ithet_end
4445 if (itype(i-1).eq.ntyp1) cycle
4446 C Zero the energy function and its derivative at 0 or pi.
4447 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4449 ichir1=isign(1,itype(i-2))
4450 ichir2=isign(1,itype(i))
4451 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4452 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4453 if (itype(i-1).eq.10) then
4454 itype1=isign(10,itype(i-2))
4455 ichir11=isign(1,itype(i-2))
4456 ichir12=isign(1,itype(i-2))
4457 itype2=isign(10,itype(i))
4458 ichir21=isign(1,itype(i))
4459 ichir22=isign(1,itype(i))
4462 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4465 if (phii.ne.phii) phii=150.0
4475 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4478 if (phii1.ne.phii1) phii1=150.0
4490 C Calculate the "mean" value of theta from the part of the distribution
4491 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4492 C In following comments this theta will be referred to as t_c.
4493 thet_pred_mean=0.0d0
4495 athetk=athet(k,it,ichir1,ichir2)
4496 bthetk=bthet(k,it,ichir1,ichir2)
4498 athetk=athet(k,itype1,ichir11,ichir12)
4499 bthetk=bthet(k,itype2,ichir21,ichir22)
4501 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4503 dthett=thet_pred_mean*ssd
4504 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4505 C Derivatives of the "mean" values in gamma1 and gamma2.
4506 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4507 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4508 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4509 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4511 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4512 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4513 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4514 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4516 if (theta(i).gt.pi-delta) then
4517 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4519 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4520 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4521 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4523 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4525 else if (theta(i).lt.delta) then
4526 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4527 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4528 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4530 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4531 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4534 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4537 etheta=etheta+ethetai
4538 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4540 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4541 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4542 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4545 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4546 do i=ithetaconstr_start,ithetaconstr_end
4547 itheta=itheta_constr(i)
4548 thetiii=theta(itheta)
4549 difi=pinorm(thetiii-theta_constr0(i))
4550 if (difi.gt.theta_drange(i)) then
4551 difi=difi-theta_drange(i)
4552 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
4553 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4554 & +for_thet_constr(i)*difi**3
4555 else if (difi.lt.-drange(i)) then
4557 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
4558 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4559 & +for_thet_constr(i)*difi**3
4563 if (energy_dec) then
4564 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4565 & i,itheta,rad2deg*thetiii,
4566 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4567 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4568 & gloc(itheta+nphi-2,icg)
4572 C Ufff.... We've done all this!!!
4575 C---------------------------------------------------------------------------
4576 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4578 implicit real*8 (a-h,o-z)
4579 include 'DIMENSIONS'
4580 include 'COMMON.LOCAL'
4581 include 'COMMON.IOUNITS'
4582 common /calcthet/ term1,term2,termm,diffak,ratak,
4583 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4584 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4585 C Calculate the contributions to both Gaussian lobes.
4586 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4587 C The "polynomial part" of the "standard deviation" of this part of
4591 sig=sig*thet_pred_mean+polthet(j,it)
4593 C Derivative of the "interior part" of the "standard deviation of the"
4594 C gamma-dependent Gaussian lobe in t_c.
4595 sigtc=3*polthet(3,it)
4597 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4600 C Set the parameters of both Gaussian lobes of the distribution.
4601 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4602 fac=sig*sig+sigc0(it)
4605 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4606 sigsqtc=-4.0D0*sigcsq*sigtc
4607 c print *,i,sig,sigtc,sigsqtc
4608 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4609 sigtc=-sigtc/(fac*fac)
4610 C Following variable is sigma(t_c)**(-2)
4611 sigcsq=sigcsq*sigcsq
4613 sig0inv=1.0D0/sig0i**2
4614 delthec=thetai-thet_pred_mean
4615 delthe0=thetai-theta0i
4616 term1=-0.5D0*sigcsq*delthec*delthec
4617 term2=-0.5D0*sig0inv*delthe0*delthe0
4618 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4619 C NaNs in taking the logarithm. We extract the largest exponent which is added
4620 C to the energy (this being the log of the distribution) at the end of energy
4621 C term evaluation for this virtual-bond angle.
4622 if (term1.gt.term2) then
4624 term2=dexp(term2-termm)
4628 term1=dexp(term1-termm)
4631 C The ratio between the gamma-independent and gamma-dependent lobes of
4632 C the distribution is a Gaussian function of thet_pred_mean too.
4633 diffak=gthet(2,it)-thet_pred_mean
4634 ratak=diffak/gthet(3,it)**2
4635 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4636 C Let's differentiate it in thet_pred_mean NOW.
4638 C Now put together the distribution terms to make complete distribution.
4639 termexp=term1+ak*term2
4640 termpre=sigc+ak*sig0i
4641 C Contribution of the bending energy from this theta is just the -log of
4642 C the sum of the contributions from the two lobes and the pre-exponential
4643 C factor. Simple enough, isn't it?
4644 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4645 C NOW the derivatives!!!
4646 C 6/6/97 Take into account the deformation.
4647 E_theta=(delthec*sigcsq*term1
4648 & +ak*delthe0*sig0inv*term2)/termexp
4649 E_tc=((sigtc+aktc*sig0i)/termpre
4650 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4651 & aktc*term2)/termexp)
4654 c-----------------------------------------------------------------------------
4655 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4656 implicit real*8 (a-h,o-z)
4657 include 'DIMENSIONS'
4658 include 'COMMON.LOCAL'
4659 include 'COMMON.IOUNITS'
4660 common /calcthet/ term1,term2,termm,diffak,ratak,
4661 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4662 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4663 delthec=thetai-thet_pred_mean
4664 delthe0=thetai-theta0i
4665 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4666 t3 = thetai-thet_pred_mean
4670 t14 = t12+t6*sigsqtc
4672 t21 = thetai-theta0i
4678 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4679 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4680 & *(-t12*t9-ak*sig0inv*t27)
4684 C--------------------------------------------------------------------------
4685 subroutine ebend(etheta,ethetacnstr)
4687 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4688 C angles gamma and its derivatives in consecutive thetas and gammas.
4689 C ab initio-derived potentials from
4690 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4692 implicit real*8 (a-h,o-z)
4693 include 'DIMENSIONS'
4694 include 'COMMON.LOCAL'
4695 include 'COMMON.GEO'
4696 include 'COMMON.INTERACT'
4697 include 'COMMON.DERIV'
4698 include 'COMMON.VAR'
4699 include 'COMMON.CHAIN'
4700 include 'COMMON.IOUNITS'
4701 include 'COMMON.NAMES'
4702 include 'COMMON.FFIELD'
4703 include 'COMMON.CONTROL'
4704 include 'COMMON.TORCNSTR'
4705 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4706 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4707 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4708 & sinph1ph2(maxdouble,maxdouble)
4709 logical lprn /.false./, lprn1 /.false./
4711 do i=ithet_start,ithet_end
4712 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4713 &(itype(i).eq.ntyp1)) cycle
4714 C print *,i,theta(i)
4715 if (iabs(itype(i+1)).eq.20) iblock=2
4716 if (iabs(itype(i+1)).ne.20) iblock=1
4720 theti2=0.5d0*theta(i)
4721 ityp2=ithetyp((itype(i-1)))
4723 coskt(k)=dcos(k*theti2)
4724 sinkt(k)=dsin(k*theti2)
4728 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4731 if (phii.ne.phii) phii=150.0
4735 ityp1=ithetyp((itype(i-2)))
4736 C propagation of chirality for glycine type
4738 cosph1(k)=dcos(k*phii)
4739 sinph1(k)=dsin(k*phii)
4744 ityp1=ithetyp((itype(i-2)))
4749 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4752 if (phii1.ne.phii1) phii1=150.0
4757 ityp3=ithetyp((itype(i)))
4759 cosph2(k)=dcos(k*phii1)
4760 sinph2(k)=dsin(k*phii1)
4764 ityp3=ithetyp((itype(i)))
4770 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4773 ccl=cosph1(l)*cosph2(k-l)
4774 ssl=sinph1(l)*sinph2(k-l)
4775 scl=sinph1(l)*cosph2(k-l)
4776 csl=cosph1(l)*sinph2(k-l)
4777 cosph1ph2(l,k)=ccl-ssl
4778 cosph1ph2(k,l)=ccl+ssl
4779 sinph1ph2(l,k)=scl+csl
4780 sinph1ph2(k,l)=scl-csl
4784 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4785 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4786 write (iout,*) "coskt and sinkt"
4788 write (iout,*) k,coskt(k),sinkt(k)
4792 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4793 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4796 & write (iout,*) "k",k,"
4797 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4798 & " ethetai",ethetai
4801 write (iout,*) "cosph and sinph"
4803 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4805 write (iout,*) "cosph1ph2 and sinph2ph2"
4808 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4809 & sinph1ph2(l,k),sinph1ph2(k,l)
4812 write(iout,*) "ethetai",ethetai
4817 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4818 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4819 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4820 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4821 ethetai=ethetai+sinkt(m)*aux
4822 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4823 dephii=dephii+k*sinkt(m)*(
4824 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4825 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4826 dephii1=dephii1+k*sinkt(m)*(
4827 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4828 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4830 & write (iout,*) "m",m," k",k," bbthet",
4831 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4832 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4833 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4834 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4835 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4838 C print *,"cosph1", (cosph1(k), k=1,nsingle)
4839 C print *,"cosph2", (cosph2(k), k=1,nsingle)
4840 C print *,"sinph1", (sinph1(k), k=1,nsingle)
4841 C print *,"sinph2", (sinph2(k), k=1,nsingle)
4843 & write(iout,*) "ethetai",ethetai
4844 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4848 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4849 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4850 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4851 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4852 ethetai=ethetai+sinkt(m)*aux
4853 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4854 dephii=dephii+l*sinkt(m)*(
4855 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4856 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4857 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4858 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4859 dephii1=dephii1+(k-l)*sinkt(m)*(
4860 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4861 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4862 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4863 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4865 write (iout,*) "m",m," k",k," l",l," ffthet",
4866 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4867 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4868 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4869 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4870 & " ethetai",ethetai
4871 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4872 & cosph1ph2(k,l)*sinkt(m),
4873 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4882 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4883 & i,theta(i)*rad2deg,phii*rad2deg,
4884 & phii1*rad2deg,ethetai
4886 etheta=etheta+ethetai
4887 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4888 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4889 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4893 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4894 do i=ithetaconstr_start,ithetaconstr_end
4895 itheta=itheta_constr(i)
4896 thetiii=theta(itheta)
4897 difi=pinorm(thetiii-theta_constr0(i))
4898 if (difi.gt.theta_drange(i)) then
4899 difi=difi-theta_drange(i)
4900 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4901 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4902 & +for_thet_constr(i)*difi**3
4903 else if (difi.lt.-drange(i)) then
4905 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4906 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4907 & +for_thet_constr(i)*difi**3
4911 if (energy_dec) then
4912 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4913 & i,itheta,rad2deg*thetiii,
4914 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4915 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4916 & gloc(itheta+nphi-2,icg)
4924 c-----------------------------------------------------------------------------
4925 subroutine esc(escloc)
4926 C Calculate the local energy of a side chain and its derivatives in the
4927 C corresponding virtual-bond valence angles THETA and the spherical angles
4929 implicit real*8 (a-h,o-z)
4930 include 'DIMENSIONS'
4931 include 'COMMON.GEO'
4932 include 'COMMON.LOCAL'
4933 include 'COMMON.VAR'
4934 include 'COMMON.INTERACT'
4935 include 'COMMON.DERIV'
4936 include 'COMMON.CHAIN'
4937 include 'COMMON.IOUNITS'
4938 include 'COMMON.NAMES'
4939 include 'COMMON.FFIELD'
4940 include 'COMMON.CONTROL'
4941 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4942 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4943 common /sccalc/ time11,time12,time112,theti,it,nlobit
4946 c write (iout,'(a)') 'ESC'
4947 do i=loc_start,loc_end
4949 if (it.eq.ntyp1) cycle
4950 if (it.eq.10) goto 1
4951 nlobit=nlob(iabs(it))
4952 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4953 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4954 theti=theta(i+1)-pipol
4959 if (x(2).gt.pi-delta) then
4963 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4965 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4966 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4968 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4969 & ddersc0(1),dersc(1))
4970 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4971 & ddersc0(3),dersc(3))
4973 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4975 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4976 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4977 & dersc0(2),esclocbi,dersc02)
4978 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4980 call splinthet(x(2),0.5d0*delta,ss,ssd)
4985 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4987 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4988 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4990 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4992 c write (iout,*) escloci
4993 else if (x(2).lt.delta) then
4997 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4999 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5000 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5002 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5003 & ddersc0(1),dersc(1))
5004 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5005 & ddersc0(3),dersc(3))
5007 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5009 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5010 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5011 & dersc0(2),esclocbi,dersc02)
5012 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5017 call splinthet(x(2),0.5d0*delta,ss,ssd)
5019 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5021 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5022 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5024 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5025 c write (iout,*) escloci
5027 call enesc(x,escloci,dersc,ddummy,.false.)
5030 escloc=escloc+escloci
5031 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5032 & 'escloc',i,escloci
5033 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5035 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5037 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5038 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5043 C---------------------------------------------------------------------------
5044 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5045 implicit real*8 (a-h,o-z)
5046 include 'DIMENSIONS'
5047 include 'COMMON.GEO'
5048 include 'COMMON.LOCAL'
5049 include 'COMMON.IOUNITS'
5050 common /sccalc/ time11,time12,time112,theti,it,nlobit
5051 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5052 double precision contr(maxlob,-1:1)
5054 c write (iout,*) 'it=',it,' nlobit=',nlobit
5058 if (mixed) ddersc(j)=0.0d0
5062 C Because of periodicity of the dependence of the SC energy in omega we have
5063 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5064 C To avoid underflows, first compute & store the exponents.
5072 z(k)=x(k)-censc(k,j,it)
5077 Axk=Axk+gaussc(l,k,j,it)*z(l)
5083 expfac=expfac+Ax(k,j,iii)*z(k)
5091 C As in the case of ebend, we want to avoid underflows in exponentiation and
5092 C subsequent NaNs and INFs in energy calculation.
5093 C Find the largest exponent
5097 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5101 cd print *,'it=',it,' emin=',emin
5103 C Compute the contribution to SC energy and derivatives
5108 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5109 if(adexp.ne.adexp) adexp=1.0
5112 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5114 cd print *,'j=',j,' expfac=',expfac
5115 escloc_i=escloc_i+expfac
5117 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5121 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5122 & +gaussc(k,2,j,it))*expfac
5129 dersc(1)=dersc(1)/cos(theti)**2
5130 ddersc(1)=ddersc(1)/cos(theti)**2
5133 escloci=-(dlog(escloc_i)-emin)
5135 dersc(j)=dersc(j)/escloc_i
5139 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5144 C------------------------------------------------------------------------------
5145 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5146 implicit real*8 (a-h,o-z)
5147 include 'DIMENSIONS'
5148 include 'COMMON.GEO'
5149 include 'COMMON.LOCAL'
5150 include 'COMMON.IOUNITS'
5151 common /sccalc/ time11,time12,time112,theti,it,nlobit
5152 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5153 double precision contr(maxlob)
5164 z(k)=x(k)-censc(k,j,it)
5170 Axk=Axk+gaussc(l,k,j,it)*z(l)
5176 expfac=expfac+Ax(k,j)*z(k)
5181 C As in the case of ebend, we want to avoid underflows in exponentiation and
5182 C subsequent NaNs and INFs in energy calculation.
5183 C Find the largest exponent
5186 if (emin.gt.contr(j)) emin=contr(j)
5190 C Compute the contribution to SC energy and derivatives
5194 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5195 escloc_i=escloc_i+expfac
5197 dersc(k)=dersc(k)+Ax(k,j)*expfac
5199 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5200 & +gaussc(1,2,j,it))*expfac
5204 dersc(1)=dersc(1)/cos(theti)**2
5205 dersc12=dersc12/cos(theti)**2
5206 escloci=-(dlog(escloc_i)-emin)
5208 dersc(j)=dersc(j)/escloc_i
5210 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5214 c----------------------------------------------------------------------------------
5215 subroutine esc(escloc)
5216 C Calculate the local energy of a side chain and its derivatives in the
5217 C corresponding virtual-bond valence angles THETA and the spherical angles
5218 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5219 C added by Urszula Kozlowska. 07/11/2007
5221 implicit real*8 (a-h,o-z)
5222 include 'DIMENSIONS'
5223 include 'COMMON.GEO'
5224 include 'COMMON.LOCAL'
5225 include 'COMMON.VAR'
5226 include 'COMMON.SCROT'
5227 include 'COMMON.INTERACT'
5228 include 'COMMON.DERIV'
5229 include 'COMMON.CHAIN'
5230 include 'COMMON.IOUNITS'
5231 include 'COMMON.NAMES'
5232 include 'COMMON.FFIELD'
5233 include 'COMMON.CONTROL'
5234 include 'COMMON.VECTORS'
5235 double precision x_prime(3),y_prime(3),z_prime(3)
5236 & , sumene,dsc_i,dp2_i,x(65),
5237 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5238 & de_dxx,de_dyy,de_dzz,de_dt
5239 double precision s1_t,s1_6_t,s2_t,s2_6_t
5241 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5242 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5243 & dt_dCi(3),dt_dCi1(3)
5244 common /sccalc/ time11,time12,time112,theti,it,nlobit
5247 do i=loc_start,loc_end
5248 if (itype(i).eq.ntyp1) cycle
5249 costtab(i+1) =dcos(theta(i+1))
5250 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5251 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5252 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5253 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5254 cosfac=dsqrt(cosfac2)
5255 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5256 sinfac=dsqrt(sinfac2)
5258 if (it.eq.10) goto 1
5260 C Compute the axes of tghe local cartesian coordinates system; store in
5261 c x_prime, y_prime and z_prime
5268 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5269 C & dc_norm(3,i+nres)
5271 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5272 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5275 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5278 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5279 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5280 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5281 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5282 c & " xy",scalar(x_prime(1),y_prime(1)),
5283 c & " xz",scalar(x_prime(1),z_prime(1)),
5284 c & " yy",scalar(y_prime(1),y_prime(1)),
5285 c & " yz",scalar(y_prime(1),z_prime(1)),
5286 c & " zz",scalar(z_prime(1),z_prime(1))
5288 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5289 C to local coordinate system. Store in xx, yy, zz.
5295 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5296 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5297 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5304 C Compute the energy of the ith side cbain
5306 c write (2,*) "xx",xx," yy",yy," zz",zz
5309 x(j) = sc_parmin(j,it)
5312 Cc diagnostics - remove later
5314 yy1 = dsin(alph(2))*dcos(omeg(2))
5315 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5316 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5317 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5319 C," --- ", xx_w,yy_w,zz_w
5322 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5323 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5325 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5326 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5328 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5329 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5330 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5331 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5332 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5334 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5335 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5336 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5337 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5338 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5340 dsc_i = 0.743d0+x(61)
5342 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5343 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5344 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5345 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5346 s1=(1+x(63))/(0.1d0 + dscp1)
5347 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5348 s2=(1+x(65))/(0.1d0 + dscp2)
5349 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5350 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5351 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5352 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5354 c & dscp1,dscp2,sumene
5355 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5356 escloc = escloc + sumene
5357 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5362 C This section to check the numerical derivatives of the energy of ith side
5363 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5364 C #define DEBUG in the code to turn it on.
5366 write (2,*) "sumene =",sumene
5370 write (2,*) xx,yy,zz
5371 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5372 de_dxx_num=(sumenep-sumene)/aincr
5374 write (2,*) "xx+ sumene from enesc=",sumenep
5377 write (2,*) xx,yy,zz
5378 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5379 de_dyy_num=(sumenep-sumene)/aincr
5381 write (2,*) "yy+ sumene from enesc=",sumenep
5384 write (2,*) xx,yy,zz
5385 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5386 de_dzz_num=(sumenep-sumene)/aincr
5388 write (2,*) "zz+ sumene from enesc=",sumenep
5389 costsave=cost2tab(i+1)
5390 sintsave=sint2tab(i+1)
5391 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5392 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5393 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5394 de_dt_num=(sumenep-sumene)/aincr
5395 write (2,*) " t+ sumene from enesc=",sumenep
5396 cost2tab(i+1)=costsave
5397 sint2tab(i+1)=sintsave
5398 C End of diagnostics section.
5401 C Compute the gradient of esc
5403 c zz=zz*dsign(1.0,dfloat(itype(i)))
5404 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5405 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5406 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5407 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5408 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5409 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5410 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5411 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5412 pom1=(sumene3*sint2tab(i+1)+sumene1)
5413 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5414 pom2=(sumene4*cost2tab(i+1)+sumene2)
5415 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5416 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5417 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5418 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5420 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5421 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5422 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5424 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5425 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5426 & +(pom1+pom2)*pom_dx
5428 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5431 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5432 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5433 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5435 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5436 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5437 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5438 & +x(59)*zz**2 +x(60)*xx*zz
5439 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5440 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5441 & +(pom1-pom2)*pom_dy
5443 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5446 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5447 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5448 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5449 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5450 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5451 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5452 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5453 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5455 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5458 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5459 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5460 & +pom1*pom_dt1+pom2*pom_dt2
5462 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5467 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5468 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5469 cosfac2xx=cosfac2*xx
5470 sinfac2yy=sinfac2*yy
5472 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5474 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5476 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5477 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5478 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5479 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5480 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5481 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5482 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5483 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5484 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5485 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5489 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5490 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5491 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5492 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5495 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5496 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5497 dZZ_XYZ(k)=vbld_inv(i+nres)*
5498 & (z_prime(k)-zz*dC_norm(k,i+nres))
5500 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5501 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5505 dXX_Ctab(k,i)=dXX_Ci(k)
5506 dXX_C1tab(k,i)=dXX_Ci1(k)
5507 dYY_Ctab(k,i)=dYY_Ci(k)
5508 dYY_C1tab(k,i)=dYY_Ci1(k)
5509 dZZ_Ctab(k,i)=dZZ_Ci(k)
5510 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5511 dXX_XYZtab(k,i)=dXX_XYZ(k)
5512 dYY_XYZtab(k,i)=dYY_XYZ(k)
5513 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5517 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5518 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5519 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5520 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5521 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5523 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5524 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5525 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5526 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5527 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5528 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5529 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5530 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5532 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5533 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5535 C to check gradient call subroutine check_grad
5541 c------------------------------------------------------------------------------
5542 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5544 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5545 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5546 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5547 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5549 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5550 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5552 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5553 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5554 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5555 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5556 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5558 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5559 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5560 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5561 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5562 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5564 dsc_i = 0.743d0+x(61)
5566 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5567 & *(xx*cost2+yy*sint2))
5568 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5569 & *(xx*cost2-yy*sint2))
5570 s1=(1+x(63))/(0.1d0 + dscp1)
5571 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5572 s2=(1+x(65))/(0.1d0 + dscp2)
5573 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5574 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5575 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5580 c------------------------------------------------------------------------------
5581 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5583 C This procedure calculates two-body contact function g(rij) and its derivative:
5586 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5589 C where x=(rij-r0ij)/delta
5591 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5594 double precision rij,r0ij,eps0ij,fcont,fprimcont
5595 double precision x,x2,x4,delta
5599 if (x.lt.-1.0D0) then
5602 else if (x.le.1.0D0) then
5605 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5606 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5613 c------------------------------------------------------------------------------
5614 subroutine splinthet(theti,delta,ss,ssder)
5615 implicit real*8 (a-h,o-z)
5616 include 'DIMENSIONS'
5617 include 'COMMON.VAR'
5618 include 'COMMON.GEO'
5621 if (theti.gt.pipol) then
5622 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5624 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5629 c------------------------------------------------------------------------------
5630 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5632 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5633 double precision ksi,ksi2,ksi3,a1,a2,a3
5634 a1=fprim0*delta/(f1-f0)
5640 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5641 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5644 c------------------------------------------------------------------------------
5645 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5647 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5648 double precision ksi,ksi2,ksi3,a1,a2,a3
5653 a2=3*(f1x-f0x)-2*fprim0x*delta
5654 a3=fprim0x*delta-2*(f1x-f0x)
5655 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5658 C-----------------------------------------------------------------------------
5660 C-----------------------------------------------------------------------------
5661 subroutine etor(etors,edihcnstr)
5662 implicit real*8 (a-h,o-z)
5663 include 'DIMENSIONS'
5664 include 'COMMON.VAR'
5665 include 'COMMON.GEO'
5666 include 'COMMON.LOCAL'
5667 include 'COMMON.TORSION'
5668 include 'COMMON.INTERACT'
5669 include 'COMMON.DERIV'
5670 include 'COMMON.CHAIN'
5671 include 'COMMON.NAMES'
5672 include 'COMMON.IOUNITS'
5673 include 'COMMON.FFIELD'
5674 include 'COMMON.TORCNSTR'
5675 include 'COMMON.CONTROL'
5677 C Set lprn=.true. for debugging
5681 do i=iphi_start,iphi_end
5683 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5684 & .or. itype(i).eq.ntyp1) cycle
5685 itori=itortyp(itype(i-2))
5686 itori1=itortyp(itype(i-1))
5689 C Proline-Proline pair is a special case...
5690 if (itori.eq.3 .and. itori1.eq.3) then
5691 if (phii.gt.-dwapi3) then
5693 fac=1.0D0/(1.0D0-cosphi)
5694 etorsi=v1(1,3,3)*fac
5695 etorsi=etorsi+etorsi
5696 etors=etors+etorsi-v1(1,3,3)
5697 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5698 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5701 v1ij=v1(j+1,itori,itori1)
5702 v2ij=v2(j+1,itori,itori1)
5705 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5706 if (energy_dec) etors_ii=etors_ii+
5707 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5708 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5712 v1ij=v1(j,itori,itori1)
5713 v2ij=v2(j,itori,itori1)
5716 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5717 if (energy_dec) etors_ii=etors_ii+
5718 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5719 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5722 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5725 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5726 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5727 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5728 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5729 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5731 ! 6/20/98 - dihedral angle constraints
5734 itori=idih_constr(i)
5737 if (difi.gt.drange(i)) then
5739 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5740 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5741 else if (difi.lt.-drange(i)) then
5743 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
5744 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5746 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5747 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5749 ! write (iout,*) 'edihcnstr',edihcnstr
5752 c------------------------------------------------------------------------------
5753 subroutine etor_d(etors_d)
5757 c----------------------------------------------------------------------------
5759 subroutine etor(etors,edihcnstr)
5760 implicit real*8 (a-h,o-z)
5761 include 'DIMENSIONS'
5762 include 'COMMON.VAR'
5763 include 'COMMON.GEO'
5764 include 'COMMON.LOCAL'
5765 include 'COMMON.TORSION'
5766 include 'COMMON.INTERACT'
5767 include 'COMMON.DERIV'
5768 include 'COMMON.CHAIN'
5769 include 'COMMON.NAMES'
5770 include 'COMMON.IOUNITS'
5771 include 'COMMON.FFIELD'
5772 include 'COMMON.TORCNSTR'
5773 include 'COMMON.CONTROL'
5775 C Set lprn=.true. for debugging
5779 do i=iphi_start,iphi_end
5780 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5781 & .or. itype(i).eq.ntyp1) cycle
5783 if (iabs(itype(i)).eq.20) then
5788 itori=itortyp(itype(i-2))
5789 itori1=itortyp(itype(i-1))
5792 C Regular cosine and sine terms
5793 do j=1,nterm(itori,itori1,iblock)
5794 v1ij=v1(j,itori,itori1,iblock)
5795 v2ij=v2(j,itori,itori1,iblock)
5798 etors=etors+v1ij*cosphi+v2ij*sinphi
5799 if (energy_dec) etors_ii=etors_ii+
5800 & v1ij*cosphi+v2ij*sinphi
5801 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5805 C E = SUM ----------------------------------- - v1
5806 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5808 cosphi=dcos(0.5d0*phii)
5809 sinphi=dsin(0.5d0*phii)
5810 do j=1,nlor(itori,itori1,iblock)
5811 vl1ij=vlor1(j,itori,itori1)
5812 vl2ij=vlor2(j,itori,itori1)
5813 vl3ij=vlor3(j,itori,itori1)
5814 pom=vl2ij*cosphi+vl3ij*sinphi
5815 pom1=1.0d0/(pom*pom+1.0d0)
5816 etors=etors+vl1ij*pom1
5817 if (energy_dec) etors_ii=etors_ii+
5820 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5822 C Subtract the constant term
5823 etors=etors-v0(itori,itori1,iblock)
5824 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5825 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5827 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5828 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5829 & (v1(j,itori,itori1,iblock),j=1,6),
5830 & (v2(j,itori,itori1,iblock),j=1,6)
5831 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5832 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5834 ! 6/20/98 - dihedral angle constraints
5836 c do i=1,ndih_constr
5837 do i=idihconstr_start,idihconstr_end
5838 itori=idih_constr(i)
5840 difi=pinorm(phii-phi0(i))
5841 if (difi.gt.drange(i)) then
5843 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5844 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5845 else if (difi.lt.-drange(i)) then
5847 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5848 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5852 if (energy_dec) then
5853 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
5854 & i,itori,rad2deg*phii,
5855 & rad2deg*phi0(i), rad2deg*drange(i),
5856 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5859 cd write (iout,*) 'edihcnstr',edihcnstr
5862 c----------------------------------------------------------------------------
5863 subroutine etor_d(etors_d)
5864 C 6/23/01 Compute double torsional energy
5865 implicit real*8 (a-h,o-z)
5866 include 'DIMENSIONS'
5867 include 'COMMON.VAR'
5868 include 'COMMON.GEO'
5869 include 'COMMON.LOCAL'
5870 include 'COMMON.TORSION'
5871 include 'COMMON.INTERACT'
5872 include 'COMMON.DERIV'
5873 include 'COMMON.CHAIN'
5874 include 'COMMON.NAMES'
5875 include 'COMMON.IOUNITS'
5876 include 'COMMON.FFIELD'
5877 include 'COMMON.TORCNSTR'
5879 C Set lprn=.true. for debugging
5883 c write(iout,*) "a tu??"
5884 do i=iphid_start,iphid_end
5885 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5886 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5887 itori=itortyp(itype(i-2))
5888 itori1=itortyp(itype(i-1))
5889 itori2=itortyp(itype(i))
5895 if (iabs(itype(i+1)).eq.20) iblock=2
5897 C Regular cosine and sine terms
5898 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5899 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5900 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5901 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5902 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5903 cosphi1=dcos(j*phii)
5904 sinphi1=dsin(j*phii)
5905 cosphi2=dcos(j*phii1)
5906 sinphi2=dsin(j*phii1)
5907 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5908 & v2cij*cosphi2+v2sij*sinphi2
5909 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5910 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5912 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5914 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5915 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5916 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5917 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5918 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5919 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5920 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5921 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5922 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5923 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5924 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5925 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5926 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5927 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5930 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5931 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5936 c------------------------------------------------------------------------------
5937 subroutine eback_sc_corr(esccor)
5938 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5939 c conformational states; temporarily implemented as differences
5940 c between UNRES torsional potentials (dependent on three types of
5941 c residues) and the torsional potentials dependent on all 20 types
5942 c of residues computed from AM1 energy surfaces of terminally-blocked
5943 c amino-acid residues.
5944 implicit real*8 (a-h,o-z)
5945 include 'DIMENSIONS'
5946 include 'COMMON.VAR'
5947 include 'COMMON.GEO'
5948 include 'COMMON.LOCAL'
5949 include 'COMMON.TORSION'
5950 include 'COMMON.SCCOR'
5951 include 'COMMON.INTERACT'
5952 include 'COMMON.DERIV'
5953 include 'COMMON.CHAIN'
5954 include 'COMMON.NAMES'
5955 include 'COMMON.IOUNITS'
5956 include 'COMMON.FFIELD'
5957 include 'COMMON.CONTROL'
5959 C Set lprn=.true. for debugging
5962 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5964 do i=itau_start,itau_end
5965 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5967 isccori=isccortyp(itype(i-2))
5968 isccori1=isccortyp(itype(i-1))
5969 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5971 do intertyp=1,3 !intertyp
5972 cc Added 09 May 2012 (Adasko)
5973 cc Intertyp means interaction type of backbone mainchain correlation:
5974 c 1 = SC...Ca...Ca...Ca
5975 c 2 = Ca...Ca...Ca...SC
5976 c 3 = SC...Ca...Ca...SCi
5978 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5979 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5980 & (itype(i-1).eq.ntyp1)))
5981 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5982 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5983 & .or.(itype(i).eq.ntyp1)))
5984 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5985 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5986 & (itype(i-3).eq.ntyp1)))) cycle
5987 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5988 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5990 do j=1,nterm_sccor(isccori,isccori1)
5991 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5992 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5993 cosphi=dcos(j*tauangle(intertyp,i))
5994 sinphi=dsin(j*tauangle(intertyp,i))
5995 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5996 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5998 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5999 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6001 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6002 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6003 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6004 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6005 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6011 c----------------------------------------------------------------------------
6012 subroutine multibody(ecorr)
6013 C This subroutine calculates multi-body contributions to energy following
6014 C the idea of Skolnick et al. If side chains I and J make a contact and
6015 C at the same time side chains I+1 and J+1 make a contact, an extra
6016 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6017 implicit real*8 (a-h,o-z)
6018 include 'DIMENSIONS'
6019 include 'COMMON.IOUNITS'
6020 include 'COMMON.DERIV'
6021 include 'COMMON.INTERACT'
6022 include 'COMMON.CONTACTS'
6023 double precision gx(3),gx1(3)
6026 C Set lprn=.true. for debugging
6030 write (iout,'(a)') 'Contact function values:'
6032 write (iout,'(i2,20(1x,i2,f10.5))')
6033 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6048 num_conti=num_cont(i)
6049 num_conti1=num_cont(i1)
6054 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6055 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6056 cd & ' ishift=',ishift
6057 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6058 C The system gains extra energy.
6059 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6060 endif ! j1==j+-ishift
6069 c------------------------------------------------------------------------------
6070 double precision function esccorr(i,j,k,l,jj,kk)
6071 implicit real*8 (a-h,o-z)
6072 include 'DIMENSIONS'
6073 include 'COMMON.IOUNITS'
6074 include 'COMMON.DERIV'
6075 include 'COMMON.INTERACT'
6076 include 'COMMON.CONTACTS'
6077 double precision gx(3),gx1(3)
6082 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6083 C Calculate the multi-body contribution to energy.
6084 C Calculate multi-body contributions to the gradient.
6085 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6086 cd & k,l,(gacont(m,kk,k),m=1,3)
6088 gx(m) =ekl*gacont(m,jj,i)
6089 gx1(m)=eij*gacont(m,kk,k)
6090 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6091 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6092 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6093 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6097 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6102 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6108 c------------------------------------------------------------------------------
6109 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6110 C This subroutine calculates multi-body contributions to hydrogen-bonding
6111 implicit real*8 (a-h,o-z)
6112 include 'DIMENSIONS'
6113 include 'COMMON.IOUNITS'
6116 parameter (max_cont=maxconts)
6117 parameter (max_dim=26)
6118 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6119 double precision zapas(max_dim,maxconts,max_fg_procs),
6120 & zapas_recv(max_dim,maxconts,max_fg_procs)
6121 common /przechowalnia/ zapas
6122 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6123 & status_array(MPI_STATUS_SIZE,maxconts*2)
6125 include 'COMMON.SETUP'
6126 include 'COMMON.FFIELD'
6127 include 'COMMON.DERIV'
6128 include 'COMMON.INTERACT'
6129 include 'COMMON.CONTACTS'
6130 include 'COMMON.CONTROL'
6131 include 'COMMON.LOCAL'
6132 double precision gx(3),gx1(3),time00
6135 C Set lprn=.true. for debugging
6140 if (nfgtasks.le.1) goto 30
6142 write (iout,'(a)') 'Contact function values before RECEIVE:'
6144 write (iout,'(2i3,50(1x,i2,f5.2))')
6145 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6146 & j=1,num_cont_hb(i))
6150 do i=1,ntask_cont_from
6153 do i=1,ntask_cont_to
6156 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6158 C Make the list of contacts to send to send to other procesors
6159 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6161 do i=iturn3_start,iturn3_end
6162 c write (iout,*) "make contact list turn3",i," num_cont",
6164 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6166 do i=iturn4_start,iturn4_end
6167 c write (iout,*) "make contact list turn4",i," num_cont",
6169 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6173 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6175 do j=1,num_cont_hb(i)
6178 iproc=iint_sent_local(k,jjc,ii)
6179 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6180 if (iproc.gt.0) then
6181 ncont_sent(iproc)=ncont_sent(iproc)+1
6182 nn=ncont_sent(iproc)
6184 zapas(2,nn,iproc)=jjc
6185 zapas(3,nn,iproc)=facont_hb(j,i)
6186 zapas(4,nn,iproc)=ees0p(j,i)
6187 zapas(5,nn,iproc)=ees0m(j,i)
6188 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6189 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6190 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6191 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6192 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6193 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6194 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6195 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6196 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6197 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6198 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6199 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6200 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6201 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6202 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6203 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6204 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6205 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6206 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6207 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6208 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6215 & "Numbers of contacts to be sent to other processors",
6216 & (ncont_sent(i),i=1,ntask_cont_to)
6217 write (iout,*) "Contacts sent"
6218 do ii=1,ntask_cont_to
6220 iproc=itask_cont_to(ii)
6221 write (iout,*) nn," contacts to processor",iproc,
6222 & " of CONT_TO_COMM group"
6224 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6232 CorrelID1=nfgtasks+fg_rank+1
6234 C Receive the numbers of needed contacts from other processors
6235 do ii=1,ntask_cont_from
6236 iproc=itask_cont_from(ii)
6238 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6239 & FG_COMM,req(ireq),IERR)
6241 c write (iout,*) "IRECV ended"
6243 C Send the number of contacts needed by other processors
6244 do ii=1,ntask_cont_to
6245 iproc=itask_cont_to(ii)
6247 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6248 & FG_COMM,req(ireq),IERR)
6250 c write (iout,*) "ISEND ended"
6251 c write (iout,*) "number of requests (nn)",ireq
6254 & call MPI_Waitall(ireq,req,status_array,ierr)
6256 c & "Numbers of contacts to be received from other processors",
6257 c & (ncont_recv(i),i=1,ntask_cont_from)
6261 do ii=1,ntask_cont_from
6262 iproc=itask_cont_from(ii)
6264 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6265 c & " of CONT_TO_COMM group"
6269 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6270 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6271 c write (iout,*) "ireq,req",ireq,req(ireq)
6274 C Send the contacts to processors that need them
6275 do ii=1,ntask_cont_to
6276 iproc=itask_cont_to(ii)
6278 c write (iout,*) nn," contacts to processor",iproc,
6279 c & " of CONT_TO_COMM group"
6282 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6283 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6284 c write (iout,*) "ireq,req",ireq,req(ireq)
6286 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6290 c write (iout,*) "number of requests (contacts)",ireq
6291 c write (iout,*) "req",(req(i),i=1,4)
6294 & call MPI_Waitall(ireq,req,status_array,ierr)
6295 do iii=1,ntask_cont_from
6296 iproc=itask_cont_from(iii)
6299 write (iout,*) "Received",nn," contacts from processor",iproc,
6300 & " of CONT_FROM_COMM group"
6303 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6308 ii=zapas_recv(1,i,iii)
6309 c Flag the received contacts to prevent double-counting
6310 jj=-zapas_recv(2,i,iii)
6311 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6313 nnn=num_cont_hb(ii)+1
6316 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6317 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6318 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6319 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6320 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6321 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6322 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6323 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6324 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6325 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6326 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6327 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6328 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6329 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6330 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6331 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6332 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6333 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6334 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6335 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6336 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6337 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6338 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6339 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6344 write (iout,'(a)') 'Contact function values after receive:'
6346 write (iout,'(2i3,50(1x,i3,f5.2))')
6347 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6348 & j=1,num_cont_hb(i))
6355 write (iout,'(a)') 'Contact function values:'
6357 write (iout,'(2i3,50(1x,i3,f5.2))')
6358 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6359 & j=1,num_cont_hb(i))
6363 C Remove the loop below after debugging !!!
6370 C Calculate the local-electrostatic correlation terms
6371 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6373 num_conti=num_cont_hb(i)
6374 num_conti1=num_cont_hb(i+1)
6381 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6382 c & ' jj=',jj,' kk=',kk
6383 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6384 & .or. j.lt.0 .and. j1.gt.0) .and.
6385 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6386 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6387 C The system gains extra energy.
6388 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6389 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6390 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6392 else if (j1.eq.j) then
6393 C Contacts I-J and I-(J+1) occur simultaneously.
6394 C The system loses extra energy.
6395 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6400 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6401 c & ' jj=',jj,' kk=',kk
6403 C Contacts I-J and (I+1)-J occur simultaneously.
6404 C The system loses extra energy.
6405 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6412 c------------------------------------------------------------------------------
6413 subroutine add_hb_contact(ii,jj,itask)
6414 implicit real*8 (a-h,o-z)
6415 include "DIMENSIONS"
6416 include "COMMON.IOUNITS"
6419 parameter (max_cont=maxconts)
6420 parameter (max_dim=26)
6421 include "COMMON.CONTACTS"
6422 double precision zapas(max_dim,maxconts,max_fg_procs),
6423 & zapas_recv(max_dim,maxconts,max_fg_procs)
6424 common /przechowalnia/ zapas
6425 integer i,j,ii,jj,iproc,itask(4),nn
6426 c write (iout,*) "itask",itask
6429 if (iproc.gt.0) then
6430 do j=1,num_cont_hb(ii)
6432 c write (iout,*) "i",ii," j",jj," jjc",jjc
6434 ncont_sent(iproc)=ncont_sent(iproc)+1
6435 nn=ncont_sent(iproc)
6436 zapas(1,nn,iproc)=ii
6437 zapas(2,nn,iproc)=jjc
6438 zapas(3,nn,iproc)=facont_hb(j,ii)
6439 zapas(4,nn,iproc)=ees0p(j,ii)
6440 zapas(5,nn,iproc)=ees0m(j,ii)
6441 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6442 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6443 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6444 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6445 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6446 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6447 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6448 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6449 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6450 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6451 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6452 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6453 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6454 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6455 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6456 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6457 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6458 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6459 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6460 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6461 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6469 c------------------------------------------------------------------------------
6470 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6472 C This subroutine calculates multi-body contributions to hydrogen-bonding
6473 implicit real*8 (a-h,o-z)
6474 include 'DIMENSIONS'
6475 include 'COMMON.IOUNITS'
6478 parameter (max_cont=maxconts)
6479 parameter (max_dim=70)
6480 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6481 double precision zapas(max_dim,maxconts,max_fg_procs),
6482 & zapas_recv(max_dim,maxconts,max_fg_procs)
6483 common /przechowalnia/ zapas
6484 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6485 & status_array(MPI_STATUS_SIZE,maxconts*2)
6487 include 'COMMON.SETUP'
6488 include 'COMMON.FFIELD'
6489 include 'COMMON.DERIV'
6490 include 'COMMON.LOCAL'
6491 include 'COMMON.INTERACT'
6492 include 'COMMON.CONTACTS'
6493 include 'COMMON.CHAIN'
6494 include 'COMMON.CONTROL'
6495 double precision gx(3),gx1(3)
6496 integer num_cont_hb_old(maxres)
6498 double precision eello4,eello5,eelo6,eello_turn6
6499 external eello4,eello5,eello6,eello_turn6
6500 C Set lprn=.true. for debugging
6505 num_cont_hb_old(i)=num_cont_hb(i)
6509 if (nfgtasks.le.1) goto 30
6511 write (iout,'(a)') 'Contact function values before RECEIVE:'
6513 write (iout,'(2i3,50(1x,i2,f5.2))')
6514 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6515 & j=1,num_cont_hb(i))
6519 do i=1,ntask_cont_from
6522 do i=1,ntask_cont_to
6525 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6527 C Make the list of contacts to send to send to other procesors
6528 do i=iturn3_start,iturn3_end
6529 c write (iout,*) "make contact list turn3",i," num_cont",
6531 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6533 do i=iturn4_start,iturn4_end
6534 c write (iout,*) "make contact list turn4",i," num_cont",
6536 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6540 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6542 do j=1,num_cont_hb(i)
6545 iproc=iint_sent_local(k,jjc,ii)
6546 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6547 if (iproc.ne.0) then
6548 ncont_sent(iproc)=ncont_sent(iproc)+1
6549 nn=ncont_sent(iproc)
6551 zapas(2,nn,iproc)=jjc
6552 zapas(3,nn,iproc)=d_cont(j,i)
6556 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6561 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6569 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6580 & "Numbers of contacts to be sent to other processors",
6581 & (ncont_sent(i),i=1,ntask_cont_to)
6582 write (iout,*) "Contacts sent"
6583 do ii=1,ntask_cont_to
6585 iproc=itask_cont_to(ii)
6586 write (iout,*) nn," contacts to processor",iproc,
6587 & " of CONT_TO_COMM group"
6589 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6597 CorrelID1=nfgtasks+fg_rank+1
6599 C Receive the numbers of needed contacts from other processors
6600 do ii=1,ntask_cont_from
6601 iproc=itask_cont_from(ii)
6603 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6604 & FG_COMM,req(ireq),IERR)
6606 c write (iout,*) "IRECV ended"
6608 C Send the number of contacts needed by other processors
6609 do ii=1,ntask_cont_to
6610 iproc=itask_cont_to(ii)
6612 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6613 & FG_COMM,req(ireq),IERR)
6615 c write (iout,*) "ISEND ended"
6616 c write (iout,*) "number of requests (nn)",ireq
6619 & call MPI_Waitall(ireq,req,status_array,ierr)
6621 c & "Numbers of contacts to be received from other processors",
6622 c & (ncont_recv(i),i=1,ntask_cont_from)
6626 do ii=1,ntask_cont_from
6627 iproc=itask_cont_from(ii)
6629 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6630 c & " of CONT_TO_COMM group"
6634 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6635 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6636 c write (iout,*) "ireq,req",ireq,req(ireq)
6639 C Send the contacts to processors that need them
6640 do ii=1,ntask_cont_to
6641 iproc=itask_cont_to(ii)
6643 c write (iout,*) nn," contacts to processor",iproc,
6644 c & " of CONT_TO_COMM group"
6647 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6648 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6649 c write (iout,*) "ireq,req",ireq,req(ireq)
6651 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6655 c write (iout,*) "number of requests (contacts)",ireq
6656 c write (iout,*) "req",(req(i),i=1,4)
6659 & call MPI_Waitall(ireq,req,status_array,ierr)
6660 do iii=1,ntask_cont_from
6661 iproc=itask_cont_from(iii)
6664 write (iout,*) "Received",nn," contacts from processor",iproc,
6665 & " of CONT_FROM_COMM group"
6668 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6673 ii=zapas_recv(1,i,iii)
6674 c Flag the received contacts to prevent double-counting
6675 jj=-zapas_recv(2,i,iii)
6676 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6678 nnn=num_cont_hb(ii)+1
6681 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6685 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6690 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6698 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6707 write (iout,'(a)') 'Contact function values after receive:'
6709 write (iout,'(2i3,50(1x,i3,5f6.3))')
6710 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6711 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6718 write (iout,'(a)') 'Contact function values:'
6720 write (iout,'(2i3,50(1x,i2,5f6.3))')
6721 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6722 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6728 C Remove the loop below after debugging !!!
6735 C Calculate the dipole-dipole interaction energies
6736 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6737 do i=iatel_s,iatel_e+1
6738 num_conti=num_cont_hb(i)
6747 C Calculate the local-electrostatic correlation terms
6748 c write (iout,*) "gradcorr5 in eello5 before loop"
6750 c write (iout,'(i5,3f10.5)')
6751 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6753 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6754 c write (iout,*) "corr loop i",i
6756 num_conti=num_cont_hb(i)
6757 num_conti1=num_cont_hb(i+1)
6764 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6765 c & ' jj=',jj,' kk=',kk
6766 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6767 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6768 & .or. j.lt.0 .and. j1.gt.0) .and.
6769 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6770 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6771 C The system gains extra energy.
6773 sqd1=dsqrt(d_cont(jj,i))
6774 sqd2=dsqrt(d_cont(kk,i1))
6775 sred_geom = sqd1*sqd2
6776 IF (sred_geom.lt.cutoff_corr) THEN
6777 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6779 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6780 cd & ' jj=',jj,' kk=',kk
6781 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6782 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6784 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6785 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6788 cd write (iout,*) 'sred_geom=',sred_geom,
6789 cd & ' ekont=',ekont,' fprim=',fprimcont,
6790 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6791 cd write (iout,*) "g_contij",g_contij
6792 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6793 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6794 call calc_eello(i,jp,i+1,jp1,jj,kk)
6795 if (wcorr4.gt.0.0d0)
6796 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6797 if (energy_dec.and.wcorr4.gt.0.0d0)
6798 1 write (iout,'(a6,4i5,0pf7.3)')
6799 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6800 c write (iout,*) "gradcorr5 before eello5"
6802 c write (iout,'(i5,3f10.5)')
6803 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6805 if (wcorr5.gt.0.0d0)
6806 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6807 c write (iout,*) "gradcorr5 after eello5"
6809 c write (iout,'(i5,3f10.5)')
6810 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6812 if (energy_dec.and.wcorr5.gt.0.0d0)
6813 1 write (iout,'(a6,4i5,0pf7.3)')
6814 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6815 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6816 cd write(2,*)'ijkl',i,jp,i+1,jp1
6817 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6818 & .or. wturn6.eq.0.0d0))then
6819 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6820 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6821 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6822 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6823 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6824 cd & 'ecorr6=',ecorr6
6825 cd write (iout,'(4e15.5)') sred_geom,
6826 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6827 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6828 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6829 else if (wturn6.gt.0.0d0
6830 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6831 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6832 eturn6=eturn6+eello_turn6(i,jj,kk)
6833 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6834 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6835 cd write (2,*) 'multibody_eello:eturn6',eturn6
6844 num_cont_hb(i)=num_cont_hb_old(i)
6846 c write (iout,*) "gradcorr5 in eello5"
6848 c write (iout,'(i5,3f10.5)')
6849 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6853 c------------------------------------------------------------------------------
6854 subroutine add_hb_contact_eello(ii,jj,itask)
6855 implicit real*8 (a-h,o-z)
6856 include "DIMENSIONS"
6857 include "COMMON.IOUNITS"
6860 parameter (max_cont=maxconts)
6861 parameter (max_dim=70)
6862 include "COMMON.CONTACTS"
6863 double precision zapas(max_dim,maxconts,max_fg_procs),
6864 & zapas_recv(max_dim,maxconts,max_fg_procs)
6865 common /przechowalnia/ zapas
6866 integer i,j,ii,jj,iproc,itask(4),nn
6867 c write (iout,*) "itask",itask
6870 if (iproc.gt.0) then
6871 do j=1,num_cont_hb(ii)
6873 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6875 ncont_sent(iproc)=ncont_sent(iproc)+1
6876 nn=ncont_sent(iproc)
6877 zapas(1,nn,iproc)=ii
6878 zapas(2,nn,iproc)=jjc
6879 zapas(3,nn,iproc)=d_cont(j,ii)
6883 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6888 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6896 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6908 c------------------------------------------------------------------------------
6909 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6910 implicit real*8 (a-h,o-z)
6911 include 'DIMENSIONS'
6912 include 'COMMON.IOUNITS'
6913 include 'COMMON.DERIV'
6914 include 'COMMON.INTERACT'
6915 include 'COMMON.CONTACTS'
6916 double precision gx(3),gx1(3)
6926 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6927 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6928 C Following 4 lines for diagnostics.
6933 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6934 c & 'Contacts ',i,j,
6935 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6936 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6938 C Calculate the multi-body contribution to energy.
6939 c ecorr=ecorr+ekont*ees
6940 C Calculate multi-body contributions to the gradient.
6941 coeffpees0pij=coeffp*ees0pij
6942 coeffmees0mij=coeffm*ees0mij
6943 coeffpees0pkl=coeffp*ees0pkl
6944 coeffmees0mkl=coeffm*ees0mkl
6946 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6947 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6948 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6949 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6950 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6951 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6952 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6953 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6954 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6955 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6956 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6957 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6958 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6959 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6960 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6961 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6962 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6963 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6964 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6965 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6966 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6967 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6968 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6969 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6970 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6975 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6976 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6977 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6978 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6983 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6984 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6985 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6986 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6989 c write (iout,*) "ehbcorr",ekont*ees
6994 C---------------------------------------------------------------------------
6995 subroutine dipole(i,j,jj)
6996 implicit real*8 (a-h,o-z)
6997 include 'DIMENSIONS'
6998 include 'COMMON.IOUNITS'
6999 include 'COMMON.CHAIN'
7000 include 'COMMON.FFIELD'
7001 include 'COMMON.DERIV'
7002 include 'COMMON.INTERACT'
7003 include 'COMMON.CONTACTS'
7004 include 'COMMON.TORSION'
7005 include 'COMMON.VAR'
7006 include 'COMMON.GEO'
7007 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7009 iti1 = itortyp(itype(i+1))
7010 if (j.lt.nres-1) then
7011 itj1 = itortyp(itype(j+1))
7016 dipi(iii,1)=Ub2(iii,i)
7017 dipderi(iii)=Ub2der(iii,i)
7018 dipi(iii,2)=b1(iii,iti1)
7019 dipj(iii,1)=Ub2(iii,j)
7020 dipderj(iii)=Ub2der(iii,j)
7021 dipj(iii,2)=b1(iii,itj1)
7025 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7028 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7035 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7039 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7044 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7045 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7047 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7049 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7051 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7056 C---------------------------------------------------------------------------
7057 subroutine calc_eello(i,j,k,l,jj,kk)
7059 C This subroutine computes matrices and vectors needed to calculate
7060 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7062 implicit real*8 (a-h,o-z)
7063 include 'DIMENSIONS'
7064 include 'COMMON.IOUNITS'
7065 include 'COMMON.CHAIN'
7066 include 'COMMON.DERIV'
7067 include 'COMMON.INTERACT'
7068 include 'COMMON.CONTACTS'
7069 include 'COMMON.TORSION'
7070 include 'COMMON.VAR'
7071 include 'COMMON.GEO'
7072 include 'COMMON.FFIELD'
7073 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7074 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7077 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7078 cd & ' jj=',jj,' kk=',kk
7079 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7080 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7081 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7084 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7085 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7088 call transpose2(aa1(1,1),aa1t(1,1))
7089 call transpose2(aa2(1,1),aa2t(1,1))
7092 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7093 & aa1tder(1,1,lll,kkk))
7094 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7095 & aa2tder(1,1,lll,kkk))
7099 C parallel orientation of the two CA-CA-CA frames.
7101 iti=itortyp(itype(i))
7105 itk1=itortyp(itype(k+1))
7106 itj=itortyp(itype(j))
7107 if (l.lt.nres-1) then
7108 itl1=itortyp(itype(l+1))
7112 C A1 kernel(j+1) A2T
7114 cd write (iout,'(3f10.5,5x,3f10.5)')
7115 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7117 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7118 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7119 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7120 C Following matrices are needed only for 6-th order cumulants
7121 IF (wcorr6.gt.0.0d0) THEN
7122 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7123 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7124 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7125 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7126 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7127 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7128 & ADtEAderx(1,1,1,1,1,1))
7130 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7131 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7132 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7133 & ADtEA1derx(1,1,1,1,1,1))
7135 C End 6-th order cumulants
7138 cd write (2,*) 'In calc_eello6'
7140 cd write (2,*) 'iii=',iii
7142 cd write (2,*) 'kkk=',kkk
7144 cd write (2,'(3(2f10.5),5x)')
7145 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7150 call transpose2(EUgder(1,1,k),auxmat(1,1))
7151 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7152 call transpose2(EUg(1,1,k),auxmat(1,1))
7153 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7154 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7158 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7159 & EAEAderx(1,1,lll,kkk,iii,1))
7163 C A1T kernel(i+1) A2
7164 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7165 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7166 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7167 C Following matrices are needed only for 6-th order cumulants
7168 IF (wcorr6.gt.0.0d0) THEN
7169 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7170 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7171 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7172 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7173 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7174 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7175 & ADtEAderx(1,1,1,1,1,2))
7176 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7177 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7178 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7179 & ADtEA1derx(1,1,1,1,1,2))
7181 C End 6-th order cumulants
7182 call transpose2(EUgder(1,1,l),auxmat(1,1))
7183 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7184 call transpose2(EUg(1,1,l),auxmat(1,1))
7185 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7186 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7190 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7191 & EAEAderx(1,1,lll,kkk,iii,2))
7196 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7197 C They are needed only when the fifth- or the sixth-order cumulants are
7199 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7200 call transpose2(AEA(1,1,1),auxmat(1,1))
7201 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7202 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7203 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7204 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7205 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7206 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7207 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7208 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7209 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7210 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7211 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7212 call transpose2(AEA(1,1,2),auxmat(1,1))
7213 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7214 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7215 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7216 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7217 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7218 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7219 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7220 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7221 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7222 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7223 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7224 C Calculate the Cartesian derivatives of the vectors.
7228 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7229 call matvec2(auxmat(1,1),b1(1,iti),
7230 & AEAb1derx(1,lll,kkk,iii,1,1))
7231 call matvec2(auxmat(1,1),Ub2(1,i),
7232 & AEAb2derx(1,lll,kkk,iii,1,1))
7233 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7234 & AEAb1derx(1,lll,kkk,iii,2,1))
7235 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7236 & AEAb2derx(1,lll,kkk,iii,2,1))
7237 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7238 call matvec2(auxmat(1,1),b1(1,itj),
7239 & AEAb1derx(1,lll,kkk,iii,1,2))
7240 call matvec2(auxmat(1,1),Ub2(1,j),
7241 & AEAb2derx(1,lll,kkk,iii,1,2))
7242 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7243 & AEAb1derx(1,lll,kkk,iii,2,2))
7244 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7245 & AEAb2derx(1,lll,kkk,iii,2,2))
7252 C Antiparallel orientation of the two CA-CA-CA frames.
7254 iti=itortyp(itype(i))
7258 itk1=itortyp(itype(k+1))
7259 itl=itortyp(itype(l))
7260 itj=itortyp(itype(j))
7261 if (j.lt.nres-1) then
7262 itj1=itortyp(itype(j+1))
7266 C A2 kernel(j-1)T A1T
7267 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7268 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7269 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7270 C Following matrices are needed only for 6-th order cumulants
7271 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7272 & j.eq.i+4 .and. l.eq.i+3)) THEN
7273 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7274 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7275 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7276 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7277 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7278 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7279 & ADtEAderx(1,1,1,1,1,1))
7280 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7281 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7282 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7283 & ADtEA1derx(1,1,1,1,1,1))
7285 C End 6-th order cumulants
7286 call transpose2(EUgder(1,1,k),auxmat(1,1))
7287 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7288 call transpose2(EUg(1,1,k),auxmat(1,1))
7289 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7290 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7294 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7295 & EAEAderx(1,1,lll,kkk,iii,1))
7299 C A2T kernel(i+1)T A1
7300 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7301 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7302 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7303 C Following matrices are needed only for 6-th order cumulants
7304 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7305 & j.eq.i+4 .and. l.eq.i+3)) THEN
7306 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7307 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7308 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7309 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7310 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7311 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7312 & ADtEAderx(1,1,1,1,1,2))
7313 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7314 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7315 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7316 & ADtEA1derx(1,1,1,1,1,2))
7318 C End 6-th order cumulants
7319 call transpose2(EUgder(1,1,j),auxmat(1,1))
7320 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7321 call transpose2(EUg(1,1,j),auxmat(1,1))
7322 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7323 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7327 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7328 & EAEAderx(1,1,lll,kkk,iii,2))
7333 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7334 C They are needed only when the fifth- or the sixth-order cumulants are
7336 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7337 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7338 call transpose2(AEA(1,1,1),auxmat(1,1))
7339 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7340 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7341 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7342 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7343 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7344 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7345 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7346 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7347 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7348 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7349 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7350 call transpose2(AEA(1,1,2),auxmat(1,1))
7351 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7352 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7353 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7354 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7355 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7356 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7357 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7358 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7359 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7360 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7361 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7362 C Calculate the Cartesian derivatives of the vectors.
7366 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7367 call matvec2(auxmat(1,1),b1(1,iti),
7368 & AEAb1derx(1,lll,kkk,iii,1,1))
7369 call matvec2(auxmat(1,1),Ub2(1,i),
7370 & AEAb2derx(1,lll,kkk,iii,1,1))
7371 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7372 & AEAb1derx(1,lll,kkk,iii,2,1))
7373 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7374 & AEAb2derx(1,lll,kkk,iii,2,1))
7375 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7376 call matvec2(auxmat(1,1),b1(1,itl),
7377 & AEAb1derx(1,lll,kkk,iii,1,2))
7378 call matvec2(auxmat(1,1),Ub2(1,l),
7379 & AEAb2derx(1,lll,kkk,iii,1,2))
7380 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7381 & AEAb1derx(1,lll,kkk,iii,2,2))
7382 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7383 & AEAb2derx(1,lll,kkk,iii,2,2))
7392 C---------------------------------------------------------------------------
7393 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7394 & KK,KKderg,AKA,AKAderg,AKAderx)
7398 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7399 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7400 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7405 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7407 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7410 cd if (lprn) write (2,*) 'In kernel'
7412 cd if (lprn) write (2,*) 'kkk=',kkk
7414 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7415 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7417 cd write (2,*) 'lll=',lll
7418 cd write (2,*) 'iii=1'
7420 cd write (2,'(3(2f10.5),5x)')
7421 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7424 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7425 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7427 cd write (2,*) 'lll=',lll
7428 cd write (2,*) 'iii=2'
7430 cd write (2,'(3(2f10.5),5x)')
7431 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7438 C---------------------------------------------------------------------------
7439 double precision function eello4(i,j,k,l,jj,kk)
7440 implicit real*8 (a-h,o-z)
7441 include 'DIMENSIONS'
7442 include 'COMMON.IOUNITS'
7443 include 'COMMON.CHAIN'
7444 include 'COMMON.DERIV'
7445 include 'COMMON.INTERACT'
7446 include 'COMMON.CONTACTS'
7447 include 'COMMON.TORSION'
7448 include 'COMMON.VAR'
7449 include 'COMMON.GEO'
7450 double precision pizda(2,2),ggg1(3),ggg2(3)
7451 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7455 cd print *,'eello4:',i,j,k,l,jj,kk
7456 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7457 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7458 cold eij=facont_hb(jj,i)
7459 cold ekl=facont_hb(kk,k)
7461 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7462 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7463 gcorr_loc(k-1)=gcorr_loc(k-1)
7464 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7466 gcorr_loc(l-1)=gcorr_loc(l-1)
7467 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7469 gcorr_loc(j-1)=gcorr_loc(j-1)
7470 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7475 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7476 & -EAEAderx(2,2,lll,kkk,iii,1)
7477 cd derx(lll,kkk,iii)=0.0d0
7481 cd gcorr_loc(l-1)=0.0d0
7482 cd gcorr_loc(j-1)=0.0d0
7483 cd gcorr_loc(k-1)=0.0d0
7485 cd write (iout,*)'Contacts have occurred for peptide groups',
7486 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7487 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7488 if (j.lt.nres-1) then
7495 if (l.lt.nres-1) then
7503 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7504 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7505 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7506 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7507 cgrad ghalf=0.5d0*ggg1(ll)
7508 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7509 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7510 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7511 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7512 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7513 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7514 cgrad ghalf=0.5d0*ggg2(ll)
7515 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7516 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7517 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7518 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7519 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7520 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7524 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7529 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7534 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7539 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7543 cd write (2,*) iii,gcorr_loc(iii)
7546 cd write (2,*) 'ekont',ekont
7547 cd write (iout,*) 'eello4',ekont*eel4
7550 C---------------------------------------------------------------------------
7551 double precision function eello5(i,j,k,l,jj,kk)
7552 implicit real*8 (a-h,o-z)
7553 include 'DIMENSIONS'
7554 include 'COMMON.IOUNITS'
7555 include 'COMMON.CHAIN'
7556 include 'COMMON.DERIV'
7557 include 'COMMON.INTERACT'
7558 include 'COMMON.CONTACTS'
7559 include 'COMMON.TORSION'
7560 include 'COMMON.VAR'
7561 include 'COMMON.GEO'
7562 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7563 double precision ggg1(3),ggg2(3)
7564 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7569 C /l\ / \ \ / \ / \ / C
7570 C / \ / \ \ / \ / \ / C
7571 C j| o |l1 | o | o| o | | o |o C
7572 C \ |/k\| |/ \| / |/ \| |/ \| C
7573 C \i/ \ / \ / / \ / \ C
7575 C (I) (II) (III) (IV) C
7577 C eello5_1 eello5_2 eello5_3 eello5_4 C
7579 C Antiparallel chains C
7582 C /j\ / \ \ / \ / \ / C
7583 C / \ / \ \ / \ / \ / C
7584 C j1| o |l | o | o| o | | o |o C
7585 C \ |/k\| |/ \| / |/ \| |/ \| C
7586 C \i/ \ / \ / / \ / \ C
7588 C (I) (II) (III) (IV) C
7590 C eello5_1 eello5_2 eello5_3 eello5_4 C
7592 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7594 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7595 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7600 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7602 itk=itortyp(itype(k))
7603 itl=itortyp(itype(l))
7604 itj=itortyp(itype(j))
7609 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7610 cd & eel5_3_num,eel5_4_num)
7614 derx(lll,kkk,iii)=0.0d0
7618 cd eij=facont_hb(jj,i)
7619 cd ekl=facont_hb(kk,k)
7621 cd write (iout,*)'Contacts have occurred for peptide groups',
7622 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7624 C Contribution from the graph I.
7625 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7626 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7627 call transpose2(EUg(1,1,k),auxmat(1,1))
7628 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7629 vv(1)=pizda(1,1)-pizda(2,2)
7630 vv(2)=pizda(1,2)+pizda(2,1)
7631 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7632 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7633 C Explicit gradient in virtual-dihedral angles.
7634 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7635 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7636 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7637 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7638 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7639 vv(1)=pizda(1,1)-pizda(2,2)
7640 vv(2)=pizda(1,2)+pizda(2,1)
7641 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7642 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7643 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7644 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7645 vv(1)=pizda(1,1)-pizda(2,2)
7646 vv(2)=pizda(1,2)+pizda(2,1)
7648 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7649 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7650 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7652 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7653 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7654 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7656 C Cartesian gradient
7660 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7662 vv(1)=pizda(1,1)-pizda(2,2)
7663 vv(2)=pizda(1,2)+pizda(2,1)
7664 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7665 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7666 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7672 C Contribution from graph II
7673 call transpose2(EE(1,1,itk),auxmat(1,1))
7674 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7675 vv(1)=pizda(1,1)+pizda(2,2)
7676 vv(2)=pizda(2,1)-pizda(1,2)
7677 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7678 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7679 C Explicit gradient in virtual-dihedral angles.
7680 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7681 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7682 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7683 vv(1)=pizda(1,1)+pizda(2,2)
7684 vv(2)=pizda(2,1)-pizda(1,2)
7686 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7687 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7688 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7690 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7691 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7692 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7694 C Cartesian gradient
7698 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7700 vv(1)=pizda(1,1)+pizda(2,2)
7701 vv(2)=pizda(2,1)-pizda(1,2)
7702 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7703 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7704 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7712 C Parallel orientation
7713 C Contribution from graph III
7714 call transpose2(EUg(1,1,l),auxmat(1,1))
7715 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7716 vv(1)=pizda(1,1)-pizda(2,2)
7717 vv(2)=pizda(1,2)+pizda(2,1)
7718 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7719 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7720 C Explicit gradient in virtual-dihedral angles.
7721 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7722 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7723 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7724 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7725 vv(1)=pizda(1,1)-pizda(2,2)
7726 vv(2)=pizda(1,2)+pizda(2,1)
7727 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7728 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7729 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7730 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7731 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7732 vv(1)=pizda(1,1)-pizda(2,2)
7733 vv(2)=pizda(1,2)+pizda(2,1)
7734 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7735 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7736 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7737 C Cartesian gradient
7741 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7743 vv(1)=pizda(1,1)-pizda(2,2)
7744 vv(2)=pizda(1,2)+pizda(2,1)
7745 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7746 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7747 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7752 C Contribution from graph IV
7754 call transpose2(EE(1,1,itl),auxmat(1,1))
7755 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7756 vv(1)=pizda(1,1)+pizda(2,2)
7757 vv(2)=pizda(2,1)-pizda(1,2)
7758 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7759 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7760 C Explicit gradient in virtual-dihedral angles.
7761 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7762 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7763 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7764 vv(1)=pizda(1,1)+pizda(2,2)
7765 vv(2)=pizda(2,1)-pizda(1,2)
7766 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7767 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7768 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7769 C Cartesian gradient
7773 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7775 vv(1)=pizda(1,1)+pizda(2,2)
7776 vv(2)=pizda(2,1)-pizda(1,2)
7777 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7778 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7779 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7784 C Antiparallel orientation
7785 C Contribution from graph III
7787 call transpose2(EUg(1,1,j),auxmat(1,1))
7788 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7789 vv(1)=pizda(1,1)-pizda(2,2)
7790 vv(2)=pizda(1,2)+pizda(2,1)
7791 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7792 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7793 C Explicit gradient in virtual-dihedral angles.
7794 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7795 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7796 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7797 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7798 vv(1)=pizda(1,1)-pizda(2,2)
7799 vv(2)=pizda(1,2)+pizda(2,1)
7800 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7801 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7802 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7803 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7804 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7805 vv(1)=pizda(1,1)-pizda(2,2)
7806 vv(2)=pizda(1,2)+pizda(2,1)
7807 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7808 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7809 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7810 C Cartesian gradient
7814 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7816 vv(1)=pizda(1,1)-pizda(2,2)
7817 vv(2)=pizda(1,2)+pizda(2,1)
7818 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7819 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7820 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7825 C Contribution from graph IV
7827 call transpose2(EE(1,1,itj),auxmat(1,1))
7828 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7829 vv(1)=pizda(1,1)+pizda(2,2)
7830 vv(2)=pizda(2,1)-pizda(1,2)
7831 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7832 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7833 C Explicit gradient in virtual-dihedral angles.
7834 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7835 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7836 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7837 vv(1)=pizda(1,1)+pizda(2,2)
7838 vv(2)=pizda(2,1)-pizda(1,2)
7839 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7840 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7841 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7842 C Cartesian gradient
7846 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7848 vv(1)=pizda(1,1)+pizda(2,2)
7849 vv(2)=pizda(2,1)-pizda(1,2)
7850 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7851 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7852 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7858 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7859 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7860 cd write (2,*) 'ijkl',i,j,k,l
7861 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7862 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7864 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7865 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7866 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7867 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7868 if (j.lt.nres-1) then
7875 if (l.lt.nres-1) then
7885 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7886 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7887 C summed up outside the subrouine as for the other subroutines
7888 C handling long-range interactions. The old code is commented out
7889 C with "cgrad" to keep track of changes.
7891 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7892 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7893 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7894 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7895 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7896 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7897 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7898 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7899 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7900 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7902 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7903 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7904 cgrad ghalf=0.5d0*ggg1(ll)
7906 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7907 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7908 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7909 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7910 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7911 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7912 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7913 cgrad ghalf=0.5d0*ggg2(ll)
7915 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
7916 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7917 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
7918 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7919 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7920 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7925 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7926 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7931 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7932 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7938 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7943 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7947 cd write (2,*) iii,g_corr5_loc(iii)
7950 cd write (2,*) 'ekont',ekont
7951 cd write (iout,*) 'eello5',ekont*eel5
7954 c--------------------------------------------------------------------------
7955 double precision function eello6(i,j,k,l,jj,kk)
7956 implicit real*8 (a-h,o-z)
7957 include 'DIMENSIONS'
7958 include 'COMMON.IOUNITS'
7959 include 'COMMON.CHAIN'
7960 include 'COMMON.DERIV'
7961 include 'COMMON.INTERACT'
7962 include 'COMMON.CONTACTS'
7963 include 'COMMON.TORSION'
7964 include 'COMMON.VAR'
7965 include 'COMMON.GEO'
7966 include 'COMMON.FFIELD'
7967 double precision ggg1(3),ggg2(3)
7968 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7973 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7981 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7982 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7986 derx(lll,kkk,iii)=0.0d0
7990 cd eij=facont_hb(jj,i)
7991 cd ekl=facont_hb(kk,k)
7997 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7998 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7999 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8000 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8001 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8002 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8004 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8005 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8006 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8007 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8008 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8009 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8013 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8015 C If turn contributions are considered, they will be handled separately.
8016 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8017 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8018 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8019 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8020 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8021 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8022 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8024 if (j.lt.nres-1) then
8031 if (l.lt.nres-1) then
8039 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8040 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8041 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8042 cgrad ghalf=0.5d0*ggg1(ll)
8044 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8045 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8046 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8047 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8048 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8049 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8050 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8051 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8052 cgrad ghalf=0.5d0*ggg2(ll)
8053 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8055 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8056 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8057 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8058 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8059 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8060 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8065 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8066 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8071 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8072 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8078 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8083 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8087 cd write (2,*) iii,g_corr6_loc(iii)
8090 cd write (2,*) 'ekont',ekont
8091 cd write (iout,*) 'eello6',ekont*eel6
8094 c--------------------------------------------------------------------------
8095 double precision function eello6_graph1(i,j,k,l,imat,swap)
8096 implicit real*8 (a-h,o-z)
8097 include 'DIMENSIONS'
8098 include 'COMMON.IOUNITS'
8099 include 'COMMON.CHAIN'
8100 include 'COMMON.DERIV'
8101 include 'COMMON.INTERACT'
8102 include 'COMMON.CONTACTS'
8103 include 'COMMON.TORSION'
8104 include 'COMMON.VAR'
8105 include 'COMMON.GEO'
8106 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8110 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8112 C Parallel Antiparallel C
8118 C \ j|/k\| / \ |/k\|l / C
8123 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8124 itk=itortyp(itype(k))
8125 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8126 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8127 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8128 call transpose2(EUgC(1,1,k),auxmat(1,1))
8129 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8130 vv1(1)=pizda1(1,1)-pizda1(2,2)
8131 vv1(2)=pizda1(1,2)+pizda1(2,1)
8132 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8133 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8134 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8135 s5=scalar2(vv(1),Dtobr2(1,i))
8136 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8137 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8138 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8139 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8140 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8141 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8142 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8143 & +scalar2(vv(1),Dtobr2der(1,i)))
8144 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8145 vv1(1)=pizda1(1,1)-pizda1(2,2)
8146 vv1(2)=pizda1(1,2)+pizda1(2,1)
8147 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8148 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8150 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8151 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8152 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8153 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8154 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8156 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8157 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8158 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8159 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8160 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8162 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8163 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8164 vv1(1)=pizda1(1,1)-pizda1(2,2)
8165 vv1(2)=pizda1(1,2)+pizda1(2,1)
8166 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8167 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8168 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8169 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8178 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8179 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8180 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8181 call transpose2(EUgC(1,1,k),auxmat(1,1))
8182 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8184 vv1(1)=pizda1(1,1)-pizda1(2,2)
8185 vv1(2)=pizda1(1,2)+pizda1(2,1)
8186 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8187 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8188 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8189 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8190 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8191 s5=scalar2(vv(1),Dtobr2(1,i))
8192 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8198 c----------------------------------------------------------------------------
8199 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8200 implicit real*8 (a-h,o-z)
8201 include 'DIMENSIONS'
8202 include 'COMMON.IOUNITS'
8203 include 'COMMON.CHAIN'
8204 include 'COMMON.DERIV'
8205 include 'COMMON.INTERACT'
8206 include 'COMMON.CONTACTS'
8207 include 'COMMON.TORSION'
8208 include 'COMMON.VAR'
8209 include 'COMMON.GEO'
8211 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8212 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8215 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8217 C Parallel Antiparallel C
8223 C \ j|/k\| \ |/k\|l C
8228 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8229 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8230 C AL 7/4/01 s1 would occur in the sixth-order moment,
8231 C but not in a cluster cumulant
8233 s1=dip(1,jj,i)*dip(1,kk,k)
8235 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8236 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8237 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8238 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8239 call transpose2(EUg(1,1,k),auxmat(1,1))
8240 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8241 vv(1)=pizda(1,1)-pizda(2,2)
8242 vv(2)=pizda(1,2)+pizda(2,1)
8243 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8244 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8246 eello6_graph2=-(s1+s2+s3+s4)
8248 eello6_graph2=-(s2+s3+s4)
8251 C Derivatives in gamma(i-1)
8254 s1=dipderg(1,jj,i)*dip(1,kk,k)
8256 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8257 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8258 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8259 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8261 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8263 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8265 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8267 C Derivatives in gamma(k-1)
8269 s1=dip(1,jj,i)*dipderg(1,kk,k)
8271 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8272 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8273 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8274 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8275 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8276 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8277 vv(1)=pizda(1,1)-pizda(2,2)
8278 vv(2)=pizda(1,2)+pizda(2,1)
8279 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8281 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8283 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8285 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8286 C Derivatives in gamma(j-1) or gamma(l-1)
8289 s1=dipderg(3,jj,i)*dip(1,kk,k)
8291 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8292 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8293 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8294 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8295 vv(1)=pizda(1,1)-pizda(2,2)
8296 vv(2)=pizda(1,2)+pizda(2,1)
8297 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8300 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8302 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8305 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8306 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8308 C Derivatives in gamma(l-1) or gamma(j-1)
8311 s1=dip(1,jj,i)*dipderg(3,kk,k)
8313 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8314 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8315 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8316 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8317 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8318 vv(1)=pizda(1,1)-pizda(2,2)
8319 vv(2)=pizda(1,2)+pizda(2,1)
8320 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8323 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8325 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8328 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8329 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8331 C Cartesian derivatives.
8333 write (2,*) 'In eello6_graph2'
8335 write (2,*) 'iii=',iii
8337 write (2,*) 'kkk=',kkk
8339 write (2,'(3(2f10.5),5x)')
8340 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8350 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8352 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8355 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8357 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8358 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8360 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8361 call transpose2(EUg(1,1,k),auxmat(1,1))
8362 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8364 vv(1)=pizda(1,1)-pizda(2,2)
8365 vv(2)=pizda(1,2)+pizda(2,1)
8366 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8367 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8369 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8371 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8374 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8376 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8383 c----------------------------------------------------------------------------
8384 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8385 implicit real*8 (a-h,o-z)
8386 include 'DIMENSIONS'
8387 include 'COMMON.IOUNITS'
8388 include 'COMMON.CHAIN'
8389 include 'COMMON.DERIV'
8390 include 'COMMON.INTERACT'
8391 include 'COMMON.CONTACTS'
8392 include 'COMMON.TORSION'
8393 include 'COMMON.VAR'
8394 include 'COMMON.GEO'
8395 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8397 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8399 C Parallel Antiparallel C
8405 C j|/k\| / |/k\|l / C
8410 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8412 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8413 C energy moment and not to the cluster cumulant.
8414 iti=itortyp(itype(i))
8415 if (j.lt.nres-1) then
8416 itj1=itortyp(itype(j+1))
8420 itk=itortyp(itype(k))
8421 itk1=itortyp(itype(k+1))
8422 if (l.lt.nres-1) then
8423 itl1=itortyp(itype(l+1))
8428 s1=dip(4,jj,i)*dip(4,kk,k)
8430 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8431 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8432 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8433 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8434 call transpose2(EE(1,1,itk),auxmat(1,1))
8435 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8436 vv(1)=pizda(1,1)+pizda(2,2)
8437 vv(2)=pizda(2,1)-pizda(1,2)
8438 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8439 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8440 cd & "sum",-(s2+s3+s4)
8442 eello6_graph3=-(s1+s2+s3+s4)
8444 eello6_graph3=-(s2+s3+s4)
8447 C Derivatives in gamma(k-1)
8448 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8449 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8450 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8451 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8452 C Derivatives in gamma(l-1)
8453 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8454 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8455 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8456 vv(1)=pizda(1,1)+pizda(2,2)
8457 vv(2)=pizda(2,1)-pizda(1,2)
8458 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8459 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8460 C Cartesian derivatives.
8466 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8468 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8471 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8473 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8474 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8476 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8477 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8479 vv(1)=pizda(1,1)+pizda(2,2)
8480 vv(2)=pizda(2,1)-pizda(1,2)
8481 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8483 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8485 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8488 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8490 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8492 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8498 c----------------------------------------------------------------------------
8499 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8500 implicit real*8 (a-h,o-z)
8501 include 'DIMENSIONS'
8502 include 'COMMON.IOUNITS'
8503 include 'COMMON.CHAIN'
8504 include 'COMMON.DERIV'
8505 include 'COMMON.INTERACT'
8506 include 'COMMON.CONTACTS'
8507 include 'COMMON.TORSION'
8508 include 'COMMON.VAR'
8509 include 'COMMON.GEO'
8510 include 'COMMON.FFIELD'
8511 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8512 & auxvec1(2),auxmat1(2,2)
8514 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8516 C Parallel Antiparallel C
8522 C \ j|/k\| \ |/k\|l C
8527 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8529 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8530 C energy moment and not to the cluster cumulant.
8531 cd write (2,*) 'eello_graph4: wturn6',wturn6
8532 iti=itortyp(itype(i))
8533 itj=itortyp(itype(j))
8534 if (j.lt.nres-1) then
8535 itj1=itortyp(itype(j+1))
8539 itk=itortyp(itype(k))
8540 if (k.lt.nres-1) then
8541 itk1=itortyp(itype(k+1))
8545 itl=itortyp(itype(l))
8546 if (l.lt.nres-1) then
8547 itl1=itortyp(itype(l+1))
8551 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8552 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8553 cd & ' itl',itl,' itl1',itl1
8556 s1=dip(3,jj,i)*dip(3,kk,k)
8558 s1=dip(2,jj,j)*dip(2,kk,l)
8561 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8562 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8564 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8565 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8567 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8568 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8570 call transpose2(EUg(1,1,k),auxmat(1,1))
8571 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8572 vv(1)=pizda(1,1)-pizda(2,2)
8573 vv(2)=pizda(2,1)+pizda(1,2)
8574 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8575 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8577 eello6_graph4=-(s1+s2+s3+s4)
8579 eello6_graph4=-(s2+s3+s4)
8581 C Derivatives in gamma(i-1)
8585 s1=dipderg(2,jj,i)*dip(3,kk,k)
8587 s1=dipderg(4,jj,j)*dip(2,kk,l)
8590 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8592 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8593 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8595 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8596 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8598 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8599 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8600 cd write (2,*) 'turn6 derivatives'
8602 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8604 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8608 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8610 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8614 C Derivatives in gamma(k-1)
8617 s1=dip(3,jj,i)*dipderg(2,kk,k)
8619 s1=dip(2,jj,j)*dipderg(4,kk,l)
8622 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8623 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8625 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8626 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8628 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8629 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8631 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8632 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8633 vv(1)=pizda(1,1)-pizda(2,2)
8634 vv(2)=pizda(2,1)+pizda(1,2)
8635 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8636 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8638 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8640 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8644 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8646 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8649 C Derivatives in gamma(j-1) or gamma(l-1)
8650 if (l.eq.j+1 .and. l.gt.1) then
8651 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8652 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8653 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8654 vv(1)=pizda(1,1)-pizda(2,2)
8655 vv(2)=pizda(2,1)+pizda(1,2)
8656 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8657 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8658 else if (j.gt.1) then
8659 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8660 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8661 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8662 vv(1)=pizda(1,1)-pizda(2,2)
8663 vv(2)=pizda(2,1)+pizda(1,2)
8664 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8665 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8666 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8668 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8671 C Cartesian derivatives.
8678 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8680 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8684 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8686 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8690 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8692 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8694 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8695 & b1(1,itj1),auxvec(1))
8696 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8698 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8699 & b1(1,itl1),auxvec(1))
8700 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8702 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8704 vv(1)=pizda(1,1)-pizda(2,2)
8705 vv(2)=pizda(2,1)+pizda(1,2)
8706 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8708 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8710 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8713 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8716 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8719 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8721 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8723 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8727 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8729 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8732 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8734 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8742 c----------------------------------------------------------------------------
8743 double precision function eello_turn6(i,jj,kk)
8744 implicit real*8 (a-h,o-z)
8745 include 'DIMENSIONS'
8746 include 'COMMON.IOUNITS'
8747 include 'COMMON.CHAIN'
8748 include 'COMMON.DERIV'
8749 include 'COMMON.INTERACT'
8750 include 'COMMON.CONTACTS'
8751 include 'COMMON.TORSION'
8752 include 'COMMON.VAR'
8753 include 'COMMON.GEO'
8754 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8755 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8757 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8758 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8759 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8760 C the respective energy moment and not to the cluster cumulant.
8769 iti=itortyp(itype(i))
8770 itk=itortyp(itype(k))
8771 itk1=itortyp(itype(k+1))
8772 itl=itortyp(itype(l))
8773 itj=itortyp(itype(j))
8774 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8775 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8776 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8781 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8783 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8787 derx_turn(lll,kkk,iii)=0.0d0
8794 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8796 cd write (2,*) 'eello6_5',eello6_5
8798 call transpose2(AEA(1,1,1),auxmat(1,1))
8799 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8800 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8801 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8803 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8804 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8805 s2 = scalar2(b1(1,itk),vtemp1(1))
8807 call transpose2(AEA(1,1,2),atemp(1,1))
8808 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8809 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8810 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8812 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8813 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8814 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8816 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8817 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8818 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8819 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8820 ss13 = scalar2(b1(1,itk),vtemp4(1))
8821 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8823 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8829 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8830 C Derivatives in gamma(i+2)
8834 call transpose2(AEA(1,1,1),auxmatd(1,1))
8835 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8836 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8837 call transpose2(AEAderg(1,1,2),atempd(1,1))
8838 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8839 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8841 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8842 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8843 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8849 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8850 C Derivatives in gamma(i+3)
8852 call transpose2(AEA(1,1,1),auxmatd(1,1))
8853 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8854 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8855 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8857 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8858 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8859 s2d = scalar2(b1(1,itk),vtemp1d(1))
8861 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8862 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8864 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8866 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8867 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8868 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8876 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8877 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8879 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8880 & -0.5d0*ekont*(s2d+s12d)
8882 C Derivatives in gamma(i+4)
8883 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8884 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8885 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8887 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8888 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8889 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8897 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8899 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8901 C Derivatives in gamma(i+5)
8903 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8904 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8905 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8907 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8908 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8909 s2d = scalar2(b1(1,itk),vtemp1d(1))
8911 call transpose2(AEA(1,1,2),atempd(1,1))
8912 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8913 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8915 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8916 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8918 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8919 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8920 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8928 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8929 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8931 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8932 & -0.5d0*ekont*(s2d+s12d)
8934 C Cartesian derivatives
8939 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8940 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8941 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8943 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8944 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8946 s2d = scalar2(b1(1,itk),vtemp1d(1))
8948 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8949 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8950 s8d = -(atempd(1,1)+atempd(2,2))*
8951 & scalar2(cc(1,1,itl),vtemp2(1))
8953 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8955 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8956 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8963 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8966 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8970 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8971 & - 0.5d0*(s8d+s12d)
8973 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8982 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8984 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8985 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8986 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8987 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8988 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8990 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8991 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8992 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8996 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8997 cd & 16*eel_turn6_num
8999 if (j.lt.nres-1) then
9006 if (l.lt.nres-1) then
9014 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9015 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9016 cgrad ghalf=0.5d0*ggg1(ll)
9018 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9019 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9020 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9021 & +ekont*derx_turn(ll,2,1)
9022 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9023 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9024 & +ekont*derx_turn(ll,4,1)
9025 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9026 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9027 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9028 cgrad ghalf=0.5d0*ggg2(ll)
9030 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9031 & +ekont*derx_turn(ll,2,2)
9032 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9033 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9034 & +ekont*derx_turn(ll,4,2)
9035 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9036 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9037 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9042 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9047 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9053 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9058 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9062 cd write (2,*) iii,g_corr6_loc(iii)
9064 eello_turn6=ekont*eel_turn6
9065 cd write (2,*) 'ekont',ekont
9066 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9070 C-----------------------------------------------------------------------------
9071 double precision function scalar(u,v)
9072 !DIR$ INLINEALWAYS scalar
9074 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9077 double precision u(3),v(3)
9078 cd double precision sc
9086 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9089 crc-------------------------------------------------
9090 SUBROUTINE MATVEC2(A1,V1,V2)
9091 !DIR$ INLINEALWAYS MATVEC2
9093 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9095 implicit real*8 (a-h,o-z)
9096 include 'DIMENSIONS'
9097 DIMENSION A1(2,2),V1(2),V2(2)
9101 c 3 VI=VI+A1(I,K)*V1(K)
9105 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9106 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9111 C---------------------------------------
9112 SUBROUTINE MATMAT2(A1,A2,A3)
9114 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9116 implicit real*8 (a-h,o-z)
9117 include 'DIMENSIONS'
9118 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9119 c DIMENSION AI3(2,2)
9123 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9129 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9130 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9131 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9132 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9140 c-------------------------------------------------------------------------
9141 double precision function scalar2(u,v)
9142 !DIR$ INLINEALWAYS scalar2
9144 double precision u(2),v(2)
9147 scalar2=u(1)*v(1)+u(2)*v(2)
9151 C-----------------------------------------------------------------------------
9153 subroutine transpose2(a,at)
9154 !DIR$ INLINEALWAYS transpose2
9156 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9159 double precision a(2,2),at(2,2)
9166 c--------------------------------------------------------------------------
9167 subroutine transpose(n,a,at)
9170 double precision a(n,n),at(n,n)
9178 C---------------------------------------------------------------------------
9179 subroutine prodmat3(a1,a2,kk,transp,prod)
9180 !DIR$ INLINEALWAYS prodmat3
9182 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9186 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9188 crc double precision auxmat(2,2),prod_(2,2)
9191 crc call transpose2(kk(1,1),auxmat(1,1))
9192 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9193 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9195 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9196 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9197 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9198 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9199 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9200 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9201 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9202 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9205 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9206 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9208 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9209 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9210 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9211 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9212 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9213 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9214 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9215 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9218 c call transpose2(a2(1,1),a2t(1,1))
9221 crc print *,((prod_(i,j),i=1,2),j=1,2)
9222 crc print *,((prod(i,j),i=1,2),j=1,2)