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.
124 c print *,"Processor",myrank," computed USCSC"
130 time_vec=time_vec+MPI_Wtime()-time01
132 c print *,"Processor",myrank," left VEC_AND_DERIV"
135 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
136 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
137 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
138 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
140 if (welec.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 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
154 c write (iout,*) "Soft-spheer ELEC potential"
155 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
158 c print *,"Processor",myrank," computed UELEC"
160 C Calculate excluded-volume interaction energy between peptide groups
165 call escp(evdw2,evdw2_14)
171 c write (iout,*) "Soft-sphere SCP potential"
172 call escp_soft_sphere(evdw2,evdw2_14)
175 c Calculate the bond-stretching energy
179 C Calculate the disulfide-bridge and other energy and the contributions
180 C from other distance constraints.
181 cd print *,'Calling EHPB'
183 cd print *,'EHPB exitted succesfully.'
185 C Calculate the virtual-bond-angle energy.
187 if (wang.gt.0d0) then
192 c print *,"Processor",myrank," computed UB"
194 C Calculate the SC local energy.
197 c print *,"Processor",myrank," computed USC"
199 C Calculate the virtual-bond torsional energy.
201 cd print *,'nterm=',nterm
203 call etor(etors,edihcnstr)
208 c print *,"Processor",myrank," computed Utor"
210 C 6/23/01 Calculate double-torsional energy
212 if (wtor_d.gt.0) then
217 c print *,"Processor",myrank," computed Utord"
219 C 21/5/07 Calculate local sicdechain correlation energy
221 if (wsccor.gt.0.0d0) then
222 call eback_sc_corr(esccor)
226 c print *,"Processor",myrank," computed Usccorr"
228 C 12/1/95 Multi-body terms
232 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
233 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
234 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
235 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
236 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
243 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
244 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
245 cd write (iout,*) "multibody_hb ecorr",ecorr
247 c print *,"Processor",myrank," computed Ucorr"
249 C If performing constraint dynamics, call the constraint energy
250 C after the equilibration time
251 if(usampl.and.totT.gt.eq_time) then
259 time_enecalc=time_enecalc+MPI_Wtime()-time00
261 c print *,"Processor",myrank," computed Uconstr"
270 energia(2)=evdw2-evdw2_14
287 energia(8)=eello_turn3
288 energia(9)=eello_turn4
295 energia(19)=edihcnstr
297 energia(20)=Uconst+Uconst_back
299 c print *," Processor",myrank," calls SUM_ENERGY"
300 call sum_energy(energia,.true.)
301 c print *," Processor",myrank," left SUM_ENERGY"
303 time_sumene=time_sumene+MPI_Wtime()-time00
307 c-------------------------------------------------------------------------------
308 subroutine sum_energy(energia,reduce)
309 implicit real*8 (a-h,o-z)
314 cMS$ATTRIBUTES C :: proc_proc
320 include 'COMMON.SETUP'
321 include 'COMMON.IOUNITS'
322 double precision energia(0:n_ene),enebuff(0:n_ene+1)
323 include 'COMMON.FFIELD'
324 include 'COMMON.DERIV'
325 include 'COMMON.INTERACT'
326 include 'COMMON.SBRIDGE'
327 include 'COMMON.CHAIN'
329 include 'COMMON.CONTROL'
330 include 'COMMON.TIME1'
333 if (nfgtasks.gt.1 .and. reduce) then
335 write (iout,*) "energies before REDUCE"
336 call enerprint(energia)
340 enebuff(i)=energia(i)
343 call MPI_Barrier(FG_COMM,IERR)
344 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
346 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
347 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
349 write (iout,*) "energies after REDUCE"
350 call enerprint(energia)
353 time_Reduce=time_Reduce+MPI_Wtime()-time00
355 if (fg_rank.eq.0) then
359 evdw2=energia(2)+energia(18)
375 eello_turn3=energia(8)
376 eello_turn4=energia(9)
383 edihcnstr=energia(19)
388 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
389 & +wang*ebe+wtor*etors+wscloc*escloc
390 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
391 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
392 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
393 & +wbond*estr+Uconst+wsccor*esccor
395 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
396 & +wang*ebe+wtor*etors+wscloc*escloc
397 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
398 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
399 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
400 & +wbond*estr+Uconst+wsccor*esccor
406 if (isnan(etot).ne.0) energia(0)=1.0d+99
408 if (isnan(etot)) energia(0)=1.0d+99
413 idumm=proc_proc(etot,i)
415 call proc_proc(etot,i)
417 if(i.eq.1)energia(0)=1.0d+99
424 c-------------------------------------------------------------------------------
425 subroutine sum_gradient
426 implicit real*8 (a-h,o-z)
431 cMS$ATTRIBUTES C :: proc_proc
436 double precision gradbufc(3,maxres),gradbufx(3,maxres),
437 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
439 include 'COMMON.SETUP'
440 include 'COMMON.IOUNITS'
441 include 'COMMON.FFIELD'
442 include 'COMMON.DERIV'
443 include 'COMMON.INTERACT'
444 include 'COMMON.SBRIDGE'
445 include 'COMMON.CHAIN'
447 include 'COMMON.CONTROL'
448 include 'COMMON.TIME1'
449 include 'COMMON.MAXGRAD'
454 write (iout,*) "sum_gradient gvdwc, gvdwx"
456 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
457 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
462 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
463 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
464 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
467 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
468 C in virtual-bond-vector coordinates
471 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
473 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
474 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
476 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
478 c write (iout,'(i5,3f10.5,2x,f10.5)')
479 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
481 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
483 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
484 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
492 gradbufc(j,i)=wsc*gvdwc(j,i)+
493 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
494 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
495 & wel_loc*gel_loc_long(j,i)+
496 & wcorr*gradcorr_long(j,i)+
497 & wcorr5*gradcorr5_long(j,i)+
498 & wcorr6*gradcorr6_long(j,i)+
499 & wturn6*gcorr6_turn_long(j,i)+
506 gradbufc(j,i)=wsc*gvdwc(j,i)+
507 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
508 & welec*gelc_long(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)+
520 if (nfgtasks.gt.1) then
523 write (iout,*) "gradbufc before allreduce"
525 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
531 gradbufc_sum(j,i)=gradbufc(j,i)
534 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
535 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
536 c time_reduce=time_reduce+MPI_Wtime()-time00
538 c write (iout,*) "gradbufc_sum after allreduce"
540 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
545 c time_allreduce=time_allreduce+MPI_Wtime()-time00
553 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
554 write (iout,*) (i," jgrad_start",jgrad_start(i),
555 & " jgrad_end ",jgrad_end(i),
556 & i=igrad_start,igrad_end)
559 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
560 c do not parallelize this part.
562 c do i=igrad_start,igrad_end
563 c do j=jgrad_start(i),jgrad_end(i)
565 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
570 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
574 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
578 write (iout,*) "gradbufc after summing"
580 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
587 write (iout,*) "gradbufc"
589 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
595 gradbufc_sum(j,i)=gradbufc(j,i)
600 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
604 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
609 c gradbufc(k,i)=0.0d0
613 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
618 write (iout,*) "gradbufc after summing"
620 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
628 gradbufc(k,nres)=0.0d0
633 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
634 & wel_loc*gel_loc(j,i)+
635 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
636 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
637 & wel_loc*gel_loc_long(j,i)+
638 & wcorr*gradcorr_long(j,i)+
639 & wcorr5*gradcorr5_long(j,i)+
640 & wcorr6*gradcorr6_long(j,i)+
641 & wturn6*gcorr6_turn_long(j,i))+
643 & wcorr*gradcorr(j,i)+
644 & wturn3*gcorr3_turn(j,i)+
645 & wturn4*gcorr4_turn(j,i)+
646 & wcorr5*gradcorr5(j,i)+
647 & wcorr6*gradcorr6(j,i)+
648 & wturn6*gcorr6_turn(j,i)+
649 & wsccor*gsccorc(j,i)
650 & +wscloc*gscloc(j,i)
652 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
653 & wel_loc*gel_loc(j,i)+
654 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
655 & welec*gelc_long(j,i)
656 & wel_loc*gel_loc_long(j,i)+
657 & wcorr*gcorr_long(j,i)+
658 & wcorr5*gradcorr5_long(j,i)+
659 & wcorr6*gradcorr6_long(j,i)+
660 & wturn6*gcorr6_turn_long(j,i))+
662 & wcorr*gradcorr(j,i)+
663 & wturn3*gcorr3_turn(j,i)+
664 & wturn4*gcorr4_turn(j,i)+
665 & wcorr5*gradcorr5(j,i)+
666 & wcorr6*gradcorr6(j,i)+
667 & wturn6*gcorr6_turn(j,i)+
668 & wsccor*gsccorc(j,i)
669 & +wscloc*gscloc(j,i)
671 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
673 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
674 & wsccor*gsccorx(j,i)
675 & +wscloc*gsclocx(j,i)
679 write (iout,*) "gloc before adding corr"
681 write (iout,*) i,gloc(i,icg)
685 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
686 & +wcorr5*g_corr5_loc(i)
687 & +wcorr6*g_corr6_loc(i)
688 & +wturn4*gel_loc_turn4(i)
689 & +wturn3*gel_loc_turn3(i)
690 & +wturn6*gel_loc_turn6(i)
691 & +wel_loc*gel_loc_loc(i)
692 & +wsccor*gsccor_loc(i)
695 write (iout,*) "gloc after adding corr"
697 write (iout,*) i,gloc(i,icg)
701 if (nfgtasks.gt.1) then
704 gradbufc(j,i)=gradc(j,i,icg)
705 gradbufx(j,i)=gradx(j,i,icg)
709 glocbuf(i)=gloc(i,icg)
712 call MPI_Barrier(FG_COMM,IERR)
713 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
715 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
716 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
717 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
718 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
719 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
720 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
721 time_reduce=time_reduce+MPI_Wtime()-time00
723 write (iout,*) "gloc after reduce"
725 write (iout,*) i,gloc(i,icg)
730 if (gnorm_check) then
732 c Compute the maximum elements of the gradient
742 gcorr3_turn_max=0.0d0
743 gcorr4_turn_max=0.0d0
746 gcorr6_turn_max=0.0d0
756 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
757 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
758 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
759 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
760 & gvdwc_scp_max=gvdwc_scp_norm
761 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
762 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
763 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
764 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
765 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
766 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
767 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
768 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
769 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
770 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
771 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
772 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
773 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
775 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
776 & gcorr3_turn_max=gcorr3_turn_norm
777 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
779 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
780 & gcorr4_turn_max=gcorr4_turn_norm
781 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
782 if (gradcorr5_norm.gt.gradcorr5_max)
783 & gradcorr5_max=gradcorr5_norm
784 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
785 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
786 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
788 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
789 & gcorr6_turn_max=gcorr6_turn_norm
790 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
791 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
792 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
793 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
794 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
795 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
796 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
797 if (gradx_scp_norm.gt.gradx_scp_max)
798 & gradx_scp_max=gradx_scp_norm
799 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
800 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
801 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
802 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
803 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
804 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
805 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
806 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
810 open(istat,file=statname,position="append")
812 open(istat,file=statname,access="append")
814 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
815 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
816 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
817 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
818 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
819 & gsccorx_max,gsclocx_max
821 if (gvdwc_max.gt.1.0d4) then
822 write (iout,*) "gvdwc gvdwx gradb gradbx"
824 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
825 & gradb(j,i),gradbx(j,i),j=1,3)
827 call pdbout(0.0d0,'cipiszcze',iout)
833 write (iout,*) "gradc gradx gloc"
835 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
836 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
840 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
844 c-------------------------------------------------------------------------------
845 subroutine rescale_weights(t_bath)
846 implicit real*8 (a-h,o-z)
848 include 'COMMON.IOUNITS'
849 include 'COMMON.FFIELD'
850 include 'COMMON.SBRIDGE'
851 double precision kfac /2.4d0/
852 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
854 c facT=2*temp0/(t_bath+temp0)
855 if (rescale_mode.eq.0) then
861 else if (rescale_mode.eq.1) then
862 facT=kfac/(kfac-1.0d0+t_bath/temp0)
863 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
864 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
865 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
866 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
867 else if (rescale_mode.eq.2) then
873 facT=licznik/dlog(dexp(x)+dexp(-x))
874 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
875 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
876 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
877 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
879 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
880 write (*,*) "Wrong RESCALE_MODE",rescale_mode
882 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
886 welec=weights(3)*fact
887 wcorr=weights(4)*fact3
888 wcorr5=weights(5)*fact4
889 wcorr6=weights(6)*fact5
890 wel_loc=weights(7)*fact2
891 wturn3=weights(8)*fact2
892 wturn4=weights(9)*fact3
893 wturn6=weights(10)*fact5
894 wtor=weights(13)*fact
895 wtor_d=weights(14)*fact2
896 wsccor=weights(21)*fact
900 C------------------------------------------------------------------------
901 subroutine enerprint(energia)
902 implicit real*8 (a-h,o-z)
904 include 'COMMON.IOUNITS'
905 include 'COMMON.FFIELD'
906 include 'COMMON.SBRIDGE'
908 double precision energia(0:n_ene)
913 evdw2=energia(2)+energia(18)
925 eello_turn3=energia(8)
926 eello_turn4=energia(9)
927 eello_turn6=energia(10)
933 edihcnstr=energia(19)
938 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
939 & estr,wbond,ebe,wang,
940 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
942 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
943 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
946 10 format (/'Virtual-chain energies:'//
947 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
948 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
949 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
950 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
951 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
952 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
953 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
954 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
955 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
956 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
957 & ' (SS bridges & dist. cnstr.)'/
958 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
959 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
960 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
961 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
962 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
963 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
964 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
965 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
966 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
967 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
968 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
969 & 'ETOT= ',1pE16.6,' (total)')
971 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
972 & estr,wbond,ebe,wang,
973 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
975 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
976 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
977 & ebr*nss,Uconst,etot
978 10 format (/'Virtual-chain energies:'//
979 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
980 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
981 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
982 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
983 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
984 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
985 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
986 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
987 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
988 & ' (SS bridges & dist. cnstr.)'/
989 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
990 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
991 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
992 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
993 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
994 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
995 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
996 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
997 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
998 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
999 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1000 & 'ETOT= ',1pE16.6,' (total)')
1004 C-----------------------------------------------------------------------
1005 subroutine elj(evdw)
1007 C This subroutine calculates the interaction energy of nonbonded side chains
1008 C assuming the LJ potential of interaction.
1010 implicit real*8 (a-h,o-z)
1011 include 'DIMENSIONS'
1012 parameter (accur=1.0d-10)
1013 include 'COMMON.GEO'
1014 include 'COMMON.VAR'
1015 include 'COMMON.LOCAL'
1016 include 'COMMON.CHAIN'
1017 include 'COMMON.DERIV'
1018 include 'COMMON.INTERACT'
1019 include 'COMMON.TORSION'
1020 include 'COMMON.SBRIDGE'
1021 include 'COMMON.NAMES'
1022 include 'COMMON.IOUNITS'
1023 include 'COMMON.CONTACTS'
1025 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1027 do i=iatsc_s,iatsc_e
1029 if (itypi.eq.21) cycle
1037 C Calculate SC interaction energy.
1039 do iint=1,nint_gr(i)
1040 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1041 cd & 'iend=',iend(i,iint)
1042 do j=istart(i,iint),iend(i,iint)
1044 if (itypj.eq.21) cycle
1048 C Change 12/1/95 to calculate four-body interactions
1049 rij=xj*xj+yj*yj+zj*zj
1051 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1052 eps0ij=eps(itypi,itypj)
1054 e1=fac*fac*aa(itypi,itypj)
1055 e2=fac*bb(itypi,itypj)
1057 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1058 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1059 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1060 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1061 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1062 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1065 C Calculate the components of the gradient in DC and X
1067 fac=-rrij*(e1+evdwij)
1072 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1073 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1074 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1075 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1079 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1083 C 12/1/95, revised on 5/20/97
1085 C Calculate the contact function. The ith column of the array JCONT will
1086 C contain the numbers of atoms that make contacts with the atom I (of numbers
1087 C greater than I). The arrays FACONT and GACONT will contain the values of
1088 C the contact function and its derivative.
1090 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1091 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1092 C Uncomment next line, if the correlation interactions are contact function only
1093 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1095 sigij=sigma(itypi,itypj)
1096 r0ij=rs0(itypi,itypj)
1098 C Check whether the SC's are not too far to make a contact.
1101 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1102 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1104 if (fcont.gt.0.0D0) then
1105 C If the SC-SC distance if close to sigma, apply spline.
1106 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1107 cAdam & fcont1,fprimcont1)
1108 cAdam fcont1=1.0d0-fcont1
1109 cAdam if (fcont1.gt.0.0d0) then
1110 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1111 cAdam fcont=fcont*fcont1
1113 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1114 cga eps0ij=1.0d0/dsqrt(eps0ij)
1116 cga gg(k)=gg(k)*eps0ij
1118 cga eps0ij=-evdwij*eps0ij
1119 C Uncomment for AL's type of SC correlation interactions.
1120 cadam eps0ij=-evdwij
1121 num_conti=num_conti+1
1122 jcont(num_conti,i)=j
1123 facont(num_conti,i)=fcont*eps0ij
1124 fprimcont=eps0ij*fprimcont/rij
1126 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1127 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1128 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1129 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1130 gacont(1,num_conti,i)=-fprimcont*xj
1131 gacont(2,num_conti,i)=-fprimcont*yj
1132 gacont(3,num_conti,i)=-fprimcont*zj
1133 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1134 cd write (iout,'(2i3,3f10.5)')
1135 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1141 num_cont(i)=num_conti
1145 gvdwc(j,i)=expon*gvdwc(j,i)
1146 gvdwx(j,i)=expon*gvdwx(j,i)
1149 C******************************************************************************
1153 C To save time, the factor of EXPON has been extracted from ALL components
1154 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1157 C******************************************************************************
1160 C-----------------------------------------------------------------------------
1161 subroutine eljk(evdw)
1163 C This subroutine calculates the interaction energy of nonbonded side chains
1164 C assuming the LJK potential of interaction.
1166 implicit real*8 (a-h,o-z)
1167 include 'DIMENSIONS'
1168 include 'COMMON.GEO'
1169 include 'COMMON.VAR'
1170 include 'COMMON.LOCAL'
1171 include 'COMMON.CHAIN'
1172 include 'COMMON.DERIV'
1173 include 'COMMON.INTERACT'
1174 include 'COMMON.IOUNITS'
1175 include 'COMMON.NAMES'
1178 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1180 do i=iatsc_s,iatsc_e
1182 if (itypi.eq.21) cycle
1188 C Calculate SC interaction energy.
1190 do iint=1,nint_gr(i)
1191 do j=istart(i,iint),iend(i,iint)
1193 if (itypj.eq.21) cycle
1197 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1198 fac_augm=rrij**expon
1199 e_augm=augm(itypi,itypj)*fac_augm
1200 r_inv_ij=dsqrt(rrij)
1202 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1203 fac=r_shift_inv**expon
1204 e1=fac*fac*aa(itypi,itypj)
1205 e2=fac*bb(itypi,itypj)
1207 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1208 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1209 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1210 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1211 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1212 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1213 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1216 C Calculate the components of the gradient in DC and X
1218 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1223 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1224 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1225 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1226 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1230 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1238 gvdwc(j,i)=expon*gvdwc(j,i)
1239 gvdwx(j,i)=expon*gvdwx(j,i)
1244 C-----------------------------------------------------------------------------
1245 subroutine ebp(evdw)
1247 C This subroutine calculates the interaction energy of nonbonded side chains
1248 C assuming the Berne-Pechukas potential of interaction.
1250 implicit real*8 (a-h,o-z)
1251 include 'DIMENSIONS'
1252 include 'COMMON.GEO'
1253 include 'COMMON.VAR'
1254 include 'COMMON.LOCAL'
1255 include 'COMMON.CHAIN'
1256 include 'COMMON.DERIV'
1257 include 'COMMON.NAMES'
1258 include 'COMMON.INTERACT'
1259 include 'COMMON.IOUNITS'
1260 include 'COMMON.CALC'
1261 common /srutu/ icall
1262 c double precision rrsave(maxdim)
1265 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1267 c if (icall.eq.0) then
1273 do i=iatsc_s,iatsc_e
1275 if (itypi.eq.21) cycle
1280 dxi=dc_norm(1,nres+i)
1281 dyi=dc_norm(2,nres+i)
1282 dzi=dc_norm(3,nres+i)
1283 c dsci_inv=dsc_inv(itypi)
1284 dsci_inv=vbld_inv(i+nres)
1286 C Calculate SC interaction energy.
1288 do iint=1,nint_gr(i)
1289 do j=istart(i,iint),iend(i,iint)
1292 if (itypj.eq.21) cycle
1293 c dscj_inv=dsc_inv(itypj)
1294 dscj_inv=vbld_inv(j+nres)
1295 chi1=chi(itypi,itypj)
1296 chi2=chi(itypj,itypi)
1303 alf12=0.5D0*(alf1+alf2)
1304 C For diagnostics only!!!
1317 dxj=dc_norm(1,nres+j)
1318 dyj=dc_norm(2,nres+j)
1319 dzj=dc_norm(3,nres+j)
1320 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1321 cd if (icall.eq.0) then
1327 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1329 C Calculate whole angle-dependent part of epsilon and contributions
1330 C to its derivatives
1331 fac=(rrij*sigsq)**expon2
1332 e1=fac*fac*aa(itypi,itypj)
1333 e2=fac*bb(itypi,itypj)
1334 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1335 eps2der=evdwij*eps3rt
1336 eps3der=evdwij*eps2rt
1337 evdwij=evdwij*eps2rt*eps3rt
1340 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1341 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1342 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1343 cd & restyp(itypi),i,restyp(itypj),j,
1344 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1345 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1346 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1349 C Calculate gradient components.
1350 e1=e1*eps1*eps2rt**2*eps3rt**2
1351 fac=-expon*(e1+evdwij)
1354 C Calculate radial part of the gradient
1358 C Calculate the angular part of the gradient and sum add the contributions
1359 C to the appropriate components of the Cartesian gradient.
1367 C-----------------------------------------------------------------------------
1368 subroutine egb(evdw)
1370 C This subroutine calculates the interaction energy of nonbonded side chains
1371 C assuming the Gay-Berne potential of interaction.
1373 implicit real*8 (a-h,o-z)
1374 include 'DIMENSIONS'
1375 include 'COMMON.GEO'
1376 include 'COMMON.VAR'
1377 include 'COMMON.LOCAL'
1378 include 'COMMON.CHAIN'
1379 include 'COMMON.DERIV'
1380 include 'COMMON.NAMES'
1381 include 'COMMON.INTERACT'
1382 include 'COMMON.IOUNITS'
1383 include 'COMMON.CALC'
1384 include 'COMMON.CONTROL'
1387 ccccc energy_dec=.false.
1388 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1391 c if (icall.eq.0) lprn=.false.
1393 do i=iatsc_s,iatsc_e
1395 if (itypi.eq.21) cycle
1400 dxi=dc_norm(1,nres+i)
1401 dyi=dc_norm(2,nres+i)
1402 dzi=dc_norm(3,nres+i)
1403 c dsci_inv=dsc_inv(itypi)
1404 dsci_inv=vbld_inv(i+nres)
1405 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1406 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1408 C Calculate SC interaction energy.
1410 do iint=1,nint_gr(i)
1411 do j=istart(i,iint),iend(i,iint)
1414 if (itypj.eq.21) cycle
1415 c dscj_inv=dsc_inv(itypj)
1416 dscj_inv=vbld_inv(j+nres)
1417 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1418 c & 1.0d0/vbld(j+nres)
1419 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1420 sig0ij=sigma(itypi,itypj)
1421 chi1=chi(itypi,itypj)
1422 chi2=chi(itypj,itypi)
1429 alf12=0.5D0*(alf1+alf2)
1430 C For diagnostics only!!!
1443 dxj=dc_norm(1,nres+j)
1444 dyj=dc_norm(2,nres+j)
1445 dzj=dc_norm(3,nres+j)
1446 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1447 c write (iout,*) "j",j," dc_norm",
1448 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1449 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1451 C Calculate angle-dependent terms of energy and contributions to their
1455 sig=sig0ij*dsqrt(sigsq)
1456 rij_shift=1.0D0/rij-sig+sig0ij
1457 c for diagnostics; uncomment
1458 c rij_shift=1.2*sig0ij
1459 C I hate to put IF's in the loops, but here don't have another choice!!!!
1460 if (rij_shift.le.0.0D0) then
1462 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1463 cd & restyp(itypi),i,restyp(itypj),j,
1464 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1468 c---------------------------------------------------------------
1469 rij_shift=1.0D0/rij_shift
1470 fac=rij_shift**expon
1471 e1=fac*fac*aa(itypi,itypj)
1472 e2=fac*bb(itypi,itypj)
1473 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1474 eps2der=evdwij*eps3rt
1475 eps3der=evdwij*eps2rt
1476 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1477 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1478 evdwij=evdwij*eps2rt*eps3rt
1481 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1482 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1483 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1484 & restyp(itypi),i,restyp(itypj),j,
1485 & epsi,sigm,chi1,chi2,chip1,chip2,
1486 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1487 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1491 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1494 C Calculate gradient components.
1495 e1=e1*eps1*eps2rt**2*eps3rt**2
1496 fac=-expon*(e1+evdwij)*rij_shift
1500 C Calculate the radial part of the gradient
1504 C Calculate angular part of the gradient.
1509 c write (iout,*) "Number of loop steps in EGB:",ind
1510 cccc energy_dec=.false.
1513 C-----------------------------------------------------------------------------
1514 subroutine egbv(evdw)
1516 C This subroutine calculates the interaction energy of nonbonded side chains
1517 C assuming the Gay-Berne-Vorobjev potential of interaction.
1519 implicit real*8 (a-h,o-z)
1520 include 'DIMENSIONS'
1521 include 'COMMON.GEO'
1522 include 'COMMON.VAR'
1523 include 'COMMON.LOCAL'
1524 include 'COMMON.CHAIN'
1525 include 'COMMON.DERIV'
1526 include 'COMMON.NAMES'
1527 include 'COMMON.INTERACT'
1528 include 'COMMON.IOUNITS'
1529 include 'COMMON.CALC'
1530 common /srutu/ icall
1533 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1536 c if (icall.eq.0) lprn=.true.
1538 do i=iatsc_s,iatsc_e
1540 if (itypi.eq.21) cycle
1545 dxi=dc_norm(1,nres+i)
1546 dyi=dc_norm(2,nres+i)
1547 dzi=dc_norm(3,nres+i)
1548 c dsci_inv=dsc_inv(itypi)
1549 dsci_inv=vbld_inv(i+nres)
1551 C Calculate SC interaction energy.
1553 do iint=1,nint_gr(i)
1554 do j=istart(i,iint),iend(i,iint)
1557 if (itypj.eq.21) cycle
1558 c dscj_inv=dsc_inv(itypj)
1559 dscj_inv=vbld_inv(j+nres)
1560 sig0ij=sigma(itypi,itypj)
1561 r0ij=r0(itypi,itypj)
1562 chi1=chi(itypi,itypj)
1563 chi2=chi(itypj,itypi)
1570 alf12=0.5D0*(alf1+alf2)
1571 C For diagnostics only!!!
1584 dxj=dc_norm(1,nres+j)
1585 dyj=dc_norm(2,nres+j)
1586 dzj=dc_norm(3,nres+j)
1587 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1589 C Calculate angle-dependent terms of energy and contributions to their
1593 sig=sig0ij*dsqrt(sigsq)
1594 rij_shift=1.0D0/rij-sig+r0ij
1595 C I hate to put IF's in the loops, but here don't have another choice!!!!
1596 if (rij_shift.le.0.0D0) then
1601 c---------------------------------------------------------------
1602 rij_shift=1.0D0/rij_shift
1603 fac=rij_shift**expon
1604 e1=fac*fac*aa(itypi,itypj)
1605 e2=fac*bb(itypi,itypj)
1606 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1607 eps2der=evdwij*eps3rt
1608 eps3der=evdwij*eps2rt
1609 fac_augm=rrij**expon
1610 e_augm=augm(itypi,itypj)*fac_augm
1611 evdwij=evdwij*eps2rt*eps3rt
1612 evdw=evdw+evdwij+e_augm
1614 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1615 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1616 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1617 & restyp(itypi),i,restyp(itypj),j,
1618 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1619 & chi1,chi2,chip1,chip2,
1620 & eps1,eps2rt**2,eps3rt**2,
1621 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1624 C Calculate gradient components.
1625 e1=e1*eps1*eps2rt**2*eps3rt**2
1626 fac=-expon*(e1+evdwij)*rij_shift
1628 fac=rij*fac-2*expon*rrij*e_augm
1629 C Calculate the radial part of the gradient
1633 C Calculate angular part of the gradient.
1639 C-----------------------------------------------------------------------------
1640 subroutine sc_angular
1641 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1642 C om12. Called by ebp, egb, and egbv.
1644 include 'COMMON.CALC'
1645 include 'COMMON.IOUNITS'
1649 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1650 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1651 om12=dxi*dxj+dyi*dyj+dzi*dzj
1653 C Calculate eps1(om12) and its derivative in om12
1654 faceps1=1.0D0-om12*chiom12
1655 faceps1_inv=1.0D0/faceps1
1656 eps1=dsqrt(faceps1_inv)
1657 C Following variable is eps1*deps1/dom12
1658 eps1_om12=faceps1_inv*chiom12
1663 c write (iout,*) "om12",om12," eps1",eps1
1664 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1669 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1670 sigsq=1.0D0-facsig*faceps1_inv
1671 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1672 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1673 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1679 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1680 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1682 C Calculate eps2 and its derivatives in om1, om2, and om12.
1685 chipom12=chip12*om12
1686 facp=1.0D0-om12*chipom12
1688 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1689 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1690 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1691 C Following variable is the square root of eps2
1692 eps2rt=1.0D0-facp1*facp_inv
1693 C Following three variables are the derivatives of the square root of eps
1694 C in om1, om2, and om12.
1695 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1696 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1697 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1698 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1699 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1700 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1701 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1702 c & " eps2rt_om12",eps2rt_om12
1703 C Calculate whole angle-dependent part of epsilon and contributions
1704 C to its derivatives
1707 C----------------------------------------------------------------------------
1709 implicit real*8 (a-h,o-z)
1710 include 'DIMENSIONS'
1711 include 'COMMON.CHAIN'
1712 include 'COMMON.DERIV'
1713 include 'COMMON.CALC'
1714 include 'COMMON.IOUNITS'
1715 double precision dcosom1(3),dcosom2(3)
1716 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1717 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1718 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1719 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1723 c eom12=evdwij*eps1_om12
1725 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1726 c & " sigder",sigder
1727 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1728 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1730 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1731 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1734 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1736 c write (iout,*) "gg",(gg(k),k=1,3)
1738 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1739 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1740 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1741 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1742 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1743 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1744 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1745 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1746 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1747 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1750 C Calculate the components of the gradient in DC and X
1754 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1758 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1759 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1763 C-----------------------------------------------------------------------
1764 subroutine e_softsphere(evdw)
1766 C This subroutine calculates the interaction energy of nonbonded side chains
1767 C assuming the LJ potential of interaction.
1769 implicit real*8 (a-h,o-z)
1770 include 'DIMENSIONS'
1771 parameter (accur=1.0d-10)
1772 include 'COMMON.GEO'
1773 include 'COMMON.VAR'
1774 include 'COMMON.LOCAL'
1775 include 'COMMON.CHAIN'
1776 include 'COMMON.DERIV'
1777 include 'COMMON.INTERACT'
1778 include 'COMMON.TORSION'
1779 include 'COMMON.SBRIDGE'
1780 include 'COMMON.NAMES'
1781 include 'COMMON.IOUNITS'
1782 include 'COMMON.CONTACTS'
1784 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1786 do i=iatsc_s,iatsc_e
1788 if (itypi.eq.21) cycle
1794 C Calculate SC interaction energy.
1796 do iint=1,nint_gr(i)
1797 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1798 cd & 'iend=',iend(i,iint)
1799 do j=istart(i,iint),iend(i,iint)
1801 if (itypj.eq.21) cycle
1805 rij=xj*xj+yj*yj+zj*zj
1806 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1807 r0ij=r0(itypi,itypj)
1809 c print *,i,j,r0ij,dsqrt(rij)
1810 if (rij.lt.r0ijsq) then
1811 evdwij=0.25d0*(rij-r0ijsq)**2
1819 C Calculate the components of the gradient in DC and X
1825 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1826 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1827 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1828 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1832 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1840 C--------------------------------------------------------------------------
1841 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1844 C Soft-sphere potential of p-p interaction
1846 implicit real*8 (a-h,o-z)
1847 include 'DIMENSIONS'
1848 include 'COMMON.CONTROL'
1849 include 'COMMON.IOUNITS'
1850 include 'COMMON.GEO'
1851 include 'COMMON.VAR'
1852 include 'COMMON.LOCAL'
1853 include 'COMMON.CHAIN'
1854 include 'COMMON.DERIV'
1855 include 'COMMON.INTERACT'
1856 include 'COMMON.CONTACTS'
1857 include 'COMMON.TORSION'
1858 include 'COMMON.VECTORS'
1859 include 'COMMON.FFIELD'
1861 cd write(iout,*) 'In EELEC_soft_sphere'
1868 do i=iatel_s,iatel_e
1869 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
1873 xmedi=c(1,i)+0.5d0*dxi
1874 ymedi=c(2,i)+0.5d0*dyi
1875 zmedi=c(3,i)+0.5d0*dzi
1877 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1878 do j=ielstart(i),ielend(i)
1879 if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
1883 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1884 r0ij=rpp(iteli,itelj)
1889 xj=c(1,j)+0.5D0*dxj-xmedi
1890 yj=c(2,j)+0.5D0*dyj-ymedi
1891 zj=c(3,j)+0.5D0*dzj-zmedi
1892 rij=xj*xj+yj*yj+zj*zj
1893 if (rij.lt.r0ijsq) then
1894 evdw1ij=0.25d0*(rij-r0ijsq)**2
1902 C Calculate contributions to the Cartesian gradient.
1908 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1909 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1912 * Loop over residues i+1 thru j-1.
1916 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1921 cgrad do i=nnt,nct-1
1923 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1925 cgrad do j=i+1,nct-1
1927 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
1933 c------------------------------------------------------------------------------
1934 subroutine vec_and_deriv
1935 implicit real*8 (a-h,o-z)
1936 include 'DIMENSIONS'
1940 include 'COMMON.IOUNITS'
1941 include 'COMMON.GEO'
1942 include 'COMMON.VAR'
1943 include 'COMMON.LOCAL'
1944 include 'COMMON.CHAIN'
1945 include 'COMMON.VECTORS'
1946 include 'COMMON.SETUP'
1947 include 'COMMON.TIME1'
1948 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1949 C Compute the local reference systems. For reference system (i), the
1950 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1951 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1953 do i=ivec_start,ivec_end
1957 if (i.eq.nres-1) then
1958 C Case of the last full residue
1959 C Compute the Z-axis
1960 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1961 costh=dcos(pi-theta(nres))
1962 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1966 C Compute the derivatives of uz
1968 uzder(2,1,1)=-dc_norm(3,i-1)
1969 uzder(3,1,1)= dc_norm(2,i-1)
1970 uzder(1,2,1)= dc_norm(3,i-1)
1972 uzder(3,2,1)=-dc_norm(1,i-1)
1973 uzder(1,3,1)=-dc_norm(2,i-1)
1974 uzder(2,3,1)= dc_norm(1,i-1)
1977 uzder(2,1,2)= dc_norm(3,i)
1978 uzder(3,1,2)=-dc_norm(2,i)
1979 uzder(1,2,2)=-dc_norm(3,i)
1981 uzder(3,2,2)= dc_norm(1,i)
1982 uzder(1,3,2)= dc_norm(2,i)
1983 uzder(2,3,2)=-dc_norm(1,i)
1985 C Compute the Y-axis
1988 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1990 C Compute the derivatives of uy
1993 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1994 & -dc_norm(k,i)*dc_norm(j,i-1)
1995 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1997 uyder(j,j,1)=uyder(j,j,1)-costh
1998 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2003 uygrad(l,k,j,i)=uyder(l,k,j)
2004 uzgrad(l,k,j,i)=uzder(l,k,j)
2008 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2009 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2010 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2011 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2014 C Compute the Z-axis
2015 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2016 costh=dcos(pi-theta(i+2))
2017 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2021 C Compute the derivatives of uz
2023 uzder(2,1,1)=-dc_norm(3,i+1)
2024 uzder(3,1,1)= dc_norm(2,i+1)
2025 uzder(1,2,1)= dc_norm(3,i+1)
2027 uzder(3,2,1)=-dc_norm(1,i+1)
2028 uzder(1,3,1)=-dc_norm(2,i+1)
2029 uzder(2,3,1)= dc_norm(1,i+1)
2032 uzder(2,1,2)= dc_norm(3,i)
2033 uzder(3,1,2)=-dc_norm(2,i)
2034 uzder(1,2,2)=-dc_norm(3,i)
2036 uzder(3,2,2)= dc_norm(1,i)
2037 uzder(1,3,2)= dc_norm(2,i)
2038 uzder(2,3,2)=-dc_norm(1,i)
2040 C Compute the Y-axis
2043 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2045 C Compute the derivatives of uy
2048 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2049 & -dc_norm(k,i)*dc_norm(j,i+1)
2050 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2052 uyder(j,j,1)=uyder(j,j,1)-costh
2053 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2058 uygrad(l,k,j,i)=uyder(l,k,j)
2059 uzgrad(l,k,j,i)=uzder(l,k,j)
2063 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2064 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2065 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2066 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2070 vbld_inv_temp(1)=vbld_inv(i+1)
2071 if (i.lt.nres-1) then
2072 vbld_inv_temp(2)=vbld_inv(i+2)
2074 vbld_inv_temp(2)=vbld_inv(i)
2079 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2080 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2085 #if defined(PARVEC) && defined(MPI)
2086 if (nfgtasks1.gt.1) then
2088 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2089 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2090 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2091 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2092 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2094 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2095 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2097 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2098 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2099 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2100 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2101 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2102 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2103 time_gather=time_gather+MPI_Wtime()-time00
2105 c if (fg_rank.eq.0) then
2106 c write (iout,*) "Arrays UY and UZ"
2108 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2115 C-----------------------------------------------------------------------------
2116 subroutine check_vecgrad
2117 implicit real*8 (a-h,o-z)
2118 include 'DIMENSIONS'
2119 include 'COMMON.IOUNITS'
2120 include 'COMMON.GEO'
2121 include 'COMMON.VAR'
2122 include 'COMMON.LOCAL'
2123 include 'COMMON.CHAIN'
2124 include 'COMMON.VECTORS'
2125 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2126 dimension uyt(3,maxres),uzt(3,maxres)
2127 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2128 double precision delta /1.0d-7/
2131 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2132 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2133 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2134 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2135 cd & (dc_norm(if90,i),if90=1,3)
2136 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2137 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2138 cd write(iout,'(a)')
2144 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2145 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2158 cd write (iout,*) 'i=',i
2160 erij(k)=dc_norm(k,i)
2164 dc_norm(k,i)=erij(k)
2166 dc_norm(j,i)=dc_norm(j,i)+delta
2167 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2169 c dc_norm(k,i)=dc_norm(k,i)/fac
2171 c write (iout,*) (dc_norm(k,i),k=1,3)
2172 c write (iout,*) (erij(k),k=1,3)
2175 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2176 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2177 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2178 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2180 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2181 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2182 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2185 dc_norm(k,i)=erij(k)
2188 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2189 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2190 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2191 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2192 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2193 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2194 cd write (iout,'(a)')
2199 C--------------------------------------------------------------------------
2200 subroutine set_matrices
2201 implicit real*8 (a-h,o-z)
2202 include 'DIMENSIONS'
2205 include "COMMON.SETUP"
2207 integer status(MPI_STATUS_SIZE)
2209 include 'COMMON.IOUNITS'
2210 include 'COMMON.GEO'
2211 include 'COMMON.VAR'
2212 include 'COMMON.LOCAL'
2213 include 'COMMON.CHAIN'
2214 include 'COMMON.DERIV'
2215 include 'COMMON.INTERACT'
2216 include 'COMMON.CONTACTS'
2217 include 'COMMON.TORSION'
2218 include 'COMMON.VECTORS'
2219 include 'COMMON.FFIELD'
2220 double precision auxvec(2),auxmat(2,2)
2222 C Compute the virtual-bond-torsional-angle dependent quantities needed
2223 C to calculate the el-loc multibody terms of various order.
2226 do i=ivec_start+2,ivec_end+2
2230 if (i .lt. nres+1) then
2267 if (i .gt. 3 .and. i .lt. nres+1) then
2268 obrot_der(1,i-2)=-sin1
2269 obrot_der(2,i-2)= cos1
2270 Ugder(1,1,i-2)= sin1
2271 Ugder(1,2,i-2)=-cos1
2272 Ugder(2,1,i-2)=-cos1
2273 Ugder(2,2,i-2)=-sin1
2276 obrot2_der(1,i-2)=-dwasin2
2277 obrot2_der(2,i-2)= dwacos2
2278 Ug2der(1,1,i-2)= dwasin2
2279 Ug2der(1,2,i-2)=-dwacos2
2280 Ug2der(2,1,i-2)=-dwacos2
2281 Ug2der(2,2,i-2)=-dwasin2
2283 obrot_der(1,i-2)=0.0d0
2284 obrot_der(2,i-2)=0.0d0
2285 Ugder(1,1,i-2)=0.0d0
2286 Ugder(1,2,i-2)=0.0d0
2287 Ugder(2,1,i-2)=0.0d0
2288 Ugder(2,2,i-2)=0.0d0
2289 obrot2_der(1,i-2)=0.0d0
2290 obrot2_der(2,i-2)=0.0d0
2291 Ug2der(1,1,i-2)=0.0d0
2292 Ug2der(1,2,i-2)=0.0d0
2293 Ug2der(2,1,i-2)=0.0d0
2294 Ug2der(2,2,i-2)=0.0d0
2296 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2297 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2298 iti = itortyp(itype(i-2))
2302 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2303 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2304 iti1 = itortyp(itype(i-1))
2308 cd write (iout,*) '*******i',i,' iti1',iti
2309 cd write (iout,*) 'b1',b1(:,iti)
2310 cd write (iout,*) 'b2',b2(:,iti)
2311 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2312 c if (i .gt. iatel_s+2) then
2313 if (i .gt. nnt+2) then
2314 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2315 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2316 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2318 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2319 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2320 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2321 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2322 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2333 DtUg2(l,k,i-2)=0.0d0
2337 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2338 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2340 muder(k,i-2)=Ub2der(k,i-2)
2342 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2343 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2344 iti1 = itortyp(itype(i-1))
2349 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2351 cd write (iout,*) 'mu ',mu(:,i-2)
2352 cd write (iout,*) 'mu1',mu1(:,i-2)
2353 cd write (iout,*) 'mu2',mu2(:,i-2)
2354 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2356 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2357 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2358 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2359 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2360 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2361 C Vectors and matrices dependent on a single virtual-bond dihedral.
2362 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2363 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2364 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2365 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2366 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2367 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2368 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2369 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2370 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2373 C Matrices dependent on two consecutive virtual-bond dihedrals.
2374 C The order of matrices is from left to right.
2375 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2377 c do i=max0(ivec_start,2),ivec_end
2379 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2380 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2381 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2382 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2383 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2384 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2385 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2386 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2389 #if defined(MPI) && defined(PARMAT)
2391 c if (fg_rank.eq.0) then
2392 write (iout,*) "Arrays UG and UGDER before GATHER"
2394 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2395 & ((ug(l,k,i),l=1,2),k=1,2),
2396 & ((ugder(l,k,i),l=1,2),k=1,2)
2398 write (iout,*) "Arrays UG2 and UG2DER"
2400 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2401 & ((ug2(l,k,i),l=1,2),k=1,2),
2402 & ((ug2der(l,k,i),l=1,2),k=1,2)
2404 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2406 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2407 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2408 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2410 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2412 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2413 & costab(i),sintab(i),costab2(i),sintab2(i)
2415 write (iout,*) "Array MUDER"
2417 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2421 if (nfgtasks.gt.1) then
2423 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2424 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2425 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2427 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2428 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2430 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2431 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2433 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2434 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2436 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2437 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2439 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2440 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2442 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2443 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2445 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2446 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2447 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2448 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2449 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2450 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2451 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2452 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2453 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2454 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2455 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2456 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2457 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2459 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2460 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2462 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2463 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2465 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2466 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2468 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2469 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2471 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2472 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2474 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2475 & ivec_count(fg_rank1),
2476 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2478 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2479 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2481 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2482 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2484 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2485 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2487 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2488 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2490 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2491 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2493 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2494 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2496 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2497 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2499 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2500 & ivec_count(fg_rank1),
2501 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2503 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2504 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2506 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2507 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2509 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2510 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2512 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2513 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2515 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2516 & ivec_count(fg_rank1),
2517 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2519 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2520 & ivec_count(fg_rank1),
2521 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2523 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2524 & ivec_count(fg_rank1),
2525 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2526 & MPI_MAT2,FG_COMM1,IERR)
2527 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2528 & ivec_count(fg_rank1),
2529 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2530 & MPI_MAT2,FG_COMM1,IERR)
2533 c Passes matrix info through the ring
2536 if (irecv.lt.0) irecv=nfgtasks1-1
2539 if (inext.ge.nfgtasks1) inext=0
2541 c write (iout,*) "isend",isend," irecv",irecv
2543 lensend=lentyp(isend)
2544 lenrecv=lentyp(irecv)
2545 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2546 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2547 c & MPI_ROTAT1(lensend),inext,2200+isend,
2548 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2549 c & iprev,2200+irecv,FG_COMM,status,IERR)
2550 c write (iout,*) "Gather ROTAT1"
2552 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2553 c & MPI_ROTAT2(lensend),inext,3300+isend,
2554 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2555 c & iprev,3300+irecv,FG_COMM,status,IERR)
2556 c write (iout,*) "Gather ROTAT2"
2558 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2559 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2560 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2561 & iprev,4400+irecv,FG_COMM,status,IERR)
2562 c write (iout,*) "Gather ROTAT_OLD"
2564 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2565 & MPI_PRECOMP11(lensend),inext,5500+isend,
2566 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2567 & iprev,5500+irecv,FG_COMM,status,IERR)
2568 c write (iout,*) "Gather PRECOMP11"
2570 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2571 & MPI_PRECOMP12(lensend),inext,6600+isend,
2572 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2573 & iprev,6600+irecv,FG_COMM,status,IERR)
2574 c write (iout,*) "Gather PRECOMP12"
2576 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2578 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2579 & MPI_ROTAT2(lensend),inext,7700+isend,
2580 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2581 & iprev,7700+irecv,FG_COMM,status,IERR)
2582 c write (iout,*) "Gather PRECOMP21"
2584 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2585 & MPI_PRECOMP22(lensend),inext,8800+isend,
2586 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2587 & iprev,8800+irecv,FG_COMM,status,IERR)
2588 c write (iout,*) "Gather PRECOMP22"
2590 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2591 & MPI_PRECOMP23(lensend),inext,9900+isend,
2592 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2593 & MPI_PRECOMP23(lenrecv),
2594 & iprev,9900+irecv,FG_COMM,status,IERR)
2595 c write (iout,*) "Gather PRECOMP23"
2600 if (irecv.lt.0) irecv=nfgtasks1-1
2603 time_gather=time_gather+MPI_Wtime()-time00
2606 c if (fg_rank.eq.0) then
2607 write (iout,*) "Arrays UG and UGDER"
2609 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2610 & ((ug(l,k,i),l=1,2),k=1,2),
2611 & ((ugder(l,k,i),l=1,2),k=1,2)
2613 write (iout,*) "Arrays UG2 and UG2DER"
2615 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2616 & ((ug2(l,k,i),l=1,2),k=1,2),
2617 & ((ug2der(l,k,i),l=1,2),k=1,2)
2619 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2621 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2622 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2623 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2625 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2627 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2628 & costab(i),sintab(i),costab2(i),sintab2(i)
2630 write (iout,*) "Array MUDER"
2632 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2638 cd iti = itortyp(itype(i))
2641 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2642 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2647 C--------------------------------------------------------------------------
2648 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2650 C This subroutine calculates the average interaction energy and its gradient
2651 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2652 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2653 C The potential depends both on the distance of peptide-group centers and on
2654 C the orientation of the CA-CA virtual bonds.
2656 implicit real*8 (a-h,o-z)
2660 include 'DIMENSIONS'
2661 include 'COMMON.CONTROL'
2662 include 'COMMON.SETUP'
2663 include 'COMMON.IOUNITS'
2664 include 'COMMON.GEO'
2665 include 'COMMON.VAR'
2666 include 'COMMON.LOCAL'
2667 include 'COMMON.CHAIN'
2668 include 'COMMON.DERIV'
2669 include 'COMMON.INTERACT'
2670 include 'COMMON.CONTACTS'
2671 include 'COMMON.TORSION'
2672 include 'COMMON.VECTORS'
2673 include 'COMMON.FFIELD'
2674 include 'COMMON.TIME1'
2675 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2676 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2677 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2678 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2679 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2680 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2682 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2684 double precision scal_el /1.0d0/
2686 double precision scal_el /0.5d0/
2689 C 13-go grudnia roku pamietnego...
2690 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2691 & 0.0d0,1.0d0,0.0d0,
2692 & 0.0d0,0.0d0,1.0d0/
2693 cd write(iout,*) 'In EELEC'
2695 cd write(iout,*) 'Type',i
2696 cd write(iout,*) 'B1',B1(:,i)
2697 cd write(iout,*) 'B2',B2(:,i)
2698 cd write(iout,*) 'CC',CC(:,:,i)
2699 cd write(iout,*) 'DD',DD(:,:,i)
2700 cd write(iout,*) 'EE',EE(:,:,i)
2702 cd call check_vecgrad
2704 if (icheckgrad.eq.1) then
2706 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2708 dc_norm(k,i)=dc(k,i)*fac
2710 c write (iout,*) 'i',i,' fac',fac
2713 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2714 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2715 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2716 c call vec_and_deriv
2722 time_mat=time_mat+MPI_Wtime()-time01
2726 cd write (iout,*) 'i=',i
2728 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2731 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2732 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2745 cd print '(a)','Enter EELEC'
2746 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2748 gel_loc_loc(i)=0.0d0
2753 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2755 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2757 do i=iturn3_start,iturn3_end
2758 if (itype(i).eq.21 .or. itype(i+1).eq.21
2759 & .or. itype(i+2).eq.21 .or. itype(i+3).eq.21) cycle
2763 dx_normi=dc_norm(1,i)
2764 dy_normi=dc_norm(2,i)
2765 dz_normi=dc_norm(3,i)
2766 xmedi=c(1,i)+0.5d0*dxi
2767 ymedi=c(2,i)+0.5d0*dyi
2768 zmedi=c(3,i)+0.5d0*dzi
2770 call eelecij(i,i+2,ees,evdw1,eel_loc)
2771 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2772 num_cont_hb(i)=num_conti
2774 do i=iturn4_start,iturn4_end
2775 if (itype(i).eq.21 .or. itype(i+1).eq.21 .or.
2776 c-----> Probably bug; should also handle itype(i+2)
2777 & .or. itype(i+3).eq.21
2778 & .or. itype(i+4).eq.21) cycle
2782 dx_normi=dc_norm(1,i)
2783 dy_normi=dc_norm(2,i)
2784 dz_normi=dc_norm(3,i)
2785 xmedi=c(1,i)+0.5d0*dxi
2786 ymedi=c(2,i)+0.5d0*dyi
2787 zmedi=c(3,i)+0.5d0*dzi
2788 num_conti=num_cont_hb(i)
2789 call eelecij(i,i+3,ees,evdw1,eel_loc)
2790 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.21)
2791 & call eturn4(i,eello_turn4)
2792 num_cont_hb(i)=num_conti
2795 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2797 do i=iatel_s,iatel_e
2798 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
2802 dx_normi=dc_norm(1,i)
2803 dy_normi=dc_norm(2,i)
2804 dz_normi=dc_norm(3,i)
2805 xmedi=c(1,i)+0.5d0*dxi
2806 ymedi=c(2,i)+0.5d0*dyi
2807 zmedi=c(3,i)+0.5d0*dzi
2808 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2809 num_conti=num_cont_hb(i)
2810 do j=ielstart(i),ielend(i)
2811 c write (iout,*) i,j,itype(i),itype(j)
2812 if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
2813 call eelecij(i,j,ees,evdw1,eel_loc)
2815 num_cont_hb(i)=num_conti
2817 c write (iout,*) "Number of loop steps in EELEC:",ind
2819 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2820 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2822 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2823 ccc eel_loc=eel_loc+eello_turn3
2824 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2827 C-------------------------------------------------------------------------------
2828 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2829 implicit real*8 (a-h,o-z)
2830 include 'DIMENSIONS'
2834 include 'COMMON.CONTROL'
2835 include 'COMMON.IOUNITS'
2836 include 'COMMON.GEO'
2837 include 'COMMON.VAR'
2838 include 'COMMON.LOCAL'
2839 include 'COMMON.CHAIN'
2840 include 'COMMON.DERIV'
2841 include 'COMMON.INTERACT'
2842 include 'COMMON.CONTACTS'
2843 include 'COMMON.TORSION'
2844 include 'COMMON.VECTORS'
2845 include 'COMMON.FFIELD'
2846 include 'COMMON.TIME1'
2847 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2848 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2849 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2850 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2851 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2852 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2854 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2856 double precision scal_el /1.0d0/
2858 double precision scal_el /0.5d0/
2861 C 13-go grudnia roku pamietnego...
2862 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2863 & 0.0d0,1.0d0,0.0d0,
2864 & 0.0d0,0.0d0,1.0d0/
2865 c time00=MPI_Wtime()
2866 cd write (iout,*) "eelecij",i,j
2870 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2871 aaa=app(iteli,itelj)
2872 bbb=bpp(iteli,itelj)
2873 ael6i=ael6(iteli,itelj)
2874 ael3i=ael3(iteli,itelj)
2878 dx_normj=dc_norm(1,j)
2879 dy_normj=dc_norm(2,j)
2880 dz_normj=dc_norm(3,j)
2881 xj=c(1,j)+0.5D0*dxj-xmedi
2882 yj=c(2,j)+0.5D0*dyj-ymedi
2883 zj=c(3,j)+0.5D0*dzj-zmedi
2884 rij=xj*xj+yj*yj+zj*zj
2890 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2891 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2892 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2893 fac=cosa-3.0D0*cosb*cosg
2895 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2896 if (j.eq.i+2) ev1=scal_el*ev1
2901 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2904 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2905 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2908 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2909 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2910 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2911 cd & xmedi,ymedi,zmedi,xj,yj,zj
2913 if (energy_dec) then
2914 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
2915 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2919 C Calculate contributions to the Cartesian gradient.
2922 facvdw=-6*rrmij*(ev1+evdwij)
2923 facel=-3*rrmij*(el1+eesij)
2929 * Radial derivatives. First process both termini of the fragment (i,j)
2935 c ghalf=0.5D0*ggg(k)
2936 c gelc(k,i)=gelc(k,i)+ghalf
2937 c gelc(k,j)=gelc(k,j)+ghalf
2939 c 9/28/08 AL Gradient compotents will be summed only at the end
2941 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2942 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2945 * Loop over residues i+1 thru j-1.
2949 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2956 c ghalf=0.5D0*ggg(k)
2957 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2958 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2960 c 9/28/08 AL Gradient compotents will be summed only at the end
2962 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2963 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2966 * Loop over residues i+1 thru j-1.
2970 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2977 fac=-3*rrmij*(facvdw+facvdw+facel)
2982 * Radial derivatives. First process both termini of the fragment (i,j)
2988 c ghalf=0.5D0*ggg(k)
2989 c gelc(k,i)=gelc(k,i)+ghalf
2990 c gelc(k,j)=gelc(k,j)+ghalf
2992 c 9/28/08 AL Gradient compotents will be summed only at the end
2994 gelc_long(k,j)=gelc(k,j)+ggg(k)
2995 gelc_long(k,i)=gelc(k,i)-ggg(k)
2998 * Loop over residues i+1 thru j-1.
3002 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3005 c 9/28/08 AL Gradient compotents will be summed only at the end
3010 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3011 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3017 ecosa=2.0D0*fac3*fac1+fac4
3020 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3021 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3023 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3024 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3026 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3027 cd & (dcosg(k),k=1,3)
3029 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3032 c ghalf=0.5D0*ggg(k)
3033 c gelc(k,i)=gelc(k,i)+ghalf
3034 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3035 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3036 c gelc(k,j)=gelc(k,j)+ghalf
3037 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3038 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3042 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3047 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3048 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3050 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3051 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3052 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3053 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3055 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3056 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3057 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3059 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3060 C energy of a peptide unit is assumed in the form of a second-order
3061 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3062 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3063 C are computed for EVERY pair of non-contiguous peptide groups.
3065 if (j.lt.nres-1) then
3076 muij(kkk)=mu(k,i)*mu(l,j)
3079 cd write (iout,*) 'EELEC: i',i,' j',j
3080 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3081 cd write(iout,*) 'muij',muij
3082 ury=scalar(uy(1,i),erij)
3083 urz=scalar(uz(1,i),erij)
3084 vry=scalar(uy(1,j),erij)
3085 vrz=scalar(uz(1,j),erij)
3086 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3087 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3088 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3089 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3090 fac=dsqrt(-ael6i)*r3ij
3095 cd write (iout,'(4i5,4f10.5)')
3096 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3097 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3098 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3099 cd & uy(:,j),uz(:,j)
3100 cd write (iout,'(4f10.5)')
3101 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3102 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3103 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3104 cd write (iout,'(9f10.5/)')
3105 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3106 C Derivatives of the elements of A in virtual-bond vectors
3107 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3109 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3110 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3111 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3112 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3113 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3114 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3115 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3116 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3117 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3118 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3119 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3120 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3122 C Compute radial contributions to the gradient
3140 C Add the contributions coming from er
3143 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3144 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3145 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3146 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3149 C Derivatives in DC(i)
3150 cgrad ghalf1=0.5d0*agg(k,1)
3151 cgrad ghalf2=0.5d0*agg(k,2)
3152 cgrad ghalf3=0.5d0*agg(k,3)
3153 cgrad ghalf4=0.5d0*agg(k,4)
3154 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3155 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3156 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3157 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3158 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3159 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3160 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3161 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3162 C Derivatives in DC(i+1)
3163 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3164 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3165 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3166 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3167 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3168 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3169 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3170 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3171 C Derivatives in DC(j)
3172 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3173 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3174 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3175 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3176 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3177 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3178 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3179 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3180 C Derivatives in DC(j+1) or DC(nres-1)
3181 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3182 & -3.0d0*vryg(k,3)*ury)
3183 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3184 & -3.0d0*vrzg(k,3)*ury)
3185 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3186 & -3.0d0*vryg(k,3)*urz)
3187 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3188 & -3.0d0*vrzg(k,3)*urz)
3189 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3191 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3204 aggi(k,l)=-aggi(k,l)
3205 aggi1(k,l)=-aggi1(k,l)
3206 aggj(k,l)=-aggj(k,l)
3207 aggj1(k,l)=-aggj1(k,l)
3210 if (j.lt.nres-1) then
3216 aggi(k,l)=-aggi(k,l)
3217 aggi1(k,l)=-aggi1(k,l)
3218 aggj(k,l)=-aggj(k,l)
3219 aggj1(k,l)=-aggj1(k,l)
3230 aggi(k,l)=-aggi(k,l)
3231 aggi1(k,l)=-aggi1(k,l)
3232 aggj(k,l)=-aggj(k,l)
3233 aggj1(k,l)=-aggj1(k,l)
3238 IF (wel_loc.gt.0.0d0) THEN
3239 C Contribution to the local-electrostatic energy coming from the i-j pair
3240 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3242 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3244 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3245 & 'eelloc',i,j,eel_loc_ij
3247 eel_loc=eel_loc+eel_loc_ij
3248 C Partial derivatives in virtual-bond dihedral angles gamma
3250 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3251 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3252 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3253 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3254 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3255 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3256 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3258 ggg(l)=agg(l,1)*muij(1)+
3259 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3260 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3261 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3262 cgrad ghalf=0.5d0*ggg(l)
3263 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3264 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3268 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3271 C Remaining derivatives of eello
3273 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3274 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3275 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3276 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3277 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3278 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3279 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3280 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3283 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3284 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3285 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3286 & .and. num_conti.le.maxconts) then
3287 c write (iout,*) i,j," entered corr"
3289 C Calculate the contact function. The ith column of the array JCONT will
3290 C contain the numbers of atoms that make contacts with the atom I (of numbers
3291 C greater than I). The arrays FACONT and GACONT will contain the values of
3292 C the contact function and its derivative.
3293 c r0ij=1.02D0*rpp(iteli,itelj)
3294 c r0ij=1.11D0*rpp(iteli,itelj)
3295 r0ij=2.20D0*rpp(iteli,itelj)
3296 c r0ij=1.55D0*rpp(iteli,itelj)
3297 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3298 if (fcont.gt.0.0D0) then
3299 num_conti=num_conti+1
3300 if (num_conti.gt.maxconts) then
3301 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3302 & ' will skip next contacts for this conf.'
3304 jcont_hb(num_conti,i)=j
3305 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3306 cd & " jcont_hb",jcont_hb(num_conti,i)
3307 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3308 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3309 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3311 d_cont(num_conti,i)=rij
3312 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3313 C --- Electrostatic-interaction matrix ---
3314 a_chuj(1,1,num_conti,i)=a22
3315 a_chuj(1,2,num_conti,i)=a23
3316 a_chuj(2,1,num_conti,i)=a32
3317 a_chuj(2,2,num_conti,i)=a33
3318 C --- Gradient of rij
3320 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3327 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3328 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3329 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3330 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3331 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3336 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3337 C Calculate contact energies
3339 wij=cosa-3.0D0*cosb*cosg
3342 c fac3=dsqrt(-ael6i)/r0ij**3
3343 fac3=dsqrt(-ael6i)*r3ij
3344 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3345 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3346 if (ees0tmp.gt.0) then
3347 ees0pij=dsqrt(ees0tmp)
3351 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3352 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3353 if (ees0tmp.gt.0) then
3354 ees0mij=dsqrt(ees0tmp)
3359 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3360 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3361 C Diagnostics. Comment out or remove after debugging!
3362 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3363 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3364 c ees0m(num_conti,i)=0.0D0
3366 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3367 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3368 C Angular derivatives of the contact function
3369 ees0pij1=fac3/ees0pij
3370 ees0mij1=fac3/ees0mij
3371 fac3p=-3.0D0*fac3*rrmij
3372 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3373 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3375 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3376 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3377 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3378 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3379 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3380 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3381 ecosap=ecosa1+ecosa2
3382 ecosbp=ecosb1+ecosb2
3383 ecosgp=ecosg1+ecosg2
3384 ecosam=ecosa1-ecosa2
3385 ecosbm=ecosb1-ecosb2
3386 ecosgm=ecosg1-ecosg2
3395 facont_hb(num_conti,i)=fcont
3396 fprimcont=fprimcont/rij
3397 cd facont_hb(num_conti,i)=1.0D0
3398 C Following line is for diagnostics.
3401 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3402 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3405 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3406 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3408 gggp(1)=gggp(1)+ees0pijp*xj
3409 gggp(2)=gggp(2)+ees0pijp*yj
3410 gggp(3)=gggp(3)+ees0pijp*zj
3411 gggm(1)=gggm(1)+ees0mijp*xj
3412 gggm(2)=gggm(2)+ees0mijp*yj
3413 gggm(3)=gggm(3)+ees0mijp*zj
3414 C Derivatives due to the contact function
3415 gacont_hbr(1,num_conti,i)=fprimcont*xj
3416 gacont_hbr(2,num_conti,i)=fprimcont*yj
3417 gacont_hbr(3,num_conti,i)=fprimcont*zj
3420 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3421 c following the change of gradient-summation algorithm.
3423 cgrad ghalfp=0.5D0*gggp(k)
3424 cgrad ghalfm=0.5D0*gggm(k)
3425 gacontp_hb1(k,num_conti,i)=!ghalfp
3426 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3427 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3428 gacontp_hb2(k,num_conti,i)=!ghalfp
3429 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3430 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3431 gacontp_hb3(k,num_conti,i)=gggp(k)
3432 gacontm_hb1(k,num_conti,i)=!ghalfm
3433 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3434 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3435 gacontm_hb2(k,num_conti,i)=!ghalfm
3436 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3437 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3438 gacontm_hb3(k,num_conti,i)=gggm(k)
3440 C Diagnostics. Comment out or remove after debugging!
3442 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3443 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3444 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3445 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3446 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3447 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3450 endif ! num_conti.le.maxconts
3453 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3456 ghalf=0.5d0*agg(l,k)
3457 aggi(l,k)=aggi(l,k)+ghalf
3458 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3459 aggj(l,k)=aggj(l,k)+ghalf
3462 if (j.eq.nres-1 .and. i.lt.j-2) then
3465 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3470 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3473 C-----------------------------------------------------------------------------
3474 subroutine eturn3(i,eello_turn3)
3475 C Third- and fourth-order contributions from turns
3476 implicit real*8 (a-h,o-z)
3477 include 'DIMENSIONS'
3478 include 'COMMON.IOUNITS'
3479 include 'COMMON.GEO'
3480 include 'COMMON.VAR'
3481 include 'COMMON.LOCAL'
3482 include 'COMMON.CHAIN'
3483 include 'COMMON.DERIV'
3484 include 'COMMON.INTERACT'
3485 include 'COMMON.CONTACTS'
3486 include 'COMMON.TORSION'
3487 include 'COMMON.VECTORS'
3488 include 'COMMON.FFIELD'
3489 include 'COMMON.CONTROL'
3491 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3492 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3493 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3494 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3495 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3496 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3497 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3500 c write (iout,*) "eturn3",i,j,j1,j2
3505 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3507 C Third-order contributions
3514 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3515 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3516 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3517 call transpose2(auxmat(1,1),auxmat1(1,1))
3518 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3519 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3520 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3521 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3522 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3523 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3524 cd & ' eello_turn3_num',4*eello_turn3_num
3525 C Derivatives in gamma(i)
3526 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3527 call transpose2(auxmat2(1,1),auxmat3(1,1))
3528 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3529 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3530 C Derivatives in gamma(i+1)
3531 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3532 call transpose2(auxmat2(1,1),auxmat3(1,1))
3533 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3534 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3535 & +0.5d0*(pizda(1,1)+pizda(2,2))
3536 C Cartesian derivatives
3538 c ghalf1=0.5d0*agg(l,1)
3539 c ghalf2=0.5d0*agg(l,2)
3540 c ghalf3=0.5d0*agg(l,3)
3541 c ghalf4=0.5d0*agg(l,4)
3542 a_temp(1,1)=aggi(l,1)!+ghalf1
3543 a_temp(1,2)=aggi(l,2)!+ghalf2
3544 a_temp(2,1)=aggi(l,3)!+ghalf3
3545 a_temp(2,2)=aggi(l,4)!+ghalf4
3546 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3547 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3548 & +0.5d0*(pizda(1,1)+pizda(2,2))
3549 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3550 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3551 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3552 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3553 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3554 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3555 & +0.5d0*(pizda(1,1)+pizda(2,2))
3556 a_temp(1,1)=aggj(l,1)!+ghalf1
3557 a_temp(1,2)=aggj(l,2)!+ghalf2
3558 a_temp(2,1)=aggj(l,3)!+ghalf3
3559 a_temp(2,2)=aggj(l,4)!+ghalf4
3560 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3561 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3562 & +0.5d0*(pizda(1,1)+pizda(2,2))
3563 a_temp(1,1)=aggj1(l,1)
3564 a_temp(1,2)=aggj1(l,2)
3565 a_temp(2,1)=aggj1(l,3)
3566 a_temp(2,2)=aggj1(l,4)
3567 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3568 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3569 & +0.5d0*(pizda(1,1)+pizda(2,2))
3573 C-------------------------------------------------------------------------------
3574 subroutine eturn4(i,eello_turn4)
3575 C Third- and fourth-order contributions from turns
3576 implicit real*8 (a-h,o-z)
3577 include 'DIMENSIONS'
3578 include 'COMMON.IOUNITS'
3579 include 'COMMON.GEO'
3580 include 'COMMON.VAR'
3581 include 'COMMON.LOCAL'
3582 include 'COMMON.CHAIN'
3583 include 'COMMON.DERIV'
3584 include 'COMMON.INTERACT'
3585 include 'COMMON.CONTACTS'
3586 include 'COMMON.TORSION'
3587 include 'COMMON.VECTORS'
3588 include 'COMMON.FFIELD'
3589 include 'COMMON.CONTROL'
3591 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3592 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3593 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3594 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3595 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3596 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3597 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3600 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3602 C Fourth-order contributions
3610 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3611 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3612 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3617 iti1=itortyp(itype(i+1))
3618 iti2=itortyp(itype(i+2))
3619 iti3=itortyp(itype(i+3))
3620 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3621 call transpose2(EUg(1,1,i+1),e1t(1,1))
3622 call transpose2(Eug(1,1,i+2),e2t(1,1))
3623 call transpose2(Eug(1,1,i+3),e3t(1,1))
3624 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3625 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3626 s1=scalar2(b1(1,iti2),auxvec(1))
3627 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3628 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3629 s2=scalar2(b1(1,iti1),auxvec(1))
3630 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3631 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3632 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3633 eello_turn4=eello_turn4-(s1+s2+s3)
3634 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3635 & 'eturn4',i,j,-(s1+s2+s3)
3636 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3637 cd & ' eello_turn4_num',8*eello_turn4_num
3638 C Derivatives in gamma(i)
3639 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3640 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3641 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3642 s1=scalar2(b1(1,iti2),auxvec(1))
3643 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3644 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3645 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3646 C Derivatives in gamma(i+1)
3647 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3648 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3649 s2=scalar2(b1(1,iti1),auxvec(1))
3650 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3651 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3652 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3653 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3654 C Derivatives in gamma(i+2)
3655 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3656 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3657 s1=scalar2(b1(1,iti2),auxvec(1))
3658 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3659 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3660 s2=scalar2(b1(1,iti1),auxvec(1))
3661 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3662 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3663 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3664 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3665 C Cartesian derivatives
3666 C Derivatives of this turn contributions in DC(i+2)
3667 if (j.lt.nres-1) then
3669 a_temp(1,1)=agg(l,1)
3670 a_temp(1,2)=agg(l,2)
3671 a_temp(2,1)=agg(l,3)
3672 a_temp(2,2)=agg(l,4)
3673 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3674 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3675 s1=scalar2(b1(1,iti2),auxvec(1))
3676 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3677 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3678 s2=scalar2(b1(1,iti1),auxvec(1))
3679 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3680 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3681 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3683 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3686 C Remaining derivatives of this turn contribution
3688 a_temp(1,1)=aggi(l,1)
3689 a_temp(1,2)=aggi(l,2)
3690 a_temp(2,1)=aggi(l,3)
3691 a_temp(2,2)=aggi(l,4)
3692 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3693 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3694 s1=scalar2(b1(1,iti2),auxvec(1))
3695 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3696 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3697 s2=scalar2(b1(1,iti1),auxvec(1))
3698 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3699 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3700 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3701 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3702 a_temp(1,1)=aggi1(l,1)
3703 a_temp(1,2)=aggi1(l,2)
3704 a_temp(2,1)=aggi1(l,3)
3705 a_temp(2,2)=aggi1(l,4)
3706 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3707 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3708 s1=scalar2(b1(1,iti2),auxvec(1))
3709 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3710 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3711 s2=scalar2(b1(1,iti1),auxvec(1))
3712 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3713 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3714 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3715 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3716 a_temp(1,1)=aggj(l,1)
3717 a_temp(1,2)=aggj(l,2)
3718 a_temp(2,1)=aggj(l,3)
3719 a_temp(2,2)=aggj(l,4)
3720 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3721 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3722 s1=scalar2(b1(1,iti2),auxvec(1))
3723 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3724 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3725 s2=scalar2(b1(1,iti1),auxvec(1))
3726 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3727 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3728 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3729 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3730 a_temp(1,1)=aggj1(l,1)
3731 a_temp(1,2)=aggj1(l,2)
3732 a_temp(2,1)=aggj1(l,3)
3733 a_temp(2,2)=aggj1(l,4)
3734 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3735 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3736 s1=scalar2(b1(1,iti2),auxvec(1))
3737 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3738 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3739 s2=scalar2(b1(1,iti1),auxvec(1))
3740 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3741 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3742 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3743 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3744 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3748 C-----------------------------------------------------------------------------
3749 subroutine vecpr(u,v,w)
3750 implicit real*8(a-h,o-z)
3751 dimension u(3),v(3),w(3)
3752 w(1)=u(2)*v(3)-u(3)*v(2)
3753 w(2)=-u(1)*v(3)+u(3)*v(1)
3754 w(3)=u(1)*v(2)-u(2)*v(1)
3757 C-----------------------------------------------------------------------------
3758 subroutine unormderiv(u,ugrad,unorm,ungrad)
3759 C This subroutine computes the derivatives of a normalized vector u, given
3760 C the derivatives computed without normalization conditions, ugrad. Returns
3763 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3764 double precision vec(3)
3765 double precision scalar
3767 c write (2,*) 'ugrad',ugrad
3770 vec(i)=scalar(ugrad(1,i),u(1))
3772 c write (2,*) 'vec',vec
3775 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3778 c write (2,*) 'ungrad',ungrad
3781 C-----------------------------------------------------------------------------
3782 subroutine escp_soft_sphere(evdw2,evdw2_14)
3784 C This subroutine calculates the excluded-volume interaction energy between
3785 C peptide-group centers and side chains and its gradient in virtual-bond and
3786 C side-chain vectors.
3788 implicit real*8 (a-h,o-z)
3789 include 'DIMENSIONS'
3790 include 'COMMON.GEO'
3791 include 'COMMON.VAR'
3792 include 'COMMON.LOCAL'
3793 include 'COMMON.CHAIN'
3794 include 'COMMON.DERIV'
3795 include 'COMMON.INTERACT'
3796 include 'COMMON.FFIELD'
3797 include 'COMMON.IOUNITS'
3798 include 'COMMON.CONTROL'
3803 cd print '(a)','Enter ESCP'
3804 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3805 do i=iatscp_s,iatscp_e
3806 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
3808 xi=0.5D0*(c(1,i)+c(1,i+1))
3809 yi=0.5D0*(c(2,i)+c(2,i+1))
3810 zi=0.5D0*(c(3,i)+c(3,i+1))
3812 do iint=1,nscp_gr(i)
3814 do j=iscpstart(i,iint),iscpend(i,iint)
3815 if (itype(j).eq.21) cycle
3817 C Uncomment following three lines for SC-p interactions
3821 C Uncomment following three lines for Ca-p interactions
3825 rij=xj*xj+yj*yj+zj*zj
3828 if (rij.lt.r0ijsq) then
3829 evdwij=0.25d0*(rij-r0ijsq)**2
3837 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3842 cgrad if (j.lt.i) then
3843 cd write (iout,*) 'j<i'
3844 C Uncomment following three lines for SC-p interactions
3846 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3849 cd write (iout,*) 'j>i'
3851 cgrad ggg(k)=-ggg(k)
3852 C Uncomment following line for SC-p interactions
3853 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3857 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3859 cgrad kstart=min0(i+1,j)
3860 cgrad kend=max0(i-1,j-1)
3861 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3862 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3863 cgrad do k=kstart,kend
3865 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3869 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3870 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3878 C-----------------------------------------------------------------------------
3879 subroutine escp(evdw2,evdw2_14)
3881 C This subroutine calculates the excluded-volume interaction energy between
3882 C peptide-group centers and side chains and its gradient in virtual-bond and
3883 C side-chain vectors.
3885 implicit real*8 (a-h,o-z)
3886 include 'DIMENSIONS'
3887 include 'COMMON.GEO'
3888 include 'COMMON.VAR'
3889 include 'COMMON.LOCAL'
3890 include 'COMMON.CHAIN'
3891 include 'COMMON.DERIV'
3892 include 'COMMON.INTERACT'
3893 include 'COMMON.FFIELD'
3894 include 'COMMON.IOUNITS'
3895 include 'COMMON.CONTROL'
3899 cd print '(a)','Enter ESCP'
3900 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3901 do i=iatscp_s,iatscp_e
3902 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
3904 xi=0.5D0*(c(1,i)+c(1,i+1))
3905 yi=0.5D0*(c(2,i)+c(2,i+1))
3906 zi=0.5D0*(c(3,i)+c(3,i+1))
3908 do iint=1,nscp_gr(i)
3910 do j=iscpstart(i,iint),iscpend(i,iint)
3912 if (itypj.eq.21) cycle
3913 C Uncomment following three lines for SC-p interactions
3917 C Uncomment following three lines for Ca-p interactions
3921 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3923 e1=fac*fac*aad(itypj,iteli)
3924 e2=fac*bad(itypj,iteli)
3925 if (iabs(j-i) .le. 2) then
3928 evdw2_14=evdw2_14+e1+e2
3932 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3933 & 'evdw2',i,j,evdwij
3935 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3937 fac=-(evdwij+e1)*rrij
3941 cgrad if (j.lt.i) then
3942 cd write (iout,*) 'j<i'
3943 C Uncomment following three lines for SC-p interactions
3945 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3948 cd write (iout,*) 'j>i'
3950 cgrad ggg(k)=-ggg(k)
3951 C Uncomment following line for SC-p interactions
3952 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3953 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3957 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3959 cgrad kstart=min0(i+1,j)
3960 cgrad kend=max0(i-1,j-1)
3961 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3962 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3963 cgrad do k=kstart,kend
3965 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3969 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3970 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3978 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3979 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
3980 gradx_scp(j,i)=expon*gradx_scp(j,i)
3983 C******************************************************************************
3987 C To save time the factor EXPON has been extracted from ALL components
3988 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3991 C******************************************************************************
3994 C--------------------------------------------------------------------------
3995 subroutine edis(ehpb)
3997 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3999 implicit real*8 (a-h,o-z)
4000 include 'DIMENSIONS'
4001 include 'COMMON.SBRIDGE'
4002 include 'COMMON.CHAIN'
4003 include 'COMMON.DERIV'
4004 include 'COMMON.VAR'
4005 include 'COMMON.INTERACT'
4006 include 'COMMON.IOUNITS'
4009 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4010 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4011 if (link_end.eq.0) return
4012 do i=link_start,link_end
4013 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4014 C CA-CA distance used in regularization of structure.
4017 C iii and jjj point to the residues for which the distance is assigned.
4018 if (ii.gt.nres) then
4025 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4026 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4027 C distance and angle dependent SS bond potential.
4028 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4029 call ssbond_ene(iii,jjj,eij)
4031 cd write (iout,*) "eij",eij
4033 C Calculate the distance between the two points and its difference from the
4037 C Get the force constant corresponding to this distance.
4039 C Calculate the contribution to energy.
4040 ehpb=ehpb+waga*rdis*rdis
4042 C Evaluate gradient.
4045 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4046 cd & ' waga=',waga,' fac=',fac
4048 ggg(j)=fac*(c(j,jj)-c(j,ii))
4050 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4051 C If this is a SC-SC distance, we need to calculate the contributions to the
4052 C Cartesian gradient in the SC vectors (ghpbx).
4055 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4056 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4059 cgrad do j=iii,jjj-1
4061 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4065 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4066 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4073 C--------------------------------------------------------------------------
4074 subroutine ssbond_ene(i,j,eij)
4076 C Calculate the distance and angle dependent SS-bond potential energy
4077 C using a free-energy function derived based on RHF/6-31G** ab initio
4078 C calculations of diethyl disulfide.
4080 C A. Liwo and U. Kozlowska, 11/24/03
4082 implicit real*8 (a-h,o-z)
4083 include 'DIMENSIONS'
4084 include 'COMMON.SBRIDGE'
4085 include 'COMMON.CHAIN'
4086 include 'COMMON.DERIV'
4087 include 'COMMON.LOCAL'
4088 include 'COMMON.INTERACT'
4089 include 'COMMON.VAR'
4090 include 'COMMON.IOUNITS'
4091 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4096 dxi=dc_norm(1,nres+i)
4097 dyi=dc_norm(2,nres+i)
4098 dzi=dc_norm(3,nres+i)
4099 c dsci_inv=dsc_inv(itypi)
4100 dsci_inv=vbld_inv(nres+i)
4102 c dscj_inv=dsc_inv(itypj)
4103 dscj_inv=vbld_inv(nres+j)
4107 dxj=dc_norm(1,nres+j)
4108 dyj=dc_norm(2,nres+j)
4109 dzj=dc_norm(3,nres+j)
4110 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4115 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4116 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4117 om12=dxi*dxj+dyi*dyj+dzi*dzj
4119 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4120 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4126 deltat12=om2-om1+2.0d0
4128 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4129 & +akct*deltad*deltat12
4130 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4131 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4132 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4133 c & " deltat12",deltat12," eij",eij
4134 ed=2*akcm*deltad+akct*deltat12
4136 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4137 eom1=-2*akth*deltat1-pom1-om2*pom2
4138 eom2= 2*akth*deltat2+pom1-om1*pom2
4141 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4142 ghpbx(k,i)=ghpbx(k,i)-ggk
4143 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4144 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4145 ghpbx(k,j)=ghpbx(k,j)+ggk
4146 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4147 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4148 ghpbc(k,i)=ghpbc(k,i)-ggk
4149 ghpbc(k,j)=ghpbc(k,j)+ggk
4152 C Calculate the components of the gradient in DC and X
4156 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4161 C--------------------------------------------------------------------------
4162 subroutine ebond(estr)
4164 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4166 implicit real*8 (a-h,o-z)
4167 include 'DIMENSIONS'
4168 include 'COMMON.LOCAL'
4169 include 'COMMON.GEO'
4170 include 'COMMON.INTERACT'
4171 include 'COMMON.DERIV'
4172 include 'COMMON.VAR'
4173 include 'COMMON.CHAIN'
4174 include 'COMMON.IOUNITS'
4175 include 'COMMON.NAMES'
4176 include 'COMMON.FFIELD'
4177 include 'COMMON.CONTROL'
4178 include 'COMMON.SETUP'
4179 double precision u(3),ud(3)
4182 do i=ibondp_start,ibondp_end
4183 if (itype(i-1).eq.21 .or. itype(i).eq.21) then
4184 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4186 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4187 & *dc(j,i-1)/vbld(i)
4189 if (energy_dec) write(iout,*)
4190 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4192 diff = vbld(i)-vbldp0
4193 if (energy_dec) write (iout,*)
4194 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4197 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4199 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4202 estr=0.5d0*AKP*estr+estr1
4204 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4206 do i=ibond_start,ibond_end
4208 if (iti.ne.10 .and. iti.ne.21) then
4211 diff=vbld(i+nres)-vbldsc0(1,iti)
4212 if (energy_dec) write (iout,*)
4213 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4214 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4215 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4217 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4221 diff=vbld(i+nres)-vbldsc0(j,iti)
4222 ud(j)=aksc(j,iti)*diff
4223 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4237 uprod2=uprod2*u(k)*u(k)
4241 usumsqder=usumsqder+ud(j)*uprod2
4243 estr=estr+uprod/usum
4245 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4253 C--------------------------------------------------------------------------
4254 subroutine ebend(etheta)
4256 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4257 C angles gamma and its derivatives in consecutive thetas and gammas.
4259 implicit real*8 (a-h,o-z)
4260 include 'DIMENSIONS'
4261 include 'COMMON.LOCAL'
4262 include 'COMMON.GEO'
4263 include 'COMMON.INTERACT'
4264 include 'COMMON.DERIV'
4265 include 'COMMON.VAR'
4266 include 'COMMON.CHAIN'
4267 include 'COMMON.IOUNITS'
4268 include 'COMMON.NAMES'
4269 include 'COMMON.FFIELD'
4270 include 'COMMON.CONTROL'
4271 common /calcthet/ term1,term2,termm,diffak,ratak,
4272 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4273 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4274 double precision y(2),z(2)
4276 c time11=dexp(-2*time)
4279 c write (*,'(a,i2)') 'EBEND ICG=',icg
4280 do i=ithet_start,ithet_end
4281 if (itype(i-1).eq.21) cycle
4282 C Zero the energy function and its derivative at 0 or pi.
4283 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4285 if (i.gt.3 .and. itype(i-2).ne.21) then
4288 if (phii.ne.phii) phii=150.0
4298 if (i.lt.nres .and. itype(i).ne.21) then
4301 if (phii1.ne.phii1) phii1=150.0
4313 C Calculate the "mean" value of theta from the part of the distribution
4314 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4315 C In following comments this theta will be referred to as t_c.
4316 thet_pred_mean=0.0d0
4320 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4322 dthett=thet_pred_mean*ssd
4323 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4324 C Derivatives of the "mean" values in gamma1 and gamma2.
4325 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4326 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4327 if (theta(i).gt.pi-delta) then
4328 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4330 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4331 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4332 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4334 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4336 else if (theta(i).lt.delta) then
4337 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4338 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4339 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4341 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4342 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4345 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4348 etheta=etheta+ethetai
4349 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4351 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4352 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4353 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4355 C Ufff.... We've done all this!!!
4358 C---------------------------------------------------------------------------
4359 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4361 implicit real*8 (a-h,o-z)
4362 include 'DIMENSIONS'
4363 include 'COMMON.LOCAL'
4364 include 'COMMON.IOUNITS'
4365 common /calcthet/ term1,term2,termm,diffak,ratak,
4366 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4367 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4368 C Calculate the contributions to both Gaussian lobes.
4369 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4370 C The "polynomial part" of the "standard deviation" of this part of
4374 sig=sig*thet_pred_mean+polthet(j,it)
4376 C Derivative of the "interior part" of the "standard deviation of the"
4377 C gamma-dependent Gaussian lobe in t_c.
4378 sigtc=3*polthet(3,it)
4380 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4383 C Set the parameters of both Gaussian lobes of the distribution.
4384 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4385 fac=sig*sig+sigc0(it)
4388 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4389 sigsqtc=-4.0D0*sigcsq*sigtc
4390 c print *,i,sig,sigtc,sigsqtc
4391 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4392 sigtc=-sigtc/(fac*fac)
4393 C Following variable is sigma(t_c)**(-2)
4394 sigcsq=sigcsq*sigcsq
4396 sig0inv=1.0D0/sig0i**2
4397 delthec=thetai-thet_pred_mean
4398 delthe0=thetai-theta0i
4399 term1=-0.5D0*sigcsq*delthec*delthec
4400 term2=-0.5D0*sig0inv*delthe0*delthe0
4401 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4402 C NaNs in taking the logarithm. We extract the largest exponent which is added
4403 C to the energy (this being the log of the distribution) at the end of energy
4404 C term evaluation for this virtual-bond angle.
4405 if (term1.gt.term2) then
4407 term2=dexp(term2-termm)
4411 term1=dexp(term1-termm)
4414 C The ratio between the gamma-independent and gamma-dependent lobes of
4415 C the distribution is a Gaussian function of thet_pred_mean too.
4416 diffak=gthet(2,it)-thet_pred_mean
4417 ratak=diffak/gthet(3,it)**2
4418 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4419 C Let's differentiate it in thet_pred_mean NOW.
4421 C Now put together the distribution terms to make complete distribution.
4422 termexp=term1+ak*term2
4423 termpre=sigc+ak*sig0i
4424 C Contribution of the bending energy from this theta is just the -log of
4425 C the sum of the contributions from the two lobes and the pre-exponential
4426 C factor. Simple enough, isn't it?
4427 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4428 C NOW the derivatives!!!
4429 C 6/6/97 Take into account the deformation.
4430 E_theta=(delthec*sigcsq*term1
4431 & +ak*delthe0*sig0inv*term2)/termexp
4432 E_tc=((sigtc+aktc*sig0i)/termpre
4433 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4434 & aktc*term2)/termexp)
4437 c-----------------------------------------------------------------------------
4438 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4439 implicit real*8 (a-h,o-z)
4440 include 'DIMENSIONS'
4441 include 'COMMON.LOCAL'
4442 include 'COMMON.IOUNITS'
4443 common /calcthet/ term1,term2,termm,diffak,ratak,
4444 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4445 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4446 delthec=thetai-thet_pred_mean
4447 delthe0=thetai-theta0i
4448 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4449 t3 = thetai-thet_pred_mean
4453 t14 = t12+t6*sigsqtc
4455 t21 = thetai-theta0i
4461 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4462 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4463 & *(-t12*t9-ak*sig0inv*t27)
4467 C--------------------------------------------------------------------------
4468 subroutine ebend(etheta)
4470 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4471 C angles gamma and its derivatives in consecutive thetas and gammas.
4472 C ab initio-derived potentials from
4473 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4475 implicit real*8 (a-h,o-z)
4476 include 'DIMENSIONS'
4477 include 'COMMON.LOCAL'
4478 include 'COMMON.GEO'
4479 include 'COMMON.INTERACT'
4480 include 'COMMON.DERIV'
4481 include 'COMMON.VAR'
4482 include 'COMMON.CHAIN'
4483 include 'COMMON.IOUNITS'
4484 include 'COMMON.NAMES'
4485 include 'COMMON.FFIELD'
4486 include 'COMMON.CONTROL'
4487 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4488 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4489 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4490 & sinph1ph2(maxdouble,maxdouble)
4491 logical lprn /.false./, lprn1 /.false./
4493 do i=ithet_start,ithet_end
4494 if (itype(i-1).eq.21) cycle
4498 theti2=0.5d0*theta(i)
4499 ityp2=ithetyp(itype(i-1))
4501 coskt(k)=dcos(k*theti2)
4502 sinkt(k)=dsin(k*theti2)
4504 if (i.gt.3 .and. itype(i-2).ne.21) then
4507 if (phii.ne.phii) phii=150.0
4511 ityp1=ithetyp(itype(i-2))
4513 cosph1(k)=dcos(k*phii)
4514 sinph1(k)=dsin(k*phii)
4524 if (i.lt.nres .and. itype(i).ne.21) then
4527 if (phii1.ne.phii1) phii1=150.0
4532 ityp3=ithetyp(itype(i))
4534 cosph2(k)=dcos(k*phii1)
4535 sinph2(k)=dsin(k*phii1)
4545 ethetai=aa0thet(ityp1,ityp2,ityp3)
4548 ccl=cosph1(l)*cosph2(k-l)
4549 ssl=sinph1(l)*sinph2(k-l)
4550 scl=sinph1(l)*cosph2(k-l)
4551 csl=cosph1(l)*sinph2(k-l)
4552 cosph1ph2(l,k)=ccl-ssl
4553 cosph1ph2(k,l)=ccl+ssl
4554 sinph1ph2(l,k)=scl+csl
4555 sinph1ph2(k,l)=scl-csl
4559 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4560 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4561 write (iout,*) "coskt and sinkt"
4563 write (iout,*) k,coskt(k),sinkt(k)
4567 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4568 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4571 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4572 & " ethetai",ethetai
4575 write (iout,*) "cosph and sinph"
4577 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4579 write (iout,*) "cosph1ph2 and sinph2ph2"
4582 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4583 & sinph1ph2(l,k),sinph1ph2(k,l)
4586 write(iout,*) "ethetai",ethetai
4590 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4591 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4592 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4593 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4594 ethetai=ethetai+sinkt(m)*aux
4595 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4596 dephii=dephii+k*sinkt(m)*(
4597 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4598 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4599 dephii1=dephii1+k*sinkt(m)*(
4600 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4601 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4603 & write (iout,*) "m",m," k",k," bbthet",
4604 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4605 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4606 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4607 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4611 & write(iout,*) "ethetai",ethetai
4615 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4616 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4617 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4618 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4619 ethetai=ethetai+sinkt(m)*aux
4620 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4621 dephii=dephii+l*sinkt(m)*(
4622 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4623 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4624 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4625 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4626 dephii1=dephii1+(k-l)*sinkt(m)*(
4627 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4628 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4629 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4630 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4632 write (iout,*) "m",m," k",k," l",l," ffthet",
4633 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4634 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4635 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4636 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4637 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4638 & cosph1ph2(k,l)*sinkt(m),
4639 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4645 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4646 & i,theta(i)*rad2deg,phii*rad2deg,
4647 & phii1*rad2deg,ethetai
4648 etheta=etheta+ethetai
4649 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4650 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4651 gloc(nphi+i-2,icg)=wang*dethetai
4657 c-----------------------------------------------------------------------------
4658 subroutine esc(escloc)
4659 C Calculate the local energy of a side chain and its derivatives in the
4660 C corresponding virtual-bond valence angles THETA and the spherical angles
4662 implicit real*8 (a-h,o-z)
4663 include 'DIMENSIONS'
4664 include 'COMMON.GEO'
4665 include 'COMMON.LOCAL'
4666 include 'COMMON.VAR'
4667 include 'COMMON.INTERACT'
4668 include 'COMMON.DERIV'
4669 include 'COMMON.CHAIN'
4670 include 'COMMON.IOUNITS'
4671 include 'COMMON.NAMES'
4672 include 'COMMON.FFIELD'
4673 include 'COMMON.CONTROL'
4674 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4675 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4676 common /sccalc/ time11,time12,time112,theti,it,nlobit
4679 c write (iout,'(a)') 'ESC'
4680 do i=loc_start,loc_end
4683 if (it.eq.10) goto 1
4685 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4686 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4687 theti=theta(i+1)-pipol
4692 if (x(2).gt.pi-delta) then
4696 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4698 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4699 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4701 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4702 & ddersc0(1),dersc(1))
4703 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4704 & ddersc0(3),dersc(3))
4706 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4708 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4709 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4710 & dersc0(2),esclocbi,dersc02)
4711 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4713 call splinthet(x(2),0.5d0*delta,ss,ssd)
4718 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4720 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4721 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4723 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4725 c write (iout,*) escloci
4726 else if (x(2).lt.delta) then
4730 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4732 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4733 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4735 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4736 & ddersc0(1),dersc(1))
4737 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4738 & ddersc0(3),dersc(3))
4740 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4742 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4743 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4744 & dersc0(2),esclocbi,dersc02)
4745 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4750 call splinthet(x(2),0.5d0*delta,ss,ssd)
4752 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4754 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4755 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4757 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4758 c write (iout,*) escloci
4760 call enesc(x,escloci,dersc,ddummy,.false.)
4763 escloc=escloc+escloci
4764 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4765 & 'escloc',i,escloci
4766 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4768 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4770 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4771 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4776 C---------------------------------------------------------------------------
4777 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4778 implicit real*8 (a-h,o-z)
4779 include 'DIMENSIONS'
4780 include 'COMMON.GEO'
4781 include 'COMMON.LOCAL'
4782 include 'COMMON.IOUNITS'
4783 common /sccalc/ time11,time12,time112,theti,it,nlobit
4784 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4785 double precision contr(maxlob,-1:1)
4787 c write (iout,*) 'it=',it,' nlobit=',nlobit
4791 if (mixed) ddersc(j)=0.0d0
4795 C Because of periodicity of the dependence of the SC energy in omega we have
4796 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4797 C To avoid underflows, first compute & store the exponents.
4805 z(k)=x(k)-censc(k,j,it)
4810 Axk=Axk+gaussc(l,k,j,it)*z(l)
4816 expfac=expfac+Ax(k,j,iii)*z(k)
4824 C As in the case of ebend, we want to avoid underflows in exponentiation and
4825 C subsequent NaNs and INFs in energy calculation.
4826 C Find the largest exponent
4830 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4834 cd print *,'it=',it,' emin=',emin
4836 C Compute the contribution to SC energy and derivatives
4841 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
4842 if(adexp.ne.adexp) adexp=1.0
4845 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4847 cd print *,'j=',j,' expfac=',expfac
4848 escloc_i=escloc_i+expfac
4850 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4854 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4855 & +gaussc(k,2,j,it))*expfac
4862 dersc(1)=dersc(1)/cos(theti)**2
4863 ddersc(1)=ddersc(1)/cos(theti)**2
4866 escloci=-(dlog(escloc_i)-emin)
4868 dersc(j)=dersc(j)/escloc_i
4872 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4877 C------------------------------------------------------------------------------
4878 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4879 implicit real*8 (a-h,o-z)
4880 include 'DIMENSIONS'
4881 include 'COMMON.GEO'
4882 include 'COMMON.LOCAL'
4883 include 'COMMON.IOUNITS'
4884 common /sccalc/ time11,time12,time112,theti,it,nlobit
4885 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4886 double precision contr(maxlob)
4897 z(k)=x(k)-censc(k,j,it)
4903 Axk=Axk+gaussc(l,k,j,it)*z(l)
4909 expfac=expfac+Ax(k,j)*z(k)
4914 C As in the case of ebend, we want to avoid underflows in exponentiation and
4915 C subsequent NaNs and INFs in energy calculation.
4916 C Find the largest exponent
4919 if (emin.gt.contr(j)) emin=contr(j)
4923 C Compute the contribution to SC energy and derivatives
4927 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4928 escloc_i=escloc_i+expfac
4930 dersc(k)=dersc(k)+Ax(k,j)*expfac
4932 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4933 & +gaussc(1,2,j,it))*expfac
4937 dersc(1)=dersc(1)/cos(theti)**2
4938 dersc12=dersc12/cos(theti)**2
4939 escloci=-(dlog(escloc_i)-emin)
4941 dersc(j)=dersc(j)/escloc_i
4943 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4947 c----------------------------------------------------------------------------------
4948 subroutine esc(escloc)
4949 C Calculate the local energy of a side chain and its derivatives in the
4950 C corresponding virtual-bond valence angles THETA and the spherical angles
4951 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4952 C added by Urszula Kozlowska. 07/11/2007
4954 implicit real*8 (a-h,o-z)
4955 include 'DIMENSIONS'
4956 include 'COMMON.GEO'
4957 include 'COMMON.LOCAL'
4958 include 'COMMON.VAR'
4959 include 'COMMON.SCROT'
4960 include 'COMMON.INTERACT'
4961 include 'COMMON.DERIV'
4962 include 'COMMON.CHAIN'
4963 include 'COMMON.IOUNITS'
4964 include 'COMMON.NAMES'
4965 include 'COMMON.FFIELD'
4966 include 'COMMON.CONTROL'
4967 include 'COMMON.VECTORS'
4968 double precision x_prime(3),y_prime(3),z_prime(3)
4969 & , sumene,dsc_i,dp2_i,x(65),
4970 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4971 & de_dxx,de_dyy,de_dzz,de_dt
4972 double precision s1_t,s1_6_t,s2_t,s2_6_t
4974 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4975 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4976 & dt_dCi(3),dt_dCi1(3)
4977 common /sccalc/ time11,time12,time112,theti,it,nlobit
4980 do i=loc_start,loc_end
4981 if (itype(i).eq.21) cycle
4982 costtab(i+1) =dcos(theta(i+1))
4983 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4984 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4985 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4986 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4987 cosfac=dsqrt(cosfac2)
4988 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4989 sinfac=dsqrt(sinfac2)
4991 if (it.eq.10) goto 1
4993 C Compute the axes of tghe local cartesian coordinates system; store in
4994 c x_prime, y_prime and z_prime
5001 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5002 C & dc_norm(3,i+nres)
5004 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5005 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5008 z_prime(j) = -uz(j,i-1)
5011 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5012 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5013 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5014 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5015 c & " xy",scalar(x_prime(1),y_prime(1)),
5016 c & " xz",scalar(x_prime(1),z_prime(1)),
5017 c & " yy",scalar(y_prime(1),y_prime(1)),
5018 c & " yz",scalar(y_prime(1),z_prime(1)),
5019 c & " zz",scalar(z_prime(1),z_prime(1))
5021 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5022 C to local coordinate system. Store in xx, yy, zz.
5028 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5029 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5030 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5037 C Compute the energy of the ith side cbain
5039 c write (2,*) "xx",xx," yy",yy," zz",zz
5042 x(j) = sc_parmin(j,it)
5045 Cc diagnostics - remove later
5047 yy1 = dsin(alph(2))*dcos(omeg(2))
5048 zz1 = -dsin(alph(2))*dsin(omeg(2))
5049 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5050 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5052 C," --- ", xx_w,yy_w,zz_w
5055 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5056 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5058 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5059 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5061 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5062 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5063 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5064 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5065 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5067 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5068 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5069 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5070 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5071 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5073 dsc_i = 0.743d0+x(61)
5075 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5076 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5077 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5078 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5079 s1=(1+x(63))/(0.1d0 + dscp1)
5080 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5081 s2=(1+x(65))/(0.1d0 + dscp2)
5082 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5083 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5084 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5085 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5087 c & dscp1,dscp2,sumene
5088 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5089 escloc = escloc + sumene
5090 c write (2,*) "i",i," escloc",sumene,escloc
5093 C This section to check the numerical derivatives of the energy of ith side
5094 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5095 C #define DEBUG in the code to turn it on.
5097 write (2,*) "sumene =",sumene
5101 write (2,*) xx,yy,zz
5102 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5103 de_dxx_num=(sumenep-sumene)/aincr
5105 write (2,*) "xx+ sumene from enesc=",sumenep
5108 write (2,*) xx,yy,zz
5109 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5110 de_dyy_num=(sumenep-sumene)/aincr
5112 write (2,*) "yy+ sumene from enesc=",sumenep
5115 write (2,*) xx,yy,zz
5116 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5117 de_dzz_num=(sumenep-sumene)/aincr
5119 write (2,*) "zz+ sumene from enesc=",sumenep
5120 costsave=cost2tab(i+1)
5121 sintsave=sint2tab(i+1)
5122 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5123 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5124 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5125 de_dt_num=(sumenep-sumene)/aincr
5126 write (2,*) " t+ sumene from enesc=",sumenep
5127 cost2tab(i+1)=costsave
5128 sint2tab(i+1)=sintsave
5129 C End of diagnostics section.
5132 C Compute the gradient of esc
5134 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5135 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5136 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5137 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5138 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5139 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5140 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5141 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5142 pom1=(sumene3*sint2tab(i+1)+sumene1)
5143 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5144 pom2=(sumene4*cost2tab(i+1)+sumene2)
5145 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5146 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5147 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5148 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5150 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5151 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5152 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5154 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5155 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5156 & +(pom1+pom2)*pom_dx
5158 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5161 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5162 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5163 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5165 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5166 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5167 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5168 & +x(59)*zz**2 +x(60)*xx*zz
5169 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5170 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5171 & +(pom1-pom2)*pom_dy
5173 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5176 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5177 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5178 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5179 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5180 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5181 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5182 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5183 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5185 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5188 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5189 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5190 & +pom1*pom_dt1+pom2*pom_dt2
5192 write(2,*), "de_dt = ", de_dt,de_dt_num
5196 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5197 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5198 cosfac2xx=cosfac2*xx
5199 sinfac2yy=sinfac2*yy
5201 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5203 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5205 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5206 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5207 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5208 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5209 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5210 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5211 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5212 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5213 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5214 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5218 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5219 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5222 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5223 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5224 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5226 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5227 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5231 dXX_Ctab(k,i)=dXX_Ci(k)
5232 dXX_C1tab(k,i)=dXX_Ci1(k)
5233 dYY_Ctab(k,i)=dYY_Ci(k)
5234 dYY_C1tab(k,i)=dYY_Ci1(k)
5235 dZZ_Ctab(k,i)=dZZ_Ci(k)
5236 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5237 dXX_XYZtab(k,i)=dXX_XYZ(k)
5238 dYY_XYZtab(k,i)=dYY_XYZ(k)
5239 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5243 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5244 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5245 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5246 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5247 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5249 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5250 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5251 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5252 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5253 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5254 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5255 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5256 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5258 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5259 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5261 C to check gradient call subroutine check_grad
5267 c------------------------------------------------------------------------------
5268 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5270 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5271 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5272 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5273 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5275 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5276 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5278 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5279 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5280 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5281 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5282 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5284 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5285 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5286 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5287 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5288 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5290 dsc_i = 0.743d0+x(61)
5292 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5293 & *(xx*cost2+yy*sint2))
5294 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5295 & *(xx*cost2-yy*sint2))
5296 s1=(1+x(63))/(0.1d0 + dscp1)
5297 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5298 s2=(1+x(65))/(0.1d0 + dscp2)
5299 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5300 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5301 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5306 c------------------------------------------------------------------------------
5307 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5309 C This procedure calculates two-body contact function g(rij) and its derivative:
5312 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5315 C where x=(rij-r0ij)/delta
5317 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5320 double precision rij,r0ij,eps0ij,fcont,fprimcont
5321 double precision x,x2,x4,delta
5325 if (x.lt.-1.0D0) then
5328 else if (x.le.1.0D0) then
5331 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5332 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5339 c------------------------------------------------------------------------------
5340 subroutine splinthet(theti,delta,ss,ssder)
5341 implicit real*8 (a-h,o-z)
5342 include 'DIMENSIONS'
5343 include 'COMMON.VAR'
5344 include 'COMMON.GEO'
5347 if (theti.gt.pipol) then
5348 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5350 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5355 c------------------------------------------------------------------------------
5356 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5358 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5359 double precision ksi,ksi2,ksi3,a1,a2,a3
5360 a1=fprim0*delta/(f1-f0)
5366 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5367 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5370 c------------------------------------------------------------------------------
5371 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5373 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5374 double precision ksi,ksi2,ksi3,a1,a2,a3
5379 a2=3*(f1x-f0x)-2*fprim0x*delta
5380 a3=fprim0x*delta-2*(f1x-f0x)
5381 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5384 C-----------------------------------------------------------------------------
5386 C-----------------------------------------------------------------------------
5387 subroutine etor(etors,edihcnstr)
5388 implicit real*8 (a-h,o-z)
5389 include 'DIMENSIONS'
5390 include 'COMMON.VAR'
5391 include 'COMMON.GEO'
5392 include 'COMMON.LOCAL'
5393 include 'COMMON.TORSION'
5394 include 'COMMON.INTERACT'
5395 include 'COMMON.DERIV'
5396 include 'COMMON.CHAIN'
5397 include 'COMMON.NAMES'
5398 include 'COMMON.IOUNITS'
5399 include 'COMMON.FFIELD'
5400 include 'COMMON.TORCNSTR'
5401 include 'COMMON.CONTROL'
5403 C Set lprn=.true. for debugging
5407 do i=iphi_start,iphi_end
5409 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
5410 & .or. itype(i).eq.21) cycle
5411 itori=itortyp(itype(i-2))
5412 itori1=itortyp(itype(i-1))
5415 C Proline-Proline pair is a special case...
5416 if (itori.eq.3 .and. itori1.eq.3) then
5417 if (phii.gt.-dwapi3) then
5419 fac=1.0D0/(1.0D0-cosphi)
5420 etorsi=v1(1,3,3)*fac
5421 etorsi=etorsi+etorsi
5422 etors=etors+etorsi-v1(1,3,3)
5423 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5424 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5427 v1ij=v1(j+1,itori,itori1)
5428 v2ij=v2(j+1,itori,itori1)
5431 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5432 if (energy_dec) etors_ii=etors_ii+
5433 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5434 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5438 v1ij=v1(j,itori,itori1)
5439 v2ij=v2(j,itori,itori1)
5442 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5443 if (energy_dec) etors_ii=etors_ii+
5444 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5445 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5448 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5451 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5452 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5453 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5454 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5455 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5457 ! 6/20/98 - dihedral angle constraints
5460 itori=idih_constr(i)
5463 if (difi.gt.drange(i)) then
5465 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5466 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5467 else if (difi.lt.-drange(i)) then
5469 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5470 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5472 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5473 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5475 ! write (iout,*) 'edihcnstr',edihcnstr
5478 c------------------------------------------------------------------------------
5479 subroutine etor_d(etors_d)
5483 c----------------------------------------------------------------------------
5485 subroutine etor(etors,edihcnstr)
5486 implicit real*8 (a-h,o-z)
5487 include 'DIMENSIONS'
5488 include 'COMMON.VAR'
5489 include 'COMMON.GEO'
5490 include 'COMMON.LOCAL'
5491 include 'COMMON.TORSION'
5492 include 'COMMON.INTERACT'
5493 include 'COMMON.DERIV'
5494 include 'COMMON.CHAIN'
5495 include 'COMMON.NAMES'
5496 include 'COMMON.IOUNITS'
5497 include 'COMMON.FFIELD'
5498 include 'COMMON.TORCNSTR'
5499 include 'COMMON.CONTROL'
5501 C Set lprn=.true. for debugging
5505 do i=iphi_start,iphi_end
5506 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
5507 & .or. itype(i).eq.21) cycle
5509 itori=itortyp(itype(i-2))
5510 itori1=itortyp(itype(i-1))
5513 C Regular cosine and sine terms
5514 do j=1,nterm(itori,itori1)
5515 v1ij=v1(j,itori,itori1)
5516 v2ij=v2(j,itori,itori1)
5519 etors=etors+v1ij*cosphi+v2ij*sinphi
5520 if (energy_dec) etors_ii=etors_ii+
5521 & v1ij*cosphi+v2ij*sinphi
5522 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5526 C E = SUM ----------------------------------- - v1
5527 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5529 cosphi=dcos(0.5d0*phii)
5530 sinphi=dsin(0.5d0*phii)
5531 do j=1,nlor(itori,itori1)
5532 vl1ij=vlor1(j,itori,itori1)
5533 vl2ij=vlor2(j,itori,itori1)
5534 vl3ij=vlor3(j,itori,itori1)
5535 pom=vl2ij*cosphi+vl3ij*sinphi
5536 pom1=1.0d0/(pom*pom+1.0d0)
5537 etors=etors+vl1ij*pom1
5538 if (energy_dec) etors_ii=etors_ii+
5541 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5543 C Subtract the constant term
5544 etors=etors-v0(itori,itori1)
5545 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5546 & 'etor',i,etors_ii-v0(itori,itori1)
5548 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5549 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5550 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5551 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5552 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5554 ! 6/20/98 - dihedral angle constraints
5556 c do i=1,ndih_constr
5557 do i=idihconstr_start,idihconstr_end
5558 itori=idih_constr(i)
5560 difi=pinorm(phii-phi0(i))
5561 if (difi.gt.drange(i)) then
5563 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5564 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5565 else if (difi.lt.-drange(i)) then
5567 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5568 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5572 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5573 cd & rad2deg*phi0(i), rad2deg*drange(i),
5574 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5576 cd write (iout,*) 'edihcnstr',edihcnstr
5579 c----------------------------------------------------------------------------
5580 subroutine etor_d(etors_d)
5581 C 6/23/01 Compute double torsional energy
5582 implicit real*8 (a-h,o-z)
5583 include 'DIMENSIONS'
5584 include 'COMMON.VAR'
5585 include 'COMMON.GEO'
5586 include 'COMMON.LOCAL'
5587 include 'COMMON.TORSION'
5588 include 'COMMON.INTERACT'
5589 include 'COMMON.DERIV'
5590 include 'COMMON.CHAIN'
5591 include 'COMMON.NAMES'
5592 include 'COMMON.IOUNITS'
5593 include 'COMMON.FFIELD'
5594 include 'COMMON.TORCNSTR'
5596 C Set lprn=.true. for debugging
5600 do i=iphid_start,iphid_end
5601 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
5602 & .or. itype(i).eq.21 .or. itype(i+1).eq.21) cycle
5603 itori=itortyp(itype(i-2))
5604 itori1=itortyp(itype(i-1))
5605 itori2=itortyp(itype(i))
5610 C Regular cosine and sine terms
5611 do j=1,ntermd_1(itori,itori1,itori2)
5612 v1cij=v1c(1,j,itori,itori1,itori2)
5613 v1sij=v1s(1,j,itori,itori1,itori2)
5614 v2cij=v1c(2,j,itori,itori1,itori2)
5615 v2sij=v1s(2,j,itori,itori1,itori2)
5616 cosphi1=dcos(j*phii)
5617 sinphi1=dsin(j*phii)
5618 cosphi2=dcos(j*phii1)
5619 sinphi2=dsin(j*phii1)
5620 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5621 & v2cij*cosphi2+v2sij*sinphi2
5622 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5623 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5625 do k=2,ntermd_2(itori,itori1,itori2)
5627 v1cdij = v2c(k,l,itori,itori1,itori2)
5628 v2cdij = v2c(l,k,itori,itori1,itori2)
5629 v1sdij = v2s(k,l,itori,itori1,itori2)
5630 v2sdij = v2s(l,k,itori,itori1,itori2)
5631 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5632 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5633 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5634 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5635 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5636 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5637 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5638 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5639 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5640 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5643 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5644 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5649 c------------------------------------------------------------------------------
5650 subroutine eback_sc_corr(esccor)
5651 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5652 c conformational states; temporarily implemented as differences
5653 c between UNRES torsional potentials (dependent on three types of
5654 c residues) and the torsional potentials dependent on all 20 types
5655 c of residues computed from AM1 energy surfaces of terminally-blocked
5656 c amino-acid residues.
5657 implicit real*8 (a-h,o-z)
5658 include 'DIMENSIONS'
5659 include 'COMMON.VAR'
5660 include 'COMMON.GEO'
5661 include 'COMMON.LOCAL'
5662 include 'COMMON.TORSION'
5663 include 'COMMON.SCCOR'
5664 include 'COMMON.INTERACT'
5665 include 'COMMON.DERIV'
5666 include 'COMMON.CHAIN'
5667 include 'COMMON.NAMES'
5668 include 'COMMON.IOUNITS'
5669 include 'COMMON.FFIELD'
5670 include 'COMMON.CONTROL'
5672 C Set lprn=.true. for debugging
5675 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5677 do i=iphi_start,iphi_end
5678 if (itype(i-2).eq.21 .or. itype(i-1).eq.21) cycle
5685 v1ij=v1sccor(j,itori,itori1)
5686 v2ij=v2sccor(j,itori,itori1)
5689 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5690 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5693 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5694 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5695 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5696 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5700 c----------------------------------------------------------------------------
5701 subroutine multibody(ecorr)
5702 C This subroutine calculates multi-body contributions to energy following
5703 C the idea of Skolnick et al. If side chains I and J make a contact and
5704 C at the same time side chains I+1 and J+1 make a contact, an extra
5705 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5706 implicit real*8 (a-h,o-z)
5707 include 'DIMENSIONS'
5708 include 'COMMON.IOUNITS'
5709 include 'COMMON.DERIV'
5710 include 'COMMON.INTERACT'
5711 include 'COMMON.CONTACTS'
5712 double precision gx(3),gx1(3)
5715 C Set lprn=.true. for debugging
5719 write (iout,'(a)') 'Contact function values:'
5721 write (iout,'(i2,20(1x,i2,f10.5))')
5722 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5737 num_conti=num_cont(i)
5738 num_conti1=num_cont(i1)
5743 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5744 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5745 cd & ' ishift=',ishift
5746 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5747 C The system gains extra energy.
5748 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5749 endif ! j1==j+-ishift
5758 c------------------------------------------------------------------------------
5759 double precision function esccorr(i,j,k,l,jj,kk)
5760 implicit real*8 (a-h,o-z)
5761 include 'DIMENSIONS'
5762 include 'COMMON.IOUNITS'
5763 include 'COMMON.DERIV'
5764 include 'COMMON.INTERACT'
5765 include 'COMMON.CONTACTS'
5766 double precision gx(3),gx1(3)
5771 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5772 C Calculate the multi-body contribution to energy.
5773 C Calculate multi-body contributions to the gradient.
5774 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5775 cd & k,l,(gacont(m,kk,k),m=1,3)
5777 gx(m) =ekl*gacont(m,jj,i)
5778 gx1(m)=eij*gacont(m,kk,k)
5779 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5780 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5781 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5782 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5786 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5791 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5797 c------------------------------------------------------------------------------
5798 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5799 C This subroutine calculates multi-body contributions to hydrogen-bonding
5800 implicit real*8 (a-h,o-z)
5801 include 'DIMENSIONS'
5802 include 'COMMON.IOUNITS'
5805 parameter (max_cont=maxconts)
5806 parameter (max_dim=26)
5807 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5808 double precision zapas(max_dim,maxconts,max_fg_procs),
5809 & zapas_recv(max_dim,maxconts,max_fg_procs)
5810 common /przechowalnia/ zapas
5811 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5812 & status_array(MPI_STATUS_SIZE,maxconts*2)
5814 include 'COMMON.SETUP'
5815 include 'COMMON.FFIELD'
5816 include 'COMMON.DERIV'
5817 include 'COMMON.INTERACT'
5818 include 'COMMON.CONTACTS'
5819 include 'COMMON.CONTROL'
5820 include 'COMMON.LOCAL'
5821 double precision gx(3),gx1(3),time00
5824 C Set lprn=.true. for debugging
5829 if (nfgtasks.le.1) goto 30
5831 write (iout,'(a)') 'Contact function values before RECEIVE:'
5833 write (iout,'(2i3,50(1x,i2,f5.2))')
5834 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5835 & j=1,num_cont_hb(i))
5839 do i=1,ntask_cont_from
5842 do i=1,ntask_cont_to
5845 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5847 C Make the list of contacts to send to send to other procesors
5848 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5850 do i=iturn3_start,iturn3_end
5851 c write (iout,*) "make contact list turn3",i," num_cont",
5853 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5855 do i=iturn4_start,iturn4_end
5856 c write (iout,*) "make contact list turn4",i," num_cont",
5858 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5862 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5864 do j=1,num_cont_hb(i)
5867 iproc=iint_sent_local(k,jjc,ii)
5868 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5869 if (iproc.gt.0) then
5870 ncont_sent(iproc)=ncont_sent(iproc)+1
5871 nn=ncont_sent(iproc)
5873 zapas(2,nn,iproc)=jjc
5874 zapas(3,nn,iproc)=facont_hb(j,i)
5875 zapas(4,nn,iproc)=ees0p(j,i)
5876 zapas(5,nn,iproc)=ees0m(j,i)
5877 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5878 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5879 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5880 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5881 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5882 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5883 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5884 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5885 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5886 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5887 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
5888 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
5889 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
5890 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
5891 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
5892 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
5893 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
5894 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
5895 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
5896 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
5897 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
5904 & "Numbers of contacts to be sent to other processors",
5905 & (ncont_sent(i),i=1,ntask_cont_to)
5906 write (iout,*) "Contacts sent"
5907 do ii=1,ntask_cont_to
5909 iproc=itask_cont_to(ii)
5910 write (iout,*) nn," contacts to processor",iproc,
5911 & " of CONT_TO_COMM group"
5913 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
5921 CorrelID1=nfgtasks+fg_rank+1
5923 C Receive the numbers of needed contacts from other processors
5924 do ii=1,ntask_cont_from
5925 iproc=itask_cont_from(ii)
5927 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
5928 & FG_COMM,req(ireq),IERR)
5930 c write (iout,*) "IRECV ended"
5932 C Send the number of contacts needed by other processors
5933 do ii=1,ntask_cont_to
5934 iproc=itask_cont_to(ii)
5936 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
5937 & FG_COMM,req(ireq),IERR)
5939 c write (iout,*) "ISEND ended"
5940 c write (iout,*) "number of requests (nn)",ireq
5943 & call MPI_Waitall(ireq,req,status_array,ierr)
5945 c & "Numbers of contacts to be received from other processors",
5946 c & (ncont_recv(i),i=1,ntask_cont_from)
5950 do ii=1,ntask_cont_from
5951 iproc=itask_cont_from(ii)
5953 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
5954 c & " of CONT_TO_COMM group"
5958 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
5959 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
5960 c write (iout,*) "ireq,req",ireq,req(ireq)
5963 C Send the contacts to processors that need them
5964 do ii=1,ntask_cont_to
5965 iproc=itask_cont_to(ii)
5967 c write (iout,*) nn," contacts to processor",iproc,
5968 c & " of CONT_TO_COMM group"
5971 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
5972 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
5973 c write (iout,*) "ireq,req",ireq,req(ireq)
5975 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
5979 c write (iout,*) "number of requests (contacts)",ireq
5980 c write (iout,*) "req",(req(i),i=1,4)
5983 & call MPI_Waitall(ireq,req,status_array,ierr)
5984 do iii=1,ntask_cont_from
5985 iproc=itask_cont_from(iii)
5988 write (iout,*) "Received",nn," contacts from processor",iproc,
5989 & " of CONT_FROM_COMM group"
5992 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
5997 ii=zapas_recv(1,i,iii)
5998 c Flag the received contacts to prevent double-counting
5999 jj=-zapas_recv(2,i,iii)
6000 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6002 nnn=num_cont_hb(ii)+1
6005 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6006 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6007 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6008 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6009 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6010 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6011 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6012 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6013 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6014 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6015 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6016 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6017 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6018 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6019 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6020 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6021 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6022 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6023 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6024 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6025 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6026 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6027 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6028 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6033 write (iout,'(a)') 'Contact function values after receive:'
6035 write (iout,'(2i3,50(1x,i3,f5.2))')
6036 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6037 & j=1,num_cont_hb(i))
6044 write (iout,'(a)') 'Contact function values:'
6046 write (iout,'(2i3,50(1x,i3,f5.2))')
6047 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6048 & j=1,num_cont_hb(i))
6052 C Remove the loop below after debugging !!!
6059 C Calculate the local-electrostatic correlation terms
6060 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6062 num_conti=num_cont_hb(i)
6063 num_conti1=num_cont_hb(i+1)
6070 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6071 c & ' jj=',jj,' kk=',kk
6072 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6073 & .or. j.lt.0 .and. j1.gt.0) .and.
6074 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6075 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6076 C The system gains extra energy.
6077 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6078 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6079 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6081 else if (j1.eq.j) then
6082 C Contacts I-J and I-(J+1) occur simultaneously.
6083 C The system loses extra energy.
6084 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6089 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6090 c & ' jj=',jj,' kk=',kk
6092 C Contacts I-J and (I+1)-J occur simultaneously.
6093 C The system loses extra energy.
6094 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6101 c------------------------------------------------------------------------------
6102 subroutine add_hb_contact(ii,jj,itask)
6103 implicit real*8 (a-h,o-z)
6104 include "DIMENSIONS"
6105 include "COMMON.IOUNITS"
6108 parameter (max_cont=maxconts)
6109 parameter (max_dim=26)
6110 include "COMMON.CONTACTS"
6111 double precision zapas(max_dim,maxconts,max_fg_procs),
6112 & zapas_recv(max_dim,maxconts,max_fg_procs)
6113 common /przechowalnia/ zapas
6114 integer i,j,ii,jj,iproc,itask(4),nn
6115 c write (iout,*) "itask",itask
6118 if (iproc.gt.0) then
6119 do j=1,num_cont_hb(ii)
6121 c write (iout,*) "i",ii," j",jj," jjc",jjc
6123 ncont_sent(iproc)=ncont_sent(iproc)+1
6124 nn=ncont_sent(iproc)
6125 zapas(1,nn,iproc)=ii
6126 zapas(2,nn,iproc)=jjc
6127 zapas(3,nn,iproc)=facont_hb(j,ii)
6128 zapas(4,nn,iproc)=ees0p(j,ii)
6129 zapas(5,nn,iproc)=ees0m(j,ii)
6130 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6131 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6132 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6133 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6134 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6135 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6136 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6137 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6138 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6139 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6140 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6141 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6142 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6143 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6144 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6145 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6146 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6147 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6148 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6149 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6150 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6158 c------------------------------------------------------------------------------
6159 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6161 C This subroutine calculates multi-body contributions to hydrogen-bonding
6162 implicit real*8 (a-h,o-z)
6163 include 'DIMENSIONS'
6164 include 'COMMON.IOUNITS'
6167 parameter (max_cont=maxconts)
6168 parameter (max_dim=70)
6169 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6170 double precision zapas(max_dim,maxconts,max_fg_procs),
6171 & zapas_recv(max_dim,maxconts,max_fg_procs)
6172 common /przechowalnia/ zapas
6173 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6174 & status_array(MPI_STATUS_SIZE,maxconts*2)
6176 include 'COMMON.SETUP'
6177 include 'COMMON.FFIELD'
6178 include 'COMMON.DERIV'
6179 include 'COMMON.LOCAL'
6180 include 'COMMON.INTERACT'
6181 include 'COMMON.CONTACTS'
6182 include 'COMMON.CHAIN'
6183 include 'COMMON.CONTROL'
6184 double precision gx(3),gx1(3)
6185 integer num_cont_hb_old(maxres)
6187 double precision eello4,eello5,eelo6,eello_turn6
6188 external eello4,eello5,eello6,eello_turn6
6189 C Set lprn=.true. for debugging
6194 num_cont_hb_old(i)=num_cont_hb(i)
6198 if (nfgtasks.le.1) goto 30
6200 write (iout,'(a)') 'Contact function values before RECEIVE:'
6202 write (iout,'(2i3,50(1x,i2,f5.2))')
6203 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6204 & j=1,num_cont_hb(i))
6208 do i=1,ntask_cont_from
6211 do i=1,ntask_cont_to
6214 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6216 C Make the list of contacts to send to send to other procesors
6217 do i=iturn3_start,iturn3_end
6218 c write (iout,*) "make contact list turn3",i," num_cont",
6220 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6222 do i=iturn4_start,iturn4_end
6223 c write (iout,*) "make contact list turn4",i," num_cont",
6225 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6229 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6231 do j=1,num_cont_hb(i)
6234 iproc=iint_sent_local(k,jjc,ii)
6235 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6236 if (iproc.ne.0) then
6237 ncont_sent(iproc)=ncont_sent(iproc)+1
6238 nn=ncont_sent(iproc)
6240 zapas(2,nn,iproc)=jjc
6241 zapas(3,nn,iproc)=d_cont(j,i)
6245 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6250 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6258 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6269 & "Numbers of contacts to be sent to other processors",
6270 & (ncont_sent(i),i=1,ntask_cont_to)
6271 write (iout,*) "Contacts sent"
6272 do ii=1,ntask_cont_to
6274 iproc=itask_cont_to(ii)
6275 write (iout,*) nn," contacts to processor",iproc,
6276 & " of CONT_TO_COMM group"
6278 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6286 CorrelID1=nfgtasks+fg_rank+1
6288 C Receive the numbers of needed contacts from other processors
6289 do ii=1,ntask_cont_from
6290 iproc=itask_cont_from(ii)
6292 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6293 & FG_COMM,req(ireq),IERR)
6295 c write (iout,*) "IRECV ended"
6297 C Send the number of contacts needed by other processors
6298 do ii=1,ntask_cont_to
6299 iproc=itask_cont_to(ii)
6301 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6302 & FG_COMM,req(ireq),IERR)
6304 c write (iout,*) "ISEND ended"
6305 c write (iout,*) "number of requests (nn)",ireq
6308 & call MPI_Waitall(ireq,req,status_array,ierr)
6310 c & "Numbers of contacts to be received from other processors",
6311 c & (ncont_recv(i),i=1,ntask_cont_from)
6315 do ii=1,ntask_cont_from
6316 iproc=itask_cont_from(ii)
6318 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6319 c & " of CONT_TO_COMM group"
6323 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6324 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6325 c write (iout,*) "ireq,req",ireq,req(ireq)
6328 C Send the contacts to processors that need them
6329 do ii=1,ntask_cont_to
6330 iproc=itask_cont_to(ii)
6332 c write (iout,*) nn," contacts to processor",iproc,
6333 c & " of CONT_TO_COMM group"
6336 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6337 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6338 c write (iout,*) "ireq,req",ireq,req(ireq)
6340 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6344 c write (iout,*) "number of requests (contacts)",ireq
6345 c write (iout,*) "req",(req(i),i=1,4)
6348 & call MPI_Waitall(ireq,req,status_array,ierr)
6349 do iii=1,ntask_cont_from
6350 iproc=itask_cont_from(iii)
6353 write (iout,*) "Received",nn," contacts from processor",iproc,
6354 & " of CONT_FROM_COMM group"
6357 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6362 ii=zapas_recv(1,i,iii)
6363 c Flag the received contacts to prevent double-counting
6364 jj=-zapas_recv(2,i,iii)
6365 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6367 nnn=num_cont_hb(ii)+1
6370 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6374 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6379 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6387 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6396 write (iout,'(a)') 'Contact function values after receive:'
6398 write (iout,'(2i3,50(1x,i3,5f6.3))')
6399 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6400 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6407 write (iout,'(a)') 'Contact function values:'
6409 write (iout,'(2i3,50(1x,i2,5f6.3))')
6410 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6411 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6417 C Remove the loop below after debugging !!!
6424 C Calculate the dipole-dipole interaction energies
6425 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6426 do i=iatel_s,iatel_e+1
6427 num_conti=num_cont_hb(i)
6436 C Calculate the local-electrostatic correlation terms
6437 c write (iout,*) "gradcorr5 in eello5 before loop"
6439 c write (iout,'(i5,3f10.5)')
6440 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6442 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6443 c write (iout,*) "corr loop i",i
6445 num_conti=num_cont_hb(i)
6446 num_conti1=num_cont_hb(i+1)
6453 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6454 c & ' jj=',jj,' kk=',kk
6455 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6456 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6457 & .or. j.lt.0 .and. j1.gt.0) .and.
6458 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6459 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6460 C The system gains extra energy.
6462 sqd1=dsqrt(d_cont(jj,i))
6463 sqd2=dsqrt(d_cont(kk,i1))
6464 sred_geom = sqd1*sqd2
6465 IF (sred_geom.lt.cutoff_corr) THEN
6466 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6468 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6469 cd & ' jj=',jj,' kk=',kk
6470 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6471 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6473 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6474 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6477 cd write (iout,*) 'sred_geom=',sred_geom,
6478 cd & ' ekont=',ekont,' fprim=',fprimcont,
6479 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6480 cd write (iout,*) "g_contij",g_contij
6481 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6482 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6483 call calc_eello(i,jp,i+1,jp1,jj,kk)
6484 if (wcorr4.gt.0.0d0)
6485 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6486 if (energy_dec.and.wcorr4.gt.0.0d0)
6487 1 write (iout,'(a6,4i5,0pf7.3)')
6488 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6489 c write (iout,*) "gradcorr5 before eello5"
6491 c write (iout,'(i5,3f10.5)')
6492 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6494 if (wcorr5.gt.0.0d0)
6495 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6496 c write (iout,*) "gradcorr5 after eello5"
6498 c write (iout,'(i5,3f10.5)')
6499 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6501 if (energy_dec.and.wcorr5.gt.0.0d0)
6502 1 write (iout,'(a6,4i5,0pf7.3)')
6503 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6504 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6505 cd write(2,*)'ijkl',i,jp,i+1,jp1
6506 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6507 & .or. wturn6.eq.0.0d0))then
6508 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6509 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6510 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6511 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6512 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6513 cd & 'ecorr6=',ecorr6
6514 cd write (iout,'(4e15.5)') sred_geom,
6515 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6516 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6517 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6518 else if (wturn6.gt.0.0d0
6519 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6520 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6521 eturn6=eturn6+eello_turn6(i,jj,kk)
6522 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6523 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6524 cd write (2,*) 'multibody_eello:eturn6',eturn6
6533 num_cont_hb(i)=num_cont_hb_old(i)
6535 c write (iout,*) "gradcorr5 in eello5"
6537 c write (iout,'(i5,3f10.5)')
6538 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6542 c------------------------------------------------------------------------------
6543 subroutine add_hb_contact_eello(ii,jj,itask)
6544 implicit real*8 (a-h,o-z)
6545 include "DIMENSIONS"
6546 include "COMMON.IOUNITS"
6549 parameter (max_cont=maxconts)
6550 parameter (max_dim=70)
6551 include "COMMON.CONTACTS"
6552 double precision zapas(max_dim,maxconts,max_fg_procs),
6553 & zapas_recv(max_dim,maxconts,max_fg_procs)
6554 common /przechowalnia/ zapas
6555 integer i,j,ii,jj,iproc,itask(4),nn
6556 c write (iout,*) "itask",itask
6559 if (iproc.gt.0) then
6560 do j=1,num_cont_hb(ii)
6562 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6564 ncont_sent(iproc)=ncont_sent(iproc)+1
6565 nn=ncont_sent(iproc)
6566 zapas(1,nn,iproc)=ii
6567 zapas(2,nn,iproc)=jjc
6568 zapas(3,nn,iproc)=d_cont(j,ii)
6572 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6577 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6585 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6597 c------------------------------------------------------------------------------
6598 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6599 implicit real*8 (a-h,o-z)
6600 include 'DIMENSIONS'
6601 include 'COMMON.IOUNITS'
6602 include 'COMMON.DERIV'
6603 include 'COMMON.INTERACT'
6604 include 'COMMON.CONTACTS'
6605 double precision gx(3),gx1(3)
6615 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6616 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6617 C Following 4 lines for diagnostics.
6622 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6623 c & 'Contacts ',i,j,
6624 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6625 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6627 C Calculate the multi-body contribution to energy.
6628 c ecorr=ecorr+ekont*ees
6629 C Calculate multi-body contributions to the gradient.
6630 coeffpees0pij=coeffp*ees0pij
6631 coeffmees0mij=coeffm*ees0mij
6632 coeffpees0pkl=coeffp*ees0pkl
6633 coeffmees0mkl=coeffm*ees0mkl
6635 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6636 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6637 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6638 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6639 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6640 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6641 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6642 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6643 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6644 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6645 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6646 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6647 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6648 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6649 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6650 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6651 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6652 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6653 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6654 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6655 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6656 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6657 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6658 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6659 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6664 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6665 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6666 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6667 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6672 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6673 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6674 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6675 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6678 c write (iout,*) "ehbcorr",ekont*ees
6683 C---------------------------------------------------------------------------
6684 subroutine dipole(i,j,jj)
6685 implicit real*8 (a-h,o-z)
6686 include 'DIMENSIONS'
6687 include 'COMMON.IOUNITS'
6688 include 'COMMON.CHAIN'
6689 include 'COMMON.FFIELD'
6690 include 'COMMON.DERIV'
6691 include 'COMMON.INTERACT'
6692 include 'COMMON.CONTACTS'
6693 include 'COMMON.TORSION'
6694 include 'COMMON.VAR'
6695 include 'COMMON.GEO'
6696 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6698 iti1 = itortyp(itype(i+1))
6699 if (j.lt.nres-1) then
6700 itj1 = itortyp(itype(j+1))
6705 dipi(iii,1)=Ub2(iii,i)
6706 dipderi(iii)=Ub2der(iii,i)
6707 dipi(iii,2)=b1(iii,iti1)
6708 dipj(iii,1)=Ub2(iii,j)
6709 dipderj(iii)=Ub2der(iii,j)
6710 dipj(iii,2)=b1(iii,itj1)
6714 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6717 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6724 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6728 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6733 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6734 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6736 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6738 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6740 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6745 C---------------------------------------------------------------------------
6746 subroutine calc_eello(i,j,k,l,jj,kk)
6748 C This subroutine computes matrices and vectors needed to calculate
6749 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6751 implicit real*8 (a-h,o-z)
6752 include 'DIMENSIONS'
6753 include 'COMMON.IOUNITS'
6754 include 'COMMON.CHAIN'
6755 include 'COMMON.DERIV'
6756 include 'COMMON.INTERACT'
6757 include 'COMMON.CONTACTS'
6758 include 'COMMON.TORSION'
6759 include 'COMMON.VAR'
6760 include 'COMMON.GEO'
6761 include 'COMMON.FFIELD'
6762 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6763 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6766 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6767 cd & ' jj=',jj,' kk=',kk
6768 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6769 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6770 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6773 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6774 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6777 call transpose2(aa1(1,1),aa1t(1,1))
6778 call transpose2(aa2(1,1),aa2t(1,1))
6781 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6782 & aa1tder(1,1,lll,kkk))
6783 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6784 & aa2tder(1,1,lll,kkk))
6788 C parallel orientation of the two CA-CA-CA frames.
6790 iti=itortyp(itype(i))
6794 itk1=itortyp(itype(k+1))
6795 itj=itortyp(itype(j))
6796 if (l.lt.nres-1) then
6797 itl1=itortyp(itype(l+1))
6801 C A1 kernel(j+1) A2T
6803 cd write (iout,'(3f10.5,5x,3f10.5)')
6804 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6806 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6807 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6808 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6809 C Following matrices are needed only for 6-th order cumulants
6810 IF (wcorr6.gt.0.0d0) THEN
6811 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6812 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6813 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6814 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6815 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6816 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6817 & ADtEAderx(1,1,1,1,1,1))
6819 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6820 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6821 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6822 & ADtEA1derx(1,1,1,1,1,1))
6824 C End 6-th order cumulants
6827 cd write (2,*) 'In calc_eello6'
6829 cd write (2,*) 'iii=',iii
6831 cd write (2,*) 'kkk=',kkk
6833 cd write (2,'(3(2f10.5),5x)')
6834 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6839 call transpose2(EUgder(1,1,k),auxmat(1,1))
6840 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6841 call transpose2(EUg(1,1,k),auxmat(1,1))
6842 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6843 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6847 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6848 & EAEAderx(1,1,lll,kkk,iii,1))
6852 C A1T kernel(i+1) A2
6853 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6854 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6855 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6856 C Following matrices are needed only for 6-th order cumulants
6857 IF (wcorr6.gt.0.0d0) THEN
6858 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6859 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6860 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6861 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6862 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6863 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6864 & ADtEAderx(1,1,1,1,1,2))
6865 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6866 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6867 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6868 & ADtEA1derx(1,1,1,1,1,2))
6870 C End 6-th order cumulants
6871 call transpose2(EUgder(1,1,l),auxmat(1,1))
6872 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6873 call transpose2(EUg(1,1,l),auxmat(1,1))
6874 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6875 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6879 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6880 & EAEAderx(1,1,lll,kkk,iii,2))
6885 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6886 C They are needed only when the fifth- or the sixth-order cumulants are
6888 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6889 call transpose2(AEA(1,1,1),auxmat(1,1))
6890 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6891 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6892 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6893 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6894 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6895 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6896 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6897 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6898 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6899 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6900 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6901 call transpose2(AEA(1,1,2),auxmat(1,1))
6902 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6903 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6904 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6905 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6906 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6907 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6908 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6909 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6910 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6911 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6912 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6913 C Calculate the Cartesian derivatives of the vectors.
6917 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6918 call matvec2(auxmat(1,1),b1(1,iti),
6919 & AEAb1derx(1,lll,kkk,iii,1,1))
6920 call matvec2(auxmat(1,1),Ub2(1,i),
6921 & AEAb2derx(1,lll,kkk,iii,1,1))
6922 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6923 & AEAb1derx(1,lll,kkk,iii,2,1))
6924 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6925 & AEAb2derx(1,lll,kkk,iii,2,1))
6926 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6927 call matvec2(auxmat(1,1),b1(1,itj),
6928 & AEAb1derx(1,lll,kkk,iii,1,2))
6929 call matvec2(auxmat(1,1),Ub2(1,j),
6930 & AEAb2derx(1,lll,kkk,iii,1,2))
6931 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6932 & AEAb1derx(1,lll,kkk,iii,2,2))
6933 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6934 & AEAb2derx(1,lll,kkk,iii,2,2))
6941 C Antiparallel orientation of the two CA-CA-CA frames.
6943 iti=itortyp(itype(i))
6947 itk1=itortyp(itype(k+1))
6948 itl=itortyp(itype(l))
6949 itj=itortyp(itype(j))
6950 if (j.lt.nres-1) then
6951 itj1=itortyp(itype(j+1))
6955 C A2 kernel(j-1)T A1T
6956 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6957 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6958 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6959 C Following matrices are needed only for 6-th order cumulants
6960 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6961 & j.eq.i+4 .and. l.eq.i+3)) THEN
6962 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6963 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6964 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6965 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6966 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6967 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6968 & ADtEAderx(1,1,1,1,1,1))
6969 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6970 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6971 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6972 & ADtEA1derx(1,1,1,1,1,1))
6974 C End 6-th order cumulants
6975 call transpose2(EUgder(1,1,k),auxmat(1,1))
6976 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6977 call transpose2(EUg(1,1,k),auxmat(1,1))
6978 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6979 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6983 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6984 & EAEAderx(1,1,lll,kkk,iii,1))
6988 C A2T kernel(i+1)T A1
6989 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6990 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6991 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6992 C Following matrices are needed only for 6-th order cumulants
6993 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6994 & j.eq.i+4 .and. l.eq.i+3)) THEN
6995 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6996 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6997 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6998 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6999 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7000 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7001 & ADtEAderx(1,1,1,1,1,2))
7002 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7003 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7004 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7005 & ADtEA1derx(1,1,1,1,1,2))
7007 C End 6-th order cumulants
7008 call transpose2(EUgder(1,1,j),auxmat(1,1))
7009 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7010 call transpose2(EUg(1,1,j),auxmat(1,1))
7011 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7012 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7016 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7017 & EAEAderx(1,1,lll,kkk,iii,2))
7022 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7023 C They are needed only when the fifth- or the sixth-order cumulants are
7025 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7026 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7027 call transpose2(AEA(1,1,1),auxmat(1,1))
7028 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7029 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7030 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7031 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7032 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7033 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7034 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7035 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7036 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7037 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7038 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7039 call transpose2(AEA(1,1,2),auxmat(1,1))
7040 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7041 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7042 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7043 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7044 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7045 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7046 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7047 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7048 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7049 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7050 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7051 C Calculate the Cartesian derivatives of the vectors.
7055 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7056 call matvec2(auxmat(1,1),b1(1,iti),
7057 & AEAb1derx(1,lll,kkk,iii,1,1))
7058 call matvec2(auxmat(1,1),Ub2(1,i),
7059 & AEAb2derx(1,lll,kkk,iii,1,1))
7060 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7061 & AEAb1derx(1,lll,kkk,iii,2,1))
7062 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7063 & AEAb2derx(1,lll,kkk,iii,2,1))
7064 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7065 call matvec2(auxmat(1,1),b1(1,itl),
7066 & AEAb1derx(1,lll,kkk,iii,1,2))
7067 call matvec2(auxmat(1,1),Ub2(1,l),
7068 & AEAb2derx(1,lll,kkk,iii,1,2))
7069 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7070 & AEAb1derx(1,lll,kkk,iii,2,2))
7071 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7072 & AEAb2derx(1,lll,kkk,iii,2,2))
7081 C---------------------------------------------------------------------------
7082 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7083 & KK,KKderg,AKA,AKAderg,AKAderx)
7087 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7088 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7089 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7094 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7096 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7099 cd if (lprn) write (2,*) 'In kernel'
7101 cd if (lprn) write (2,*) 'kkk=',kkk
7103 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7104 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7106 cd write (2,*) 'lll=',lll
7107 cd write (2,*) 'iii=1'
7109 cd write (2,'(3(2f10.5),5x)')
7110 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7113 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7114 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7116 cd write (2,*) 'lll=',lll
7117 cd write (2,*) 'iii=2'
7119 cd write (2,'(3(2f10.5),5x)')
7120 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7127 C---------------------------------------------------------------------------
7128 double precision function eello4(i,j,k,l,jj,kk)
7129 implicit real*8 (a-h,o-z)
7130 include 'DIMENSIONS'
7131 include 'COMMON.IOUNITS'
7132 include 'COMMON.CHAIN'
7133 include 'COMMON.DERIV'
7134 include 'COMMON.INTERACT'
7135 include 'COMMON.CONTACTS'
7136 include 'COMMON.TORSION'
7137 include 'COMMON.VAR'
7138 include 'COMMON.GEO'
7139 double precision pizda(2,2),ggg1(3),ggg2(3)
7140 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7144 cd print *,'eello4:',i,j,k,l,jj,kk
7145 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7146 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7147 cold eij=facont_hb(jj,i)
7148 cold ekl=facont_hb(kk,k)
7150 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7151 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7152 gcorr_loc(k-1)=gcorr_loc(k-1)
7153 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7155 gcorr_loc(l-1)=gcorr_loc(l-1)
7156 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7158 gcorr_loc(j-1)=gcorr_loc(j-1)
7159 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7164 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7165 & -EAEAderx(2,2,lll,kkk,iii,1)
7166 cd derx(lll,kkk,iii)=0.0d0
7170 cd gcorr_loc(l-1)=0.0d0
7171 cd gcorr_loc(j-1)=0.0d0
7172 cd gcorr_loc(k-1)=0.0d0
7174 cd write (iout,*)'Contacts have occurred for peptide groups',
7175 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7176 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7177 if (j.lt.nres-1) then
7184 if (l.lt.nres-1) then
7192 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7193 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7194 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7195 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7196 cgrad ghalf=0.5d0*ggg1(ll)
7197 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7198 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7199 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7200 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7201 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7202 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7203 cgrad ghalf=0.5d0*ggg2(ll)
7204 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7205 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7206 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7207 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7208 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7209 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7213 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7218 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7223 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7228 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7232 cd write (2,*) iii,gcorr_loc(iii)
7235 cd write (2,*) 'ekont',ekont
7236 cd write (iout,*) 'eello4',ekont*eel4
7239 C---------------------------------------------------------------------------
7240 double precision function eello5(i,j,k,l,jj,kk)
7241 implicit real*8 (a-h,o-z)
7242 include 'DIMENSIONS'
7243 include 'COMMON.IOUNITS'
7244 include 'COMMON.CHAIN'
7245 include 'COMMON.DERIV'
7246 include 'COMMON.INTERACT'
7247 include 'COMMON.CONTACTS'
7248 include 'COMMON.TORSION'
7249 include 'COMMON.VAR'
7250 include 'COMMON.GEO'
7251 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7252 double precision ggg1(3),ggg2(3)
7253 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7258 C /l\ / \ \ / \ / \ / C
7259 C / \ / \ \ / \ / \ / C
7260 C j| o |l1 | o | o| o | | o |o C
7261 C \ |/k\| |/ \| / |/ \| |/ \| C
7262 C \i/ \ / \ / / \ / \ C
7264 C (I) (II) (III) (IV) C
7266 C eello5_1 eello5_2 eello5_3 eello5_4 C
7268 C Antiparallel chains C
7271 C /j\ / \ \ / \ / \ / C
7272 C / \ / \ \ / \ / \ / C
7273 C j1| o |l | o | o| o | | o |o C
7274 C \ |/k\| |/ \| / |/ \| |/ \| C
7275 C \i/ \ / \ / / \ / \ C
7277 C (I) (II) (III) (IV) C
7279 C eello5_1 eello5_2 eello5_3 eello5_4 C
7281 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7283 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7284 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7289 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7291 itk=itortyp(itype(k))
7292 itl=itortyp(itype(l))
7293 itj=itortyp(itype(j))
7298 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7299 cd & eel5_3_num,eel5_4_num)
7303 derx(lll,kkk,iii)=0.0d0
7307 cd eij=facont_hb(jj,i)
7308 cd ekl=facont_hb(kk,k)
7310 cd write (iout,*)'Contacts have occurred for peptide groups',
7311 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7313 C Contribution from the graph I.
7314 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7315 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7316 call transpose2(EUg(1,1,k),auxmat(1,1))
7317 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7318 vv(1)=pizda(1,1)-pizda(2,2)
7319 vv(2)=pizda(1,2)+pizda(2,1)
7320 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7321 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7322 C Explicit gradient in virtual-dihedral angles.
7323 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7324 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7325 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7326 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7327 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7328 vv(1)=pizda(1,1)-pizda(2,2)
7329 vv(2)=pizda(1,2)+pizda(2,1)
7330 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7331 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7332 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7333 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7334 vv(1)=pizda(1,1)-pizda(2,2)
7335 vv(2)=pizda(1,2)+pizda(2,1)
7337 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7338 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7339 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7341 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7342 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7343 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7345 C Cartesian gradient
7349 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7351 vv(1)=pizda(1,1)-pizda(2,2)
7352 vv(2)=pizda(1,2)+pizda(2,1)
7353 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7354 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7355 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7361 C Contribution from graph II
7362 call transpose2(EE(1,1,itk),auxmat(1,1))
7363 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7364 vv(1)=pizda(1,1)+pizda(2,2)
7365 vv(2)=pizda(2,1)-pizda(1,2)
7366 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7367 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7368 C Explicit gradient in virtual-dihedral angles.
7369 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7370 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7371 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7372 vv(1)=pizda(1,1)+pizda(2,2)
7373 vv(2)=pizda(2,1)-pizda(1,2)
7375 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7376 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7377 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7379 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7380 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7381 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7383 C Cartesian gradient
7387 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7389 vv(1)=pizda(1,1)+pizda(2,2)
7390 vv(2)=pizda(2,1)-pizda(1,2)
7391 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7392 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7393 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7401 C Parallel orientation
7402 C Contribution from graph III
7403 call transpose2(EUg(1,1,l),auxmat(1,1))
7404 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7405 vv(1)=pizda(1,1)-pizda(2,2)
7406 vv(2)=pizda(1,2)+pizda(2,1)
7407 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7408 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7409 C Explicit gradient in virtual-dihedral angles.
7410 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7411 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7412 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7413 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7414 vv(1)=pizda(1,1)-pizda(2,2)
7415 vv(2)=pizda(1,2)+pizda(2,1)
7416 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7417 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7418 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7419 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7420 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7421 vv(1)=pizda(1,1)-pizda(2,2)
7422 vv(2)=pizda(1,2)+pizda(2,1)
7423 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7424 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7425 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7426 C Cartesian gradient
7430 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7432 vv(1)=pizda(1,1)-pizda(2,2)
7433 vv(2)=pizda(1,2)+pizda(2,1)
7434 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7435 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7436 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7441 C Contribution from graph IV
7443 call transpose2(EE(1,1,itl),auxmat(1,1))
7444 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7445 vv(1)=pizda(1,1)+pizda(2,2)
7446 vv(2)=pizda(2,1)-pizda(1,2)
7447 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7448 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7449 C Explicit gradient in virtual-dihedral angles.
7450 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7451 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7452 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7453 vv(1)=pizda(1,1)+pizda(2,2)
7454 vv(2)=pizda(2,1)-pizda(1,2)
7455 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7456 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7457 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7458 C Cartesian gradient
7462 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7464 vv(1)=pizda(1,1)+pizda(2,2)
7465 vv(2)=pizda(2,1)-pizda(1,2)
7466 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7467 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7468 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7473 C Antiparallel orientation
7474 C Contribution from graph III
7476 call transpose2(EUg(1,1,j),auxmat(1,1))
7477 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7478 vv(1)=pizda(1,1)-pizda(2,2)
7479 vv(2)=pizda(1,2)+pizda(2,1)
7480 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7481 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7482 C Explicit gradient in virtual-dihedral angles.
7483 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7484 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7485 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7486 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7487 vv(1)=pizda(1,1)-pizda(2,2)
7488 vv(2)=pizda(1,2)+pizda(2,1)
7489 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7490 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7491 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7492 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7493 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7494 vv(1)=pizda(1,1)-pizda(2,2)
7495 vv(2)=pizda(1,2)+pizda(2,1)
7496 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7497 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7498 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7499 C Cartesian gradient
7503 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7505 vv(1)=pizda(1,1)-pizda(2,2)
7506 vv(2)=pizda(1,2)+pizda(2,1)
7507 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7508 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7509 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7514 C Contribution from graph IV
7516 call transpose2(EE(1,1,itj),auxmat(1,1))
7517 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7518 vv(1)=pizda(1,1)+pizda(2,2)
7519 vv(2)=pizda(2,1)-pizda(1,2)
7520 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7521 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7522 C Explicit gradient in virtual-dihedral angles.
7523 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7524 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7525 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7526 vv(1)=pizda(1,1)+pizda(2,2)
7527 vv(2)=pizda(2,1)-pizda(1,2)
7528 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7529 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7530 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7531 C Cartesian gradient
7535 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7537 vv(1)=pizda(1,1)+pizda(2,2)
7538 vv(2)=pizda(2,1)-pizda(1,2)
7539 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7540 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7541 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7547 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7548 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7549 cd write (2,*) 'ijkl',i,j,k,l
7550 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7551 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7553 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7554 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7555 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7556 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7557 if (j.lt.nres-1) then
7564 if (l.lt.nres-1) then
7574 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7575 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7576 C summed up outside the subrouine as for the other subroutines
7577 C handling long-range interactions. The old code is commented out
7578 C with "cgrad" to keep track of changes.
7580 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7581 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7582 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7583 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7584 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7585 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7586 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7587 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7588 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7589 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7591 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7592 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7593 cgrad ghalf=0.5d0*ggg1(ll)
7595 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7596 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7597 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7598 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7599 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7600 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7601 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7602 cgrad ghalf=0.5d0*ggg2(ll)
7604 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7605 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7606 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7607 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7608 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7609 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7614 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7615 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7620 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7621 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7627 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7632 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7636 cd write (2,*) iii,g_corr5_loc(iii)
7639 cd write (2,*) 'ekont',ekont
7640 cd write (iout,*) 'eello5',ekont*eel5
7643 c--------------------------------------------------------------------------
7644 double precision function eello6(i,j,k,l,jj,kk)
7645 implicit real*8 (a-h,o-z)
7646 include 'DIMENSIONS'
7647 include 'COMMON.IOUNITS'
7648 include 'COMMON.CHAIN'
7649 include 'COMMON.DERIV'
7650 include 'COMMON.INTERACT'
7651 include 'COMMON.CONTACTS'
7652 include 'COMMON.TORSION'
7653 include 'COMMON.VAR'
7654 include 'COMMON.GEO'
7655 include 'COMMON.FFIELD'
7656 double precision ggg1(3),ggg2(3)
7657 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7662 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7670 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7671 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7675 derx(lll,kkk,iii)=0.0d0
7679 cd eij=facont_hb(jj,i)
7680 cd ekl=facont_hb(kk,k)
7686 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7687 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7688 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7689 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7690 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7691 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7693 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7694 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7695 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7696 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7697 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7698 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7702 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7704 C If turn contributions are considered, they will be handled separately.
7705 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7706 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7707 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7708 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7709 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7710 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7711 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7713 if (j.lt.nres-1) then
7720 if (l.lt.nres-1) then
7728 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7729 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7730 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7731 cgrad ghalf=0.5d0*ggg1(ll)
7733 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7734 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7735 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7736 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7737 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7738 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7739 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7740 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7741 cgrad ghalf=0.5d0*ggg2(ll)
7742 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7744 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7745 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7746 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7747 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7748 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7749 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7754 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7755 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7760 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7761 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7767 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7772 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7776 cd write (2,*) iii,g_corr6_loc(iii)
7779 cd write (2,*) 'ekont',ekont
7780 cd write (iout,*) 'eello6',ekont*eel6
7783 c--------------------------------------------------------------------------
7784 double precision function eello6_graph1(i,j,k,l,imat,swap)
7785 implicit real*8 (a-h,o-z)
7786 include 'DIMENSIONS'
7787 include 'COMMON.IOUNITS'
7788 include 'COMMON.CHAIN'
7789 include 'COMMON.DERIV'
7790 include 'COMMON.INTERACT'
7791 include 'COMMON.CONTACTS'
7792 include 'COMMON.TORSION'
7793 include 'COMMON.VAR'
7794 include 'COMMON.GEO'
7795 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7799 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7801 C Parallel Antiparallel C
7807 C \ j|/k\| / \ |/k\|l / C
7812 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7813 itk=itortyp(itype(k))
7814 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7815 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7816 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7817 call transpose2(EUgC(1,1,k),auxmat(1,1))
7818 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7819 vv1(1)=pizda1(1,1)-pizda1(2,2)
7820 vv1(2)=pizda1(1,2)+pizda1(2,1)
7821 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7822 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7823 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7824 s5=scalar2(vv(1),Dtobr2(1,i))
7825 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7826 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7827 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7828 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7829 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7830 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7831 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7832 & +scalar2(vv(1),Dtobr2der(1,i)))
7833 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7834 vv1(1)=pizda1(1,1)-pizda1(2,2)
7835 vv1(2)=pizda1(1,2)+pizda1(2,1)
7836 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7837 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7839 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7840 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7841 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7842 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7843 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7845 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7846 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7847 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7848 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7849 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7851 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7852 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7853 vv1(1)=pizda1(1,1)-pizda1(2,2)
7854 vv1(2)=pizda1(1,2)+pizda1(2,1)
7855 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7856 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7857 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7858 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7867 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7868 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7869 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7870 call transpose2(EUgC(1,1,k),auxmat(1,1))
7871 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7873 vv1(1)=pizda1(1,1)-pizda1(2,2)
7874 vv1(2)=pizda1(1,2)+pizda1(2,1)
7875 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7876 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7877 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7878 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7879 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7880 s5=scalar2(vv(1),Dtobr2(1,i))
7881 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7887 c----------------------------------------------------------------------------
7888 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7889 implicit real*8 (a-h,o-z)
7890 include 'DIMENSIONS'
7891 include 'COMMON.IOUNITS'
7892 include 'COMMON.CHAIN'
7893 include 'COMMON.DERIV'
7894 include 'COMMON.INTERACT'
7895 include 'COMMON.CONTACTS'
7896 include 'COMMON.TORSION'
7897 include 'COMMON.VAR'
7898 include 'COMMON.GEO'
7900 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7901 & auxvec1(2),auxvec2(1),auxmat1(2,2)
7904 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7906 C Parallel Antiparallel C
7912 C \ j|/k\| \ |/k\|l C
7917 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7918 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7919 C AL 7/4/01 s1 would occur in the sixth-order moment,
7920 C but not in a cluster cumulant
7922 s1=dip(1,jj,i)*dip(1,kk,k)
7924 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7925 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7926 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7927 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7928 call transpose2(EUg(1,1,k),auxmat(1,1))
7929 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7930 vv(1)=pizda(1,1)-pizda(2,2)
7931 vv(2)=pizda(1,2)+pizda(2,1)
7932 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7933 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7935 eello6_graph2=-(s1+s2+s3+s4)
7937 eello6_graph2=-(s2+s3+s4)
7940 C Derivatives in gamma(i-1)
7943 s1=dipderg(1,jj,i)*dip(1,kk,k)
7945 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7946 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7947 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7948 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7950 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7952 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7954 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7956 C Derivatives in gamma(k-1)
7958 s1=dip(1,jj,i)*dipderg(1,kk,k)
7960 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7961 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7962 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7963 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7964 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7965 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7966 vv(1)=pizda(1,1)-pizda(2,2)
7967 vv(2)=pizda(1,2)+pizda(2,1)
7968 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7970 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7972 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7974 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7975 C Derivatives in gamma(j-1) or gamma(l-1)
7978 s1=dipderg(3,jj,i)*dip(1,kk,k)
7980 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7981 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7982 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7983 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7984 vv(1)=pizda(1,1)-pizda(2,2)
7985 vv(2)=pizda(1,2)+pizda(2,1)
7986 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7989 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7991 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7994 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7995 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7997 C Derivatives in gamma(l-1) or gamma(j-1)
8000 s1=dip(1,jj,i)*dipderg(3,kk,k)
8002 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8003 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8004 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8005 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8006 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8007 vv(1)=pizda(1,1)-pizda(2,2)
8008 vv(2)=pizda(1,2)+pizda(2,1)
8009 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8012 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8014 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8017 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8018 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8020 C Cartesian derivatives.
8022 write (2,*) 'In eello6_graph2'
8024 write (2,*) 'iii=',iii
8026 write (2,*) 'kkk=',kkk
8028 write (2,'(3(2f10.5),5x)')
8029 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8039 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8041 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8044 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8046 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8047 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8049 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8050 call transpose2(EUg(1,1,k),auxmat(1,1))
8051 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8053 vv(1)=pizda(1,1)-pizda(2,2)
8054 vv(2)=pizda(1,2)+pizda(2,1)
8055 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8056 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8058 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8060 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8063 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8065 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8072 c----------------------------------------------------------------------------
8073 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8074 implicit real*8 (a-h,o-z)
8075 include 'DIMENSIONS'
8076 include 'COMMON.IOUNITS'
8077 include 'COMMON.CHAIN'
8078 include 'COMMON.DERIV'
8079 include 'COMMON.INTERACT'
8080 include 'COMMON.CONTACTS'
8081 include 'COMMON.TORSION'
8082 include 'COMMON.VAR'
8083 include 'COMMON.GEO'
8084 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8086 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8088 C Parallel Antiparallel C
8094 C j|/k\| / |/k\|l / C
8099 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8101 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8102 C energy moment and not to the cluster cumulant.
8103 iti=itortyp(itype(i))
8104 if (j.lt.nres-1) then
8105 itj1=itortyp(itype(j+1))
8109 itk=itortyp(itype(k))
8110 itk1=itortyp(itype(k+1))
8111 if (l.lt.nres-1) then
8112 itl1=itortyp(itype(l+1))
8117 s1=dip(4,jj,i)*dip(4,kk,k)
8119 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8120 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8121 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8122 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8123 call transpose2(EE(1,1,itk),auxmat(1,1))
8124 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8125 vv(1)=pizda(1,1)+pizda(2,2)
8126 vv(2)=pizda(2,1)-pizda(1,2)
8127 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8128 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8129 cd & "sum",-(s2+s3+s4)
8131 eello6_graph3=-(s1+s2+s3+s4)
8133 eello6_graph3=-(s2+s3+s4)
8136 C Derivatives in gamma(k-1)
8137 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8138 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8139 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8140 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8141 C Derivatives in gamma(l-1)
8142 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8143 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8144 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8145 vv(1)=pizda(1,1)+pizda(2,2)
8146 vv(2)=pizda(2,1)-pizda(1,2)
8147 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8148 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8149 C Cartesian derivatives.
8155 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8157 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8160 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8162 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8163 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8165 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8166 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8168 vv(1)=pizda(1,1)+pizda(2,2)
8169 vv(2)=pizda(2,1)-pizda(1,2)
8170 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8172 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8174 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8177 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8179 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8181 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8187 c----------------------------------------------------------------------------
8188 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8189 implicit real*8 (a-h,o-z)
8190 include 'DIMENSIONS'
8191 include 'COMMON.IOUNITS'
8192 include 'COMMON.CHAIN'
8193 include 'COMMON.DERIV'
8194 include 'COMMON.INTERACT'
8195 include 'COMMON.CONTACTS'
8196 include 'COMMON.TORSION'
8197 include 'COMMON.VAR'
8198 include 'COMMON.GEO'
8199 include 'COMMON.FFIELD'
8200 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8201 & auxvec1(2),auxmat1(2,2)
8203 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8205 C Parallel Antiparallel C
8211 C \ j|/k\| \ |/k\|l C
8216 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8218 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8219 C energy moment and not to the cluster cumulant.
8220 cd write (2,*) 'eello_graph4: wturn6',wturn6
8221 iti=itortyp(itype(i))
8222 itj=itortyp(itype(j))
8223 if (j.lt.nres-1) then
8224 itj1=itortyp(itype(j+1))
8228 itk=itortyp(itype(k))
8229 if (k.lt.nres-1) then
8230 itk1=itortyp(itype(k+1))
8234 itl=itortyp(itype(l))
8235 if (l.lt.nres-1) then
8236 itl1=itortyp(itype(l+1))
8240 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8241 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8242 cd & ' itl',itl,' itl1',itl1
8245 s1=dip(3,jj,i)*dip(3,kk,k)
8247 s1=dip(2,jj,j)*dip(2,kk,l)
8250 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8251 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8253 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8254 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8256 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8257 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8259 call transpose2(EUg(1,1,k),auxmat(1,1))
8260 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8261 vv(1)=pizda(1,1)-pizda(2,2)
8262 vv(2)=pizda(2,1)+pizda(1,2)
8263 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8264 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8266 eello6_graph4=-(s1+s2+s3+s4)
8268 eello6_graph4=-(s2+s3+s4)
8270 C Derivatives in gamma(i-1)
8274 s1=dipderg(2,jj,i)*dip(3,kk,k)
8276 s1=dipderg(4,jj,j)*dip(2,kk,l)
8279 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8281 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8282 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8284 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8285 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8287 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8288 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8289 cd write (2,*) 'turn6 derivatives'
8291 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8293 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8297 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8299 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8303 C Derivatives in gamma(k-1)
8306 s1=dip(3,jj,i)*dipderg(2,kk,k)
8308 s1=dip(2,jj,j)*dipderg(4,kk,l)
8311 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8312 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8314 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8315 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8317 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8318 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8320 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8321 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8322 vv(1)=pizda(1,1)-pizda(2,2)
8323 vv(2)=pizda(2,1)+pizda(1,2)
8324 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8325 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8327 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8329 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8333 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8335 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8338 C Derivatives in gamma(j-1) or gamma(l-1)
8339 if (l.eq.j+1 .and. l.gt.1) then
8340 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8341 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8342 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8343 vv(1)=pizda(1,1)-pizda(2,2)
8344 vv(2)=pizda(2,1)+pizda(1,2)
8345 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8346 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8347 else if (j.gt.1) then
8348 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8349 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8350 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8351 vv(1)=pizda(1,1)-pizda(2,2)
8352 vv(2)=pizda(2,1)+pizda(1,2)
8353 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8354 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8355 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8357 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8360 C Cartesian derivatives.
8367 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8369 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8373 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8375 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8379 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8381 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8383 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8384 & b1(1,itj1),auxvec(1))
8385 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8387 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8388 & b1(1,itl1),auxvec(1))
8389 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8391 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8393 vv(1)=pizda(1,1)-pizda(2,2)
8394 vv(2)=pizda(2,1)+pizda(1,2)
8395 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8397 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8399 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8402 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8405 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8408 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8410 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8412 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8416 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8418 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8421 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8423 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8431 c----------------------------------------------------------------------------
8432 double precision function eello_turn6(i,jj,kk)
8433 implicit real*8 (a-h,o-z)
8434 include 'DIMENSIONS'
8435 include 'COMMON.IOUNITS'
8436 include 'COMMON.CHAIN'
8437 include 'COMMON.DERIV'
8438 include 'COMMON.INTERACT'
8439 include 'COMMON.CONTACTS'
8440 include 'COMMON.TORSION'
8441 include 'COMMON.VAR'
8442 include 'COMMON.GEO'
8443 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8444 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8446 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8447 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8448 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8449 C the respective energy moment and not to the cluster cumulant.
8458 iti=itortyp(itype(i))
8459 itk=itortyp(itype(k))
8460 itk1=itortyp(itype(k+1))
8461 itl=itortyp(itype(l))
8462 itj=itortyp(itype(j))
8463 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8464 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8465 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8470 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8472 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8476 derx_turn(lll,kkk,iii)=0.0d0
8483 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8485 cd write (2,*) 'eello6_5',eello6_5
8487 call transpose2(AEA(1,1,1),auxmat(1,1))
8488 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8489 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8490 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8492 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8493 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8494 s2 = scalar2(b1(1,itk),vtemp1(1))
8496 call transpose2(AEA(1,1,2),atemp(1,1))
8497 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8498 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8499 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8501 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8502 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8503 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8505 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8506 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8507 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8508 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8509 ss13 = scalar2(b1(1,itk),vtemp4(1))
8510 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8512 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8518 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8519 C Derivatives in gamma(i+2)
8523 call transpose2(AEA(1,1,1),auxmatd(1,1))
8524 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8525 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8526 call transpose2(AEAderg(1,1,2),atempd(1,1))
8527 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8528 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8530 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8531 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8532 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8538 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8539 C Derivatives in gamma(i+3)
8541 call transpose2(AEA(1,1,1),auxmatd(1,1))
8542 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8543 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8544 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8546 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8547 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8548 s2d = scalar2(b1(1,itk),vtemp1d(1))
8550 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8551 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8553 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8555 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8556 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8557 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8565 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8566 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8568 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8569 & -0.5d0*ekont*(s2d+s12d)
8571 C Derivatives in gamma(i+4)
8572 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8573 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8574 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8576 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8577 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8578 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8586 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8588 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8590 C Derivatives in gamma(i+5)
8592 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8593 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8594 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8596 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8597 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8598 s2d = scalar2(b1(1,itk),vtemp1d(1))
8600 call transpose2(AEA(1,1,2),atempd(1,1))
8601 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8602 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8604 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8605 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8607 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8608 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8609 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8617 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8618 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8620 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8621 & -0.5d0*ekont*(s2d+s12d)
8623 C Cartesian derivatives
8628 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8629 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8630 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8632 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8633 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8635 s2d = scalar2(b1(1,itk),vtemp1d(1))
8637 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8638 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8639 s8d = -(atempd(1,1)+atempd(2,2))*
8640 & scalar2(cc(1,1,itl),vtemp2(1))
8642 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8644 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8645 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8652 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8655 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8659 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8660 & - 0.5d0*(s8d+s12d)
8662 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8671 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8673 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8674 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8675 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8676 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8677 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8679 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8680 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8681 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8685 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8686 cd & 16*eel_turn6_num
8688 if (j.lt.nres-1) then
8695 if (l.lt.nres-1) then
8703 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8704 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8705 cgrad ghalf=0.5d0*ggg1(ll)
8707 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8708 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8709 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8710 & +ekont*derx_turn(ll,2,1)
8711 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8712 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8713 & +ekont*derx_turn(ll,4,1)
8714 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8715 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8716 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8717 cgrad ghalf=0.5d0*ggg2(ll)
8719 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8720 & +ekont*derx_turn(ll,2,2)
8721 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8722 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8723 & +ekont*derx_turn(ll,4,2)
8724 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8725 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8726 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8731 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8736 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8742 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8747 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8751 cd write (2,*) iii,g_corr6_loc(iii)
8753 eello_turn6=ekont*eel_turn6
8754 cd write (2,*) 'ekont',ekont
8755 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8759 C-----------------------------------------------------------------------------
8760 double precision function scalar(u,v)
8761 !DIR$ INLINEALWAYS scalar
8763 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8766 double precision u(3),v(3)
8767 cd double precision sc
8775 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8778 crc-------------------------------------------------
8779 SUBROUTINE MATVEC2(A1,V1,V2)
8780 !DIR$ INLINEALWAYS MATVEC2
8782 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8784 implicit real*8 (a-h,o-z)
8785 include 'DIMENSIONS'
8786 DIMENSION A1(2,2),V1(2),V2(2)
8790 c 3 VI=VI+A1(I,K)*V1(K)
8794 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8795 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8800 C---------------------------------------
8801 SUBROUTINE MATMAT2(A1,A2,A3)
8803 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8805 implicit real*8 (a-h,o-z)
8806 include 'DIMENSIONS'
8807 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8808 c DIMENSION AI3(2,2)
8812 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8818 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8819 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8820 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8821 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8829 c-------------------------------------------------------------------------
8830 double precision function scalar2(u,v)
8831 !DIR$ INLINEALWAYS scalar2
8833 double precision u(2),v(2)
8836 scalar2=u(1)*v(1)+u(2)*v(2)
8840 C-----------------------------------------------------------------------------
8842 subroutine transpose2(a,at)
8843 !DIR$ INLINEALWAYS transpose2
8845 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8848 double precision a(2,2),at(2,2)
8855 c--------------------------------------------------------------------------
8856 subroutine transpose(n,a,at)
8859 double precision a(n,n),at(n,n)
8867 C---------------------------------------------------------------------------
8868 subroutine prodmat3(a1,a2,kk,transp,prod)
8869 !DIR$ INLINEALWAYS prodmat3
8871 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8875 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8877 crc double precision auxmat(2,2),prod_(2,2)
8880 crc call transpose2(kk(1,1),auxmat(1,1))
8881 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8882 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8884 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8885 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8886 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8887 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8888 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8889 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8890 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8891 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8894 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8895 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8897 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8898 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8899 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8900 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8901 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8902 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8903 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8904 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8907 c call transpose2(a2(1,1),a2t(1,1))
8910 crc print *,((prod_(i,j),i=1,2),j=1,2)
8911 crc print *,((prod(i,j),i=1,2),j=1,2)