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 Here are the energies showed per procesor if the are more processors
300 c per molecule then we sum it up in sum_energy subroutine
301 c print *," Processor",myrank," calls SUM_ENERGY"
302 call sum_energy(energia,.true.)
303 c print *," Processor",myrank," left SUM_ENERGY"
305 time_sumene=time_sumene+MPI_Wtime()-time00
309 c-------------------------------------------------------------------------------
310 subroutine sum_energy(energia,reduce)
311 implicit real*8 (a-h,o-z)
316 cMS$ATTRIBUTES C :: proc_proc
322 include 'COMMON.SETUP'
323 include 'COMMON.IOUNITS'
324 double precision energia(0:n_ene),enebuff(0:n_ene+1)
325 include 'COMMON.FFIELD'
326 include 'COMMON.DERIV'
327 include 'COMMON.INTERACT'
328 include 'COMMON.SBRIDGE'
329 include 'COMMON.CHAIN'
331 include 'COMMON.CONTROL'
332 include 'COMMON.TIME1'
335 if (nfgtasks.gt.1 .and. reduce) then
337 write (iout,*) "energies before REDUCE"
338 call enerprint(energia)
342 enebuff(i)=energia(i)
345 call MPI_Barrier(FG_COMM,IERR)
346 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
348 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
349 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
351 write (iout,*) "energies after REDUCE"
352 call enerprint(energia)
355 time_Reduce=time_Reduce+MPI_Wtime()-time00
357 if (fg_rank.eq.0) then
361 evdw2=energia(2)+energia(18)
377 eello_turn3=energia(8)
378 eello_turn4=energia(9)
385 edihcnstr=energia(19)
390 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
391 & +wang*ebe+wtor*etors+wscloc*escloc
392 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
393 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
394 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
395 & +wbond*estr+Uconst+wsccor*esccor
397 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
398 & +wang*ebe+wtor*etors+wscloc*escloc
399 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
400 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
401 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
402 & +wbond*estr+Uconst+wsccor*esccor
408 if (isnan(etot).ne.0) energia(0)=1.0d+99
410 if (isnan(etot)) energia(0)=1.0d+99
415 idumm=proc_proc(etot,i)
417 call proc_proc(etot,i)
419 if(i.eq.1)energia(0)=1.0d+99
426 c-------------------------------------------------------------------------------
427 subroutine sum_gradient
428 implicit real*8 (a-h,o-z)
433 cMS$ATTRIBUTES C :: proc_proc
438 double precision gradbufc(3,maxres),gradbufx(3,maxres),
439 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
441 include 'COMMON.SETUP'
442 include 'COMMON.IOUNITS'
443 include 'COMMON.FFIELD'
444 include 'COMMON.DERIV'
445 include 'COMMON.INTERACT'
446 include 'COMMON.SBRIDGE'
447 include 'COMMON.CHAIN'
449 include 'COMMON.CONTROL'
450 include 'COMMON.TIME1'
451 include 'COMMON.MAXGRAD'
452 include 'COMMON.SCCOR'
457 write (iout,*) "sum_gradient gvdwc, gvdwx"
459 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
460 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
465 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
466 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
467 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
470 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
471 C in virtual-bond-vector coordinates
474 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
476 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
477 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
479 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
481 c write (iout,'(i5,3f10.5,2x,f10.5)')
482 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
484 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
486 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
487 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
495 gradbufc(j,i)=wsc*gvdwc(j,i)+
496 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
497 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
498 & wel_loc*gel_loc_long(j,i)+
499 & wcorr*gradcorr_long(j,i)+
500 & wcorr5*gradcorr5_long(j,i)+
501 & wcorr6*gradcorr6_long(j,i)+
502 & wturn6*gcorr6_turn_long(j,i)+
509 gradbufc(j,i)=wsc*gvdwc(j,i)+
510 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
511 & welec*gelc_long(j,i)+
513 & wel_loc*gel_loc_long(j,i)+
514 & wcorr*gradcorr_long(j,i)+
515 & wcorr5*gradcorr5_long(j,i)+
516 & wcorr6*gradcorr6_long(j,i)+
517 & wturn6*gcorr6_turn_long(j,i)+
523 if (nfgtasks.gt.1) then
526 write (iout,*) "gradbufc before allreduce"
528 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
534 gradbufc_sum(j,i)=gradbufc(j,i)
537 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
538 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
539 c time_reduce=time_reduce+MPI_Wtime()-time00
541 c write (iout,*) "gradbufc_sum after allreduce"
543 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
548 c time_allreduce=time_allreduce+MPI_Wtime()-time00
556 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
557 write (iout,*) (i," jgrad_start",jgrad_start(i),
558 & " jgrad_end ",jgrad_end(i),
559 & i=igrad_start,igrad_end)
562 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
563 c do not parallelize this part.
565 c do i=igrad_start,igrad_end
566 c do j=jgrad_start(i),jgrad_end(i)
568 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
573 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
577 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
581 write (iout,*) "gradbufc after summing"
583 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
590 write (iout,*) "gradbufc"
592 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
598 gradbufc_sum(j,i)=gradbufc(j,i)
603 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
607 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
612 c gradbufc(k,i)=0.0d0
616 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
621 write (iout,*) "gradbufc after summing"
623 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
631 gradbufc(k,nres)=0.0d0
636 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
637 & wel_loc*gel_loc(j,i)+
638 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
639 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
640 & wel_loc*gel_loc_long(j,i)+
641 & wcorr*gradcorr_long(j,i)+
642 & wcorr5*gradcorr5_long(j,i)+
643 & wcorr6*gradcorr6_long(j,i)+
644 & wturn6*gcorr6_turn_long(j,i))+
646 & wcorr*gradcorr(j,i)+
647 & wturn3*gcorr3_turn(j,i)+
648 & wturn4*gcorr4_turn(j,i)+
649 & wcorr5*gradcorr5(j,i)+
650 & wcorr6*gradcorr6(j,i)+
651 & wturn6*gcorr6_turn(j,i)+
652 & wsccor*gsccorc(j,i)
653 & +wscloc*gscloc(j,i)
655 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
656 & wel_loc*gel_loc(j,i)+
657 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
658 & welec*gelc_long(j,i)
659 & wel_loc*gel_loc_long(j,i)+
660 & wcorr*gcorr_long(j,i)+
661 & wcorr5*gradcorr5_long(j,i)+
662 & wcorr6*gradcorr6_long(j,i)+
663 & wturn6*gcorr6_turn_long(j,i))+
665 & wcorr*gradcorr(j,i)+
666 & wturn3*gcorr3_turn(j,i)+
667 & wturn4*gcorr4_turn(j,i)+
668 & wcorr5*gradcorr5(j,i)+
669 & wcorr6*gradcorr6(j,i)+
670 & wturn6*gcorr6_turn(j,i)+
671 & wsccor*gsccorc(j,i)
672 & +wscloc*gscloc(j,i)
674 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
676 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
677 & wsccor*gsccorx(j,i)
678 & +wscloc*gsclocx(j,i)
682 write (iout,*) "gloc before adding corr"
684 write (iout,*) i,gloc(i,icg)
688 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
689 & +wcorr5*g_corr5_loc(i)
690 & +wcorr6*g_corr6_loc(i)
691 & +wturn4*gel_loc_turn4(i)
692 & +wturn3*gel_loc_turn3(i)
693 & +wturn6*gel_loc_turn6(i)
694 & +wel_loc*gel_loc_loc(i)
697 write (iout,*) "gloc after adding corr"
699 write (iout,*) i,gloc(i,icg)
703 if (nfgtasks.gt.1) then
706 gradbufc(j,i)=gradc(j,i,icg)
707 gradbufx(j,i)=gradx(j,i,icg)
711 glocbuf(i)=gloc(i,icg)
715 write (iout,*) "gloc_sc before reduce"
718 write (iout,*) i,j,gloc_sc(j,i,icg)
725 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
729 call MPI_Barrier(FG_COMM,IERR)
730 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
732 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
733 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
734 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
735 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
736 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
737 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
738 time_reduce=time_reduce+MPI_Wtime()-time00
739 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
740 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
741 time_reduce=time_reduce+MPI_Wtime()-time00
744 write (iout,*) "gloc_sc after reduce"
747 write (iout,*) i,j,gloc_sc(j,i,icg)
753 write (iout,*) "gloc after reduce"
755 write (iout,*) i,gloc(i,icg)
760 if (gnorm_check) then
762 c Compute the maximum elements of the gradient
772 gcorr3_turn_max=0.0d0
773 gcorr4_turn_max=0.0d0
776 gcorr6_turn_max=0.0d0
786 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
787 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
788 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
789 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
790 & gvdwc_scp_max=gvdwc_scp_norm
791 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
792 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
793 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
794 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
795 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
796 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
797 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
798 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
799 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
800 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
801 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
802 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
803 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
805 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
806 & gcorr3_turn_max=gcorr3_turn_norm
807 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
809 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
810 & gcorr4_turn_max=gcorr4_turn_norm
811 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
812 if (gradcorr5_norm.gt.gradcorr5_max)
813 & gradcorr5_max=gradcorr5_norm
814 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
815 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
816 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
818 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
819 & gcorr6_turn_max=gcorr6_turn_norm
820 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
821 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
822 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
823 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
824 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
825 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
826 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
827 if (gradx_scp_norm.gt.gradx_scp_max)
828 & gradx_scp_max=gradx_scp_norm
829 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
830 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
831 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
832 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
833 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
834 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
835 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
836 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
840 open(istat,file=statname,position="append")
842 open(istat,file=statname,access="append")
844 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
845 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
846 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
847 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
848 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
849 & gsccorx_max,gsclocx_max
851 if (gvdwc_max.gt.1.0d4) then
852 write (iout,*) "gvdwc gvdwx gradb gradbx"
854 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
855 & gradb(j,i),gradbx(j,i),j=1,3)
857 call pdbout(0.0d0,'cipiszcze',iout)
863 write (iout,*) "gradc gradx gloc"
865 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
866 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
870 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
874 c-------------------------------------------------------------------------------
875 subroutine rescale_weights(t_bath)
876 implicit real*8 (a-h,o-z)
878 include 'COMMON.IOUNITS'
879 include 'COMMON.FFIELD'
880 include 'COMMON.SBRIDGE'
881 double precision kfac /2.4d0/
882 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
884 c facT=2*temp0/(t_bath+temp0)
885 if (rescale_mode.eq.0) then
891 else if (rescale_mode.eq.1) then
892 facT=kfac/(kfac-1.0d0+t_bath/temp0)
893 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
894 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
895 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
896 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
897 else if (rescale_mode.eq.2) then
903 facT=licznik/dlog(dexp(x)+dexp(-x))
904 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
905 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
906 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
907 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
909 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
910 write (*,*) "Wrong RESCALE_MODE",rescale_mode
912 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
916 welec=weights(3)*fact
917 wcorr=weights(4)*fact3
918 wcorr5=weights(5)*fact4
919 wcorr6=weights(6)*fact5
920 wel_loc=weights(7)*fact2
921 wturn3=weights(8)*fact2
922 wturn4=weights(9)*fact3
923 wturn6=weights(10)*fact5
924 wtor=weights(13)*fact
925 wtor_d=weights(14)*fact2
926 wsccor=weights(21)*fact
930 C------------------------------------------------------------------------
931 subroutine enerprint(energia)
932 implicit real*8 (a-h,o-z)
934 include 'COMMON.IOUNITS'
935 include 'COMMON.FFIELD'
936 include 'COMMON.SBRIDGE'
938 double precision energia(0:n_ene)
943 evdw2=energia(2)+energia(18)
955 eello_turn3=energia(8)
956 eello_turn4=energia(9)
957 eello_turn6=energia(10)
963 edihcnstr=energia(19)
968 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
969 & estr,wbond,ebe,wang,
970 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
972 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
973 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
976 10 format (/'Virtual-chain energies:'//
977 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
978 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
979 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
980 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
981 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
982 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
983 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
984 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
985 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
986 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
987 & ' (SS bridges & dist. cnstr.)'/
988 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
989 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
990 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
991 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
992 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
993 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
994 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
995 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
996 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
997 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
998 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
999 & 'ETOT= ',1pE16.6,' (total)')
1001 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1002 & estr,wbond,ebe,wang,
1003 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1005 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1006 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1007 & ebr*nss,Uconst,etot
1008 10 format (/'Virtual-chain energies:'//
1009 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1010 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1011 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1012 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1013 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1014 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1015 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1016 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1017 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1018 & ' (SS bridges & dist. cnstr.)'/
1019 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1020 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1021 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1022 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1023 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1024 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1025 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1026 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1027 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1028 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1029 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1030 & 'ETOT= ',1pE16.6,' (total)')
1034 C-----------------------------------------------------------------------
1035 subroutine elj(evdw)
1037 C This subroutine calculates the interaction energy of nonbonded side chains
1038 C assuming the LJ potential of interaction.
1040 implicit real*8 (a-h,o-z)
1041 include 'DIMENSIONS'
1042 parameter (accur=1.0d-10)
1043 include 'COMMON.GEO'
1044 include 'COMMON.VAR'
1045 include 'COMMON.LOCAL'
1046 include 'COMMON.CHAIN'
1047 include 'COMMON.DERIV'
1048 include 'COMMON.INTERACT'
1049 include 'COMMON.TORSION'
1050 include 'COMMON.SBRIDGE'
1051 include 'COMMON.NAMES'
1052 include 'COMMON.IOUNITS'
1053 include 'COMMON.CONTACTS'
1055 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1057 do i=iatsc_s,iatsc_e
1058 itypi=iabs(itype(i))
1059 if (itypi.eq.ntyp1) cycle
1060 itypi1=iabs(itype(i+1))
1067 C Calculate SC interaction energy.
1069 do iint=1,nint_gr(i)
1070 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1071 cd & 'iend=',iend(i,iint)
1072 do j=istart(i,iint),iend(i,iint)
1073 itypj=iabs(itype(j))
1074 if (itypj.eq.ntyp1) cycle
1078 C Change 12/1/95 to calculate four-body interactions
1079 rij=xj*xj+yj*yj+zj*zj
1081 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1082 eps0ij=eps(itypi,itypj)
1084 e1=fac*fac*aa(itypi,itypj)
1085 e2=fac*bb(itypi,itypj)
1087 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1088 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1089 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1090 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1091 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1092 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1095 C Calculate the components of the gradient in DC and X
1097 fac=-rrij*(e1+evdwij)
1102 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1103 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1104 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1105 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1109 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1113 C 12/1/95, revised on 5/20/97
1115 C Calculate the contact function. The ith column of the array JCONT will
1116 C contain the numbers of atoms that make contacts with the atom I (of numbers
1117 C greater than I). The arrays FACONT and GACONT will contain the values of
1118 C the contact function and its derivative.
1120 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1121 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1122 C Uncomment next line, if the correlation interactions are contact function only
1123 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1125 sigij=sigma(itypi,itypj)
1126 r0ij=rs0(itypi,itypj)
1128 C Check whether the SC's are not too far to make a contact.
1131 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1132 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1134 if (fcont.gt.0.0D0) then
1135 C If the SC-SC distance if close to sigma, apply spline.
1136 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1137 cAdam & fcont1,fprimcont1)
1138 cAdam fcont1=1.0d0-fcont1
1139 cAdam if (fcont1.gt.0.0d0) then
1140 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1141 cAdam fcont=fcont*fcont1
1143 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1144 cga eps0ij=1.0d0/dsqrt(eps0ij)
1146 cga gg(k)=gg(k)*eps0ij
1148 cga eps0ij=-evdwij*eps0ij
1149 C Uncomment for AL's type of SC correlation interactions.
1150 cadam eps0ij=-evdwij
1151 num_conti=num_conti+1
1152 jcont(num_conti,i)=j
1153 facont(num_conti,i)=fcont*eps0ij
1154 fprimcont=eps0ij*fprimcont/rij
1156 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1157 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1158 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1159 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1160 gacont(1,num_conti,i)=-fprimcont*xj
1161 gacont(2,num_conti,i)=-fprimcont*yj
1162 gacont(3,num_conti,i)=-fprimcont*zj
1163 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1164 cd write (iout,'(2i3,3f10.5)')
1165 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1171 num_cont(i)=num_conti
1175 gvdwc(j,i)=expon*gvdwc(j,i)
1176 gvdwx(j,i)=expon*gvdwx(j,i)
1179 C******************************************************************************
1183 C To save time, the factor of EXPON has been extracted from ALL components
1184 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1187 C******************************************************************************
1190 C-----------------------------------------------------------------------------
1191 subroutine eljk(evdw)
1193 C This subroutine calculates the interaction energy of nonbonded side chains
1194 C assuming the LJK potential of interaction.
1196 implicit real*8 (a-h,o-z)
1197 include 'DIMENSIONS'
1198 include 'COMMON.GEO'
1199 include 'COMMON.VAR'
1200 include 'COMMON.LOCAL'
1201 include 'COMMON.CHAIN'
1202 include 'COMMON.DERIV'
1203 include 'COMMON.INTERACT'
1204 include 'COMMON.IOUNITS'
1205 include 'COMMON.NAMES'
1208 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1210 do i=iatsc_s,iatsc_e
1211 itypi=iabs(itype(i))
1212 if (itypi.eq.ntyp1) cycle
1213 itypi1=iabs(itype(i+1))
1218 C Calculate SC interaction energy.
1220 do iint=1,nint_gr(i)
1221 do j=istart(i,iint),iend(i,iint)
1222 itypj=iabs(itype(j))
1223 if (itypj.eq.ntyp1) cycle
1227 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1228 fac_augm=rrij**expon
1229 e_augm=augm(itypi,itypj)*fac_augm
1230 r_inv_ij=dsqrt(rrij)
1232 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1233 fac=r_shift_inv**expon
1234 e1=fac*fac*aa(itypi,itypj)
1235 e2=fac*bb(itypi,itypj)
1237 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1238 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1239 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1240 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1241 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1242 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1243 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1246 C Calculate the components of the gradient in DC and X
1248 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1253 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1254 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1255 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1256 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1260 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1268 gvdwc(j,i)=expon*gvdwc(j,i)
1269 gvdwx(j,i)=expon*gvdwx(j,i)
1274 C-----------------------------------------------------------------------------
1275 subroutine ebp(evdw)
1277 C This subroutine calculates the interaction energy of nonbonded side chains
1278 C assuming the Berne-Pechukas potential of interaction.
1280 implicit real*8 (a-h,o-z)
1281 include 'DIMENSIONS'
1282 include 'COMMON.GEO'
1283 include 'COMMON.VAR'
1284 include 'COMMON.LOCAL'
1285 include 'COMMON.CHAIN'
1286 include 'COMMON.DERIV'
1287 include 'COMMON.NAMES'
1288 include 'COMMON.INTERACT'
1289 include 'COMMON.IOUNITS'
1290 include 'COMMON.CALC'
1291 common /srutu/ icall
1292 c double precision rrsave(maxdim)
1295 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1297 c if (icall.eq.0) then
1303 do i=iatsc_s,iatsc_e
1304 itypi=iabs(itype(i))
1305 if (itypi.eq.ntyp1) cycle
1306 itypi1=iabs(itype(i+1))
1310 dxi=dc_norm(1,nres+i)
1311 dyi=dc_norm(2,nres+i)
1312 dzi=dc_norm(3,nres+i)
1313 c dsci_inv=dsc_inv(itypi)
1314 dsci_inv=vbld_inv(i+nres)
1316 C Calculate SC interaction energy.
1318 do iint=1,nint_gr(i)
1319 do j=istart(i,iint),iend(i,iint)
1321 itypj=iabs(itype(j))
1322 if (itypj.eq.ntyp1) cycle
1323 c dscj_inv=dsc_inv(itypj)
1324 dscj_inv=vbld_inv(j+nres)
1325 chi1=chi(itypi,itypj)
1326 chi2=chi(itypj,itypi)
1333 alf12=0.5D0*(alf1+alf2)
1334 C For diagnostics only!!!
1347 dxj=dc_norm(1,nres+j)
1348 dyj=dc_norm(2,nres+j)
1349 dzj=dc_norm(3,nres+j)
1350 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1351 cd if (icall.eq.0) then
1357 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1359 C Calculate whole angle-dependent part of epsilon and contributions
1360 C to its derivatives
1361 fac=(rrij*sigsq)**expon2
1362 e1=fac*fac*aa(itypi,itypj)
1363 e2=fac*bb(itypi,itypj)
1364 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1365 eps2der=evdwij*eps3rt
1366 eps3der=evdwij*eps2rt
1367 evdwij=evdwij*eps2rt*eps3rt
1370 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1371 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1372 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1373 cd & restyp(itypi),i,restyp(itypj),j,
1374 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1375 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1376 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1379 C Calculate gradient components.
1380 e1=e1*eps1*eps2rt**2*eps3rt**2
1381 fac=-expon*(e1+evdwij)
1384 C Calculate radial part of the gradient
1388 C Calculate the angular part of the gradient and sum add the contributions
1389 C to the appropriate components of the Cartesian gradient.
1397 C-----------------------------------------------------------------------------
1398 subroutine egb(evdw)
1400 C This subroutine calculates the interaction energy of nonbonded side chains
1401 C assuming the Gay-Berne potential of interaction.
1403 implicit real*8 (a-h,o-z)
1404 include 'DIMENSIONS'
1405 include 'COMMON.GEO'
1406 include 'COMMON.VAR'
1407 include 'COMMON.LOCAL'
1408 include 'COMMON.CHAIN'
1409 include 'COMMON.DERIV'
1410 include 'COMMON.NAMES'
1411 include 'COMMON.INTERACT'
1412 include 'COMMON.IOUNITS'
1413 include 'COMMON.CALC'
1414 include 'COMMON.CONTROL'
1416 integer xshift,yshift,zshift
1418 ccccc energy_dec=.false.
1419 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1422 c if (icall.eq.0) lprn=.false.
1424 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1425 C we have the original box)
1429 do i=iatsc_s,iatsc_e
1430 itypi=iabs(itype(i))
1431 if (itypi.eq.ntyp1) cycle
1432 itypi1=iabs(itype(i+1))
1436 C Return atom into box, boxxsize is size of box in x dimension
1438 if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1439 if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1440 C Condition for being inside the proper box
1441 if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1442 & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1446 if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1447 if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1448 C Condition for being inside the proper box
1449 if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1450 & (yi.lt.((yshift-0.5d0)*boxysize))) then
1454 if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxxsize
1455 if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxxsize
1456 C Condition for being inside the proper box
1457 if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1458 & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1462 dxi=dc_norm(1,nres+i)
1463 dyi=dc_norm(2,nres+i)
1464 dzi=dc_norm(3,nres+i)
1465 c dsci_inv=dsc_inv(itypi)
1466 dsci_inv=vbld_inv(i+nres)
1467 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1468 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1470 C Calculate SC interaction energy.
1472 do iint=1,nint_gr(i)
1473 do j=istart(i,iint),iend(i,iint)
1475 itypj=iabs(itype(j))
1476 if (itypj.eq.ntyp1) cycle
1477 c dscj_inv=dsc_inv(itypj)
1478 dscj_inv=vbld_inv(j+nres)
1479 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1480 c & 1.0d0/vbld(j+nres)
1481 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1482 sig0ij=sigma(itypi,itypj)
1483 chi1=chi(itypi,itypj)
1484 chi2=chi(itypj,itypi)
1491 alf12=0.5D0*(alf1+alf2)
1492 C For diagnostics only!!!
1505 C Return atom J into box the original box
1507 if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1508 if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1509 C Condition for being inside the proper box
1510 if ((xj.gt.((0.5d0)*boxxsize)).or.
1511 & (xj.lt.((-0.5d0)*boxxsize))) then
1515 if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1516 if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1517 C Condition for being inside the proper box
1518 if ((yj.gt.((0.5d0)*boxysize)).or.
1519 & (yj.lt.((-0.5d0)*boxysize))) then
1523 if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxxsize
1524 if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxxsize
1525 C Condition for being inside the proper box
1526 if ((zj.gt.((0.5d0)*boxzsize)).or.
1527 & (zj.lt.((-0.5d0)*boxzsize))) then
1531 dxj=dc_norm(1,nres+j)
1532 dyj=dc_norm(2,nres+j)
1533 dzj=dc_norm(3,nres+j)
1537 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1538 c write (iout,*) "j",j," dc_norm",
1539 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1540 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1542 C Calculate angle-dependent terms of energy and contributions to their
1546 sig=sig0ij*dsqrt(sigsq)
1547 rij_shift=1.0D0/rij-sig+sig0ij
1548 c for diagnostics; uncomment
1549 c rij_shift=1.2*sig0ij
1550 C I hate to put IF's in the loops, but here don't have another choice!!!!
1551 if (rij_shift.le.0.0D0) then
1553 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1554 cd & restyp(itypi),i,restyp(itypj),j,
1555 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1559 c---------------------------------------------------------------
1560 rij_shift=1.0D0/rij_shift
1561 fac=rij_shift**expon
1562 e1=fac*fac*aa(itypi,itypj)
1563 e2=fac*bb(itypi,itypj)
1564 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1565 eps2der=evdwij*eps3rt
1566 eps3der=evdwij*eps2rt
1567 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1568 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1569 evdwij=evdwij*eps2rt*eps3rt
1572 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1573 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1574 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1575 & restyp(itypi),i,restyp(itypj),j,
1576 & epsi,sigm,chi1,chi2,chip1,chip2,
1577 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1578 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1582 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1585 C Calculate gradient components.
1586 e1=e1*eps1*eps2rt**2*eps3rt**2
1587 fac=-expon*(e1+evdwij)*rij_shift
1591 C Calculate the radial part of the gradient
1595 C Calculate angular part of the gradient.
1603 c write (iout,*) "Number of loop steps in EGB:",ind
1604 cccc energy_dec=.false.
1607 C-----------------------------------------------------------------------------
1608 subroutine egbv(evdw)
1610 C This subroutine calculates the interaction energy of nonbonded side chains
1611 C assuming the Gay-Berne-Vorobjev potential of interaction.
1613 implicit real*8 (a-h,o-z)
1614 include 'DIMENSIONS'
1615 include 'COMMON.GEO'
1616 include 'COMMON.VAR'
1617 include 'COMMON.LOCAL'
1618 include 'COMMON.CHAIN'
1619 include 'COMMON.DERIV'
1620 include 'COMMON.NAMES'
1621 include 'COMMON.INTERACT'
1622 include 'COMMON.IOUNITS'
1623 include 'COMMON.CALC'
1624 common /srutu/ icall
1627 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1630 c if (icall.eq.0) lprn=.true.
1632 do i=iatsc_s,iatsc_e
1633 itypi=iabs(itype(i))
1634 if (itypi.eq.ntyp1) cycle
1635 itypi1=iabs(itype(i+1))
1639 dxi=dc_norm(1,nres+i)
1640 dyi=dc_norm(2,nres+i)
1641 dzi=dc_norm(3,nres+i)
1642 c dsci_inv=dsc_inv(itypi)
1643 dsci_inv=vbld_inv(i+nres)
1645 C Calculate SC interaction energy.
1647 do iint=1,nint_gr(i)
1648 do j=istart(i,iint),iend(i,iint)
1650 itypj=iabs(itype(j))
1651 if (itypj.eq.ntyp1) cycle
1652 c dscj_inv=dsc_inv(itypj)
1653 dscj_inv=vbld_inv(j+nres)
1654 sig0ij=sigma(itypi,itypj)
1655 r0ij=r0(itypi,itypj)
1656 chi1=chi(itypi,itypj)
1657 chi2=chi(itypj,itypi)
1664 alf12=0.5D0*(alf1+alf2)
1665 C For diagnostics only!!!
1678 dxj=dc_norm(1,nres+j)
1679 dyj=dc_norm(2,nres+j)
1680 dzj=dc_norm(3,nres+j)
1681 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1683 C Calculate angle-dependent terms of energy and contributions to their
1687 sig=sig0ij*dsqrt(sigsq)
1688 rij_shift=1.0D0/rij-sig+r0ij
1689 C I hate to put IF's in the loops, but here don't have another choice!!!!
1690 if (rij_shift.le.0.0D0) then
1695 c---------------------------------------------------------------
1696 rij_shift=1.0D0/rij_shift
1697 fac=rij_shift**expon
1698 e1=fac*fac*aa(itypi,itypj)
1699 e2=fac*bb(itypi,itypj)
1700 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1701 eps2der=evdwij*eps3rt
1702 eps3der=evdwij*eps2rt
1703 fac_augm=rrij**expon
1704 e_augm=augm(itypi,itypj)*fac_augm
1705 evdwij=evdwij*eps2rt*eps3rt
1706 evdw=evdw+evdwij+e_augm
1708 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1709 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1710 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1711 & restyp(itypi),i,restyp(itypj),j,
1712 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1713 & chi1,chi2,chip1,chip2,
1714 & eps1,eps2rt**2,eps3rt**2,
1715 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1718 C Calculate gradient components.
1719 e1=e1*eps1*eps2rt**2*eps3rt**2
1720 fac=-expon*(e1+evdwij)*rij_shift
1722 fac=rij*fac-2*expon*rrij*e_augm
1723 C Calculate the radial part of the gradient
1727 C Calculate angular part of the gradient.
1733 C-----------------------------------------------------------------------------
1734 subroutine sc_angular
1735 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1736 C om12. Called by ebp, egb, and egbv.
1738 include 'COMMON.CALC'
1739 include 'COMMON.IOUNITS'
1743 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1744 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1745 om12=dxi*dxj+dyi*dyj+dzi*dzj
1747 C Calculate eps1(om12) and its derivative in om12
1748 faceps1=1.0D0-om12*chiom12
1749 faceps1_inv=1.0D0/faceps1
1750 eps1=dsqrt(faceps1_inv)
1751 C Following variable is eps1*deps1/dom12
1752 eps1_om12=faceps1_inv*chiom12
1757 c write (iout,*) "om12",om12," eps1",eps1
1758 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1763 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1764 sigsq=1.0D0-facsig*faceps1_inv
1765 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1766 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1767 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1773 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1774 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1776 C Calculate eps2 and its derivatives in om1, om2, and om12.
1779 chipom12=chip12*om12
1780 facp=1.0D0-om12*chipom12
1782 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1783 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1784 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1785 C Following variable is the square root of eps2
1786 eps2rt=1.0D0-facp1*facp_inv
1787 C Following three variables are the derivatives of the square root of eps
1788 C in om1, om2, and om12.
1789 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1790 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1791 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1792 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1793 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1794 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1795 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1796 c & " eps2rt_om12",eps2rt_om12
1797 C Calculate whole angle-dependent part of epsilon and contributions
1798 C to its derivatives
1801 C----------------------------------------------------------------------------
1803 implicit real*8 (a-h,o-z)
1804 include 'DIMENSIONS'
1805 include 'COMMON.CHAIN'
1806 include 'COMMON.DERIV'
1807 include 'COMMON.CALC'
1808 include 'COMMON.IOUNITS'
1809 double precision dcosom1(3),dcosom2(3)
1810 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1811 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1812 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1813 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1817 c eom12=evdwij*eps1_om12
1819 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1820 c & " sigder",sigder
1821 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1822 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1824 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1825 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1828 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1830 c write (iout,*) "gg",(gg(k),k=1,3)
1832 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1833 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1834 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1835 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1836 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1837 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1838 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1839 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1840 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1841 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1844 C Calculate the components of the gradient in DC and X
1848 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1852 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1853 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1857 C-----------------------------------------------------------------------
1858 subroutine e_softsphere(evdw)
1860 C This subroutine calculates the interaction energy of nonbonded side chains
1861 C assuming the LJ potential of interaction.
1863 implicit real*8 (a-h,o-z)
1864 include 'DIMENSIONS'
1865 parameter (accur=1.0d-10)
1866 include 'COMMON.GEO'
1867 include 'COMMON.VAR'
1868 include 'COMMON.LOCAL'
1869 include 'COMMON.CHAIN'
1870 include 'COMMON.DERIV'
1871 include 'COMMON.INTERACT'
1872 include 'COMMON.TORSION'
1873 include 'COMMON.SBRIDGE'
1874 include 'COMMON.NAMES'
1875 include 'COMMON.IOUNITS'
1876 include 'COMMON.CONTACTS'
1878 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1880 do i=iatsc_s,iatsc_e
1881 itypi=iabs(itype(i))
1882 if (itypi.eq.ntyp1) cycle
1883 itypi1=iabs(itype(i+1))
1888 C Calculate SC interaction energy.
1890 do iint=1,nint_gr(i)
1891 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1892 cd & 'iend=',iend(i,iint)
1893 do j=istart(i,iint),iend(i,iint)
1894 itypj=iabs(itype(j))
1895 if (itypj.eq.ntyp1) cycle
1899 rij=xj*xj+yj*yj+zj*zj
1900 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1901 r0ij=r0(itypi,itypj)
1903 c print *,i,j,r0ij,dsqrt(rij)
1904 if (rij.lt.r0ijsq) then
1905 evdwij=0.25d0*(rij-r0ijsq)**2
1913 C Calculate the components of the gradient in DC and X
1919 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1920 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1921 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1922 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1926 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1934 C--------------------------------------------------------------------------
1935 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1938 C Soft-sphere potential of p-p interaction
1940 implicit real*8 (a-h,o-z)
1941 include 'DIMENSIONS'
1942 include 'COMMON.CONTROL'
1943 include 'COMMON.IOUNITS'
1944 include 'COMMON.GEO'
1945 include 'COMMON.VAR'
1946 include 'COMMON.LOCAL'
1947 include 'COMMON.CHAIN'
1948 include 'COMMON.DERIV'
1949 include 'COMMON.INTERACT'
1950 include 'COMMON.CONTACTS'
1951 include 'COMMON.TORSION'
1952 include 'COMMON.VECTORS'
1953 include 'COMMON.FFIELD'
1955 cd write(iout,*) 'In EELEC_soft_sphere'
1962 do i=iatel_s,iatel_e
1963 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1967 xmedi=c(1,i)+0.5d0*dxi
1968 ymedi=c(2,i)+0.5d0*dyi
1969 zmedi=c(3,i)+0.5d0*dzi
1971 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1972 do j=ielstart(i),ielend(i)
1973 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1977 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1978 r0ij=rpp(iteli,itelj)
1983 xj=c(1,j)+0.5D0*dxj-xmedi
1984 yj=c(2,j)+0.5D0*dyj-ymedi
1985 zj=c(3,j)+0.5D0*dzj-zmedi
1986 rij=xj*xj+yj*yj+zj*zj
1987 if (rij.lt.r0ijsq) then
1988 evdw1ij=0.25d0*(rij-r0ijsq)**2
1996 C Calculate contributions to the Cartesian gradient.
2002 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2003 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2006 * Loop over residues i+1 thru j-1.
2010 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2015 cgrad do i=nnt,nct-1
2017 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2019 cgrad do j=i+1,nct-1
2021 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2027 c------------------------------------------------------------------------------
2028 subroutine vec_and_deriv
2029 implicit real*8 (a-h,o-z)
2030 include 'DIMENSIONS'
2034 include 'COMMON.IOUNITS'
2035 include 'COMMON.GEO'
2036 include 'COMMON.VAR'
2037 include 'COMMON.LOCAL'
2038 include 'COMMON.CHAIN'
2039 include 'COMMON.VECTORS'
2040 include 'COMMON.SETUP'
2041 include 'COMMON.TIME1'
2042 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2043 C Compute the local reference systems. For reference system (i), the
2044 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2045 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2047 do i=ivec_start,ivec_end
2051 if (i.eq.nres-1) then
2052 C Case of the last full residue
2053 C Compute the Z-axis
2054 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2055 costh=dcos(pi-theta(nres))
2056 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2060 C Compute the derivatives of uz
2062 uzder(2,1,1)=-dc_norm(3,i-1)
2063 uzder(3,1,1)= dc_norm(2,i-1)
2064 uzder(1,2,1)= dc_norm(3,i-1)
2066 uzder(3,2,1)=-dc_norm(1,i-1)
2067 uzder(1,3,1)=-dc_norm(2,i-1)
2068 uzder(2,3,1)= dc_norm(1,i-1)
2071 uzder(2,1,2)= dc_norm(3,i)
2072 uzder(3,1,2)=-dc_norm(2,i)
2073 uzder(1,2,2)=-dc_norm(3,i)
2075 uzder(3,2,2)= dc_norm(1,i)
2076 uzder(1,3,2)= dc_norm(2,i)
2077 uzder(2,3,2)=-dc_norm(1,i)
2079 C Compute the Y-axis
2082 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2084 C Compute the derivatives of uy
2087 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2088 & -dc_norm(k,i)*dc_norm(j,i-1)
2089 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2091 uyder(j,j,1)=uyder(j,j,1)-costh
2092 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2097 uygrad(l,k,j,i)=uyder(l,k,j)
2098 uzgrad(l,k,j,i)=uzder(l,k,j)
2102 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2103 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2104 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2105 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2108 C Compute the Z-axis
2109 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2110 costh=dcos(pi-theta(i+2))
2111 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2115 C Compute the derivatives of uz
2117 uzder(2,1,1)=-dc_norm(3,i+1)
2118 uzder(3,1,1)= dc_norm(2,i+1)
2119 uzder(1,2,1)= dc_norm(3,i+1)
2121 uzder(3,2,1)=-dc_norm(1,i+1)
2122 uzder(1,3,1)=-dc_norm(2,i+1)
2123 uzder(2,3,1)= dc_norm(1,i+1)
2126 uzder(2,1,2)= dc_norm(3,i)
2127 uzder(3,1,2)=-dc_norm(2,i)
2128 uzder(1,2,2)=-dc_norm(3,i)
2130 uzder(3,2,2)= dc_norm(1,i)
2131 uzder(1,3,2)= dc_norm(2,i)
2132 uzder(2,3,2)=-dc_norm(1,i)
2134 C Compute the Y-axis
2137 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2139 C Compute the derivatives of uy
2142 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2143 & -dc_norm(k,i)*dc_norm(j,i+1)
2144 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2146 uyder(j,j,1)=uyder(j,j,1)-costh
2147 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2152 uygrad(l,k,j,i)=uyder(l,k,j)
2153 uzgrad(l,k,j,i)=uzder(l,k,j)
2157 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2158 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2159 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2160 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2164 vbld_inv_temp(1)=vbld_inv(i+1)
2165 if (i.lt.nres-1) then
2166 vbld_inv_temp(2)=vbld_inv(i+2)
2168 vbld_inv_temp(2)=vbld_inv(i)
2173 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2174 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2179 #if defined(PARVEC) && defined(MPI)
2180 if (nfgtasks1.gt.1) then
2182 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2183 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2184 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2185 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2186 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2188 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2189 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2191 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2192 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2193 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2194 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2195 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2196 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2197 time_gather=time_gather+MPI_Wtime()-time00
2199 c if (fg_rank.eq.0) then
2200 c write (iout,*) "Arrays UY and UZ"
2202 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2209 C-----------------------------------------------------------------------------
2210 subroutine check_vecgrad
2211 implicit real*8 (a-h,o-z)
2212 include 'DIMENSIONS'
2213 include 'COMMON.IOUNITS'
2214 include 'COMMON.GEO'
2215 include 'COMMON.VAR'
2216 include 'COMMON.LOCAL'
2217 include 'COMMON.CHAIN'
2218 include 'COMMON.VECTORS'
2219 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2220 dimension uyt(3,maxres),uzt(3,maxres)
2221 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2222 double precision delta /1.0d-7/
2225 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2226 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2227 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2228 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2229 cd & (dc_norm(if90,i),if90=1,3)
2230 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2231 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2232 cd write(iout,'(a)')
2238 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2239 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2252 cd write (iout,*) 'i=',i
2254 erij(k)=dc_norm(k,i)
2258 dc_norm(k,i)=erij(k)
2260 dc_norm(j,i)=dc_norm(j,i)+delta
2261 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2263 c dc_norm(k,i)=dc_norm(k,i)/fac
2265 c write (iout,*) (dc_norm(k,i),k=1,3)
2266 c write (iout,*) (erij(k),k=1,3)
2269 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2270 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2271 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2272 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2274 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2275 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2276 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2279 dc_norm(k,i)=erij(k)
2282 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2283 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2284 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2285 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2286 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2287 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2288 cd write (iout,'(a)')
2293 C--------------------------------------------------------------------------
2294 subroutine set_matrices
2295 implicit real*8 (a-h,o-z)
2296 include 'DIMENSIONS'
2299 include "COMMON.SETUP"
2301 integer status(MPI_STATUS_SIZE)
2303 include 'COMMON.IOUNITS'
2304 include 'COMMON.GEO'
2305 include 'COMMON.VAR'
2306 include 'COMMON.LOCAL'
2307 include 'COMMON.CHAIN'
2308 include 'COMMON.DERIV'
2309 include 'COMMON.INTERACT'
2310 include 'COMMON.CONTACTS'
2311 include 'COMMON.TORSION'
2312 include 'COMMON.VECTORS'
2313 include 'COMMON.FFIELD'
2314 double precision auxvec(2),auxmat(2,2)
2316 C Compute the virtual-bond-torsional-angle dependent quantities needed
2317 C to calculate the el-loc multibody terms of various order.
2320 do i=ivec_start+2,ivec_end+2
2324 if (i .lt. nres+1) then
2361 if (i .gt. 3 .and. i .lt. nres+1) then
2362 obrot_der(1,i-2)=-sin1
2363 obrot_der(2,i-2)= cos1
2364 Ugder(1,1,i-2)= sin1
2365 Ugder(1,2,i-2)=-cos1
2366 Ugder(2,1,i-2)=-cos1
2367 Ugder(2,2,i-2)=-sin1
2370 obrot2_der(1,i-2)=-dwasin2
2371 obrot2_der(2,i-2)= dwacos2
2372 Ug2der(1,1,i-2)= dwasin2
2373 Ug2der(1,2,i-2)=-dwacos2
2374 Ug2der(2,1,i-2)=-dwacos2
2375 Ug2der(2,2,i-2)=-dwasin2
2377 obrot_der(1,i-2)=0.0d0
2378 obrot_der(2,i-2)=0.0d0
2379 Ugder(1,1,i-2)=0.0d0
2380 Ugder(1,2,i-2)=0.0d0
2381 Ugder(2,1,i-2)=0.0d0
2382 Ugder(2,2,i-2)=0.0d0
2383 obrot2_der(1,i-2)=0.0d0
2384 obrot2_der(2,i-2)=0.0d0
2385 Ug2der(1,1,i-2)=0.0d0
2386 Ug2der(1,2,i-2)=0.0d0
2387 Ug2der(2,1,i-2)=0.0d0
2388 Ug2der(2,2,i-2)=0.0d0
2390 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2391 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2392 iti = itortyp(itype(i-2))
2396 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2397 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2398 iti1 = itortyp(itype(i-1))
2402 cd write (iout,*) '*******i',i,' iti1',iti
2403 cd write (iout,*) 'b1',b1(:,iti)
2404 cd write (iout,*) 'b2',b2(:,iti)
2405 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2406 c if (i .gt. iatel_s+2) then
2407 if (i .gt. nnt+2) then
2408 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2409 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2410 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2412 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2413 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2414 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2415 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2416 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2427 DtUg2(l,k,i-2)=0.0d0
2431 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2432 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2434 muder(k,i-2)=Ub2der(k,i-2)
2436 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2437 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2438 if (itype(i-1).le.ntyp) then
2439 iti1 = itortyp(itype(i-1))
2447 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2449 cd write (iout,*) 'mu ',mu(:,i-2)
2450 cd write (iout,*) 'mu1',mu1(:,i-2)
2451 cd write (iout,*) 'mu2',mu2(:,i-2)
2452 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2454 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2455 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2456 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2457 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2458 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2459 C Vectors and matrices dependent on a single virtual-bond dihedral.
2460 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2461 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2462 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2463 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2464 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2465 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2466 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2467 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2468 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2471 C Matrices dependent on two consecutive virtual-bond dihedrals.
2472 C The order of matrices is from left to right.
2473 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2475 c do i=max0(ivec_start,2),ivec_end
2477 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2478 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2479 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2480 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2481 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2482 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2483 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2484 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2487 #if defined(MPI) && defined(PARMAT)
2489 c if (fg_rank.eq.0) then
2490 write (iout,*) "Arrays UG and UGDER before GATHER"
2492 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2493 & ((ug(l,k,i),l=1,2),k=1,2),
2494 & ((ugder(l,k,i),l=1,2),k=1,2)
2496 write (iout,*) "Arrays UG2 and UG2DER"
2498 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2499 & ((ug2(l,k,i),l=1,2),k=1,2),
2500 & ((ug2der(l,k,i),l=1,2),k=1,2)
2502 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2504 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2505 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2506 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2508 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2510 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2511 & costab(i),sintab(i),costab2(i),sintab2(i)
2513 write (iout,*) "Array MUDER"
2515 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2519 if (nfgtasks.gt.1) then
2521 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2522 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2523 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2525 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2526 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2528 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2529 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2531 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2532 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2534 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2535 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2537 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2538 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2540 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2541 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2543 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2544 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2545 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2546 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2547 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2548 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2549 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2550 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2551 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2552 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2553 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2554 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2555 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2557 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2558 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2560 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2561 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2563 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2564 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2566 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2567 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2569 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2570 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2572 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2573 & ivec_count(fg_rank1),
2574 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2576 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2577 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2579 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2580 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2582 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2583 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2585 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2586 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2588 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2589 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2591 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2592 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2594 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2595 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2597 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2598 & ivec_count(fg_rank1),
2599 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2601 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2602 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2604 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2605 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2607 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2608 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2610 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2611 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2613 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2614 & ivec_count(fg_rank1),
2615 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2617 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2618 & ivec_count(fg_rank1),
2619 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2621 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2622 & ivec_count(fg_rank1),
2623 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2624 & MPI_MAT2,FG_COMM1,IERR)
2625 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2626 & ivec_count(fg_rank1),
2627 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2628 & MPI_MAT2,FG_COMM1,IERR)
2631 c Passes matrix info through the ring
2634 if (irecv.lt.0) irecv=nfgtasks1-1
2637 if (inext.ge.nfgtasks1) inext=0
2639 c write (iout,*) "isend",isend," irecv",irecv
2641 lensend=lentyp(isend)
2642 lenrecv=lentyp(irecv)
2643 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2644 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2645 c & MPI_ROTAT1(lensend),inext,2200+isend,
2646 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2647 c & iprev,2200+irecv,FG_COMM,status,IERR)
2648 c write (iout,*) "Gather ROTAT1"
2650 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2651 c & MPI_ROTAT2(lensend),inext,3300+isend,
2652 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2653 c & iprev,3300+irecv,FG_COMM,status,IERR)
2654 c write (iout,*) "Gather ROTAT2"
2656 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2657 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2658 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2659 & iprev,4400+irecv,FG_COMM,status,IERR)
2660 c write (iout,*) "Gather ROTAT_OLD"
2662 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2663 & MPI_PRECOMP11(lensend),inext,5500+isend,
2664 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2665 & iprev,5500+irecv,FG_COMM,status,IERR)
2666 c write (iout,*) "Gather PRECOMP11"
2668 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2669 & MPI_PRECOMP12(lensend),inext,6600+isend,
2670 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2671 & iprev,6600+irecv,FG_COMM,status,IERR)
2672 c write (iout,*) "Gather PRECOMP12"
2674 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2676 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2677 & MPI_ROTAT2(lensend),inext,7700+isend,
2678 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2679 & iprev,7700+irecv,FG_COMM,status,IERR)
2680 c write (iout,*) "Gather PRECOMP21"
2682 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2683 & MPI_PRECOMP22(lensend),inext,8800+isend,
2684 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2685 & iprev,8800+irecv,FG_COMM,status,IERR)
2686 c write (iout,*) "Gather PRECOMP22"
2688 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2689 & MPI_PRECOMP23(lensend),inext,9900+isend,
2690 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2691 & MPI_PRECOMP23(lenrecv),
2692 & iprev,9900+irecv,FG_COMM,status,IERR)
2693 c write (iout,*) "Gather PRECOMP23"
2698 if (irecv.lt.0) irecv=nfgtasks1-1
2701 time_gather=time_gather+MPI_Wtime()-time00
2704 c if (fg_rank.eq.0) then
2705 write (iout,*) "Arrays UG and UGDER"
2707 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2708 & ((ug(l,k,i),l=1,2),k=1,2),
2709 & ((ugder(l,k,i),l=1,2),k=1,2)
2711 write (iout,*) "Arrays UG2 and UG2DER"
2713 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2714 & ((ug2(l,k,i),l=1,2),k=1,2),
2715 & ((ug2der(l,k,i),l=1,2),k=1,2)
2717 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2719 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2720 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2721 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2723 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2725 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2726 & costab(i),sintab(i),costab2(i),sintab2(i)
2728 write (iout,*) "Array MUDER"
2730 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2736 cd iti = itortyp(itype(i))
2739 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2740 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2745 C--------------------------------------------------------------------------
2746 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2748 C This subroutine calculates the average interaction energy and its gradient
2749 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2750 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2751 C The potential depends both on the distance of peptide-group centers and on
2752 C the orientation of the CA-CA virtual bonds.
2754 implicit real*8 (a-h,o-z)
2758 include 'DIMENSIONS'
2759 include 'COMMON.CONTROL'
2760 include 'COMMON.SETUP'
2761 include 'COMMON.IOUNITS'
2762 include 'COMMON.GEO'
2763 include 'COMMON.VAR'
2764 include 'COMMON.LOCAL'
2765 include 'COMMON.CHAIN'
2766 include 'COMMON.DERIV'
2767 include 'COMMON.INTERACT'
2768 include 'COMMON.CONTACTS'
2769 include 'COMMON.TORSION'
2770 include 'COMMON.VECTORS'
2771 include 'COMMON.FFIELD'
2772 include 'COMMON.TIME1'
2773 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2774 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2775 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2776 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2777 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2778 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2780 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2782 double precision scal_el /1.0d0/
2784 double precision scal_el /0.5d0/
2787 C 13-go grudnia roku pamietnego...
2788 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2789 & 0.0d0,1.0d0,0.0d0,
2790 & 0.0d0,0.0d0,1.0d0/
2791 cd write(iout,*) 'In EELEC'
2793 cd write(iout,*) 'Type',i
2794 cd write(iout,*) 'B1',B1(:,i)
2795 cd write(iout,*) 'B2',B2(:,i)
2796 cd write(iout,*) 'CC',CC(:,:,i)
2797 cd write(iout,*) 'DD',DD(:,:,i)
2798 cd write(iout,*) 'EE',EE(:,:,i)
2800 cd call check_vecgrad
2802 if (icheckgrad.eq.1) then
2804 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2806 dc_norm(k,i)=dc(k,i)*fac
2808 c write (iout,*) 'i',i,' fac',fac
2811 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2812 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2813 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2814 c call vec_and_deriv
2820 time_mat=time_mat+MPI_Wtime()-time01
2824 cd write (iout,*) 'i=',i
2826 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2829 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2830 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2843 cd print '(a)','Enter EELEC'
2844 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2846 gel_loc_loc(i)=0.0d0
2851 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2853 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2855 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2856 do i=iturn3_start,iturn3_end
2857 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2858 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2862 dx_normi=dc_norm(1,i)
2863 dy_normi=dc_norm(2,i)
2864 dz_normi=dc_norm(3,i)
2865 xmedi=c(1,i)+0.5d0*dxi
2866 ymedi=c(2,i)+0.5d0*dyi
2867 zmedi=c(3,i)+0.5d0*dzi
2868 C Return atom into box, boxxsize is size of box in x dimension
2870 if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2871 if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2872 C Condition for being inside the proper box
2873 if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2874 & (xmedi.lt.((-0.5d0)*boxxsize))) then
2878 if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2879 if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2880 C Condition for being inside the proper box
2881 if ((ymedi.gt.((0.5d0)*boxysize)).or.
2882 & (ymedi.lt.((-0.5d0)*boxysize))) then
2886 if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxxsize
2887 if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxxsize
2888 C Condition for being inside the proper box
2889 if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2890 & (zmedi.lt.((-0.5d0)*boxzsize))) then
2894 call eelecij(i,i+2,ees,evdw1,eel_loc)
2895 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2896 num_cont_hb(i)=num_conti
2898 do i=iturn4_start,iturn4_end
2899 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2900 & .or. itype(i+3).eq.ntyp1
2901 & .or. itype(i+4).eq.ntyp1) cycle
2905 dx_normi=dc_norm(1,i)
2906 dy_normi=dc_norm(2,i)
2907 dz_normi=dc_norm(3,i)
2908 xmedi=c(1,i)+0.5d0*dxi
2909 ymedi=c(2,i)+0.5d0*dyi
2910 zmedi=c(3,i)+0.5d0*dzi
2911 C Return atom into box, boxxsize is size of box in x dimension
2913 if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2914 if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2915 C Condition for being inside the proper box
2916 if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2917 & (xmedi.lt.((-0.5d0)*boxxsize))) then
2921 if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2922 if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2923 C Condition for being inside the proper box
2924 if ((ymedi.gt.((0.5d0)*boxysize)).or.
2925 & (ymedi.lt.((-0.5d0)*boxysize))) then
2929 if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxxsize
2930 if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxxsize
2931 C Condition for being inside the proper box
2932 if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2933 & (zmedi.lt.((-0.5d0)*boxzsize))) then
2937 num_conti=num_cont_hb(i)
2938 call eelecij(i,i+3,ees,evdw1,eel_loc)
2939 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2940 & call eturn4(i,eello_turn4)
2941 num_cont_hb(i)=num_conti
2943 C Loop over all neighbouring boxes
2948 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2950 do i=iatel_s,iatel_e
2951 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2955 dx_normi=dc_norm(1,i)
2956 dy_normi=dc_norm(2,i)
2957 dz_normi=dc_norm(3,i)
2958 xmedi=c(1,i)+0.5d0*dxi
2959 ymedi=c(2,i)+0.5d0*dyi
2960 zmedi=c(3,i)+0.5d0*dzi
2961 C Return atom into box, boxxsize is size of box in x dimension
2963 if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2964 if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2965 C Condition for being inside the proper box
2966 if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
2967 & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
2971 if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
2972 if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2973 C Condition for being inside the proper box
2974 if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
2975 & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
2979 if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxxsize
2980 if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxxsize
2981 C Condition for being inside the proper box
2982 if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
2983 & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
2987 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2988 num_conti=num_cont_hb(i)
2989 do j=ielstart(i),ielend(i)
2990 c write (iout,*) i,j,itype(i),itype(j)
2991 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2992 call eelecij(i,j,ees,evdw1,eel_loc)
2994 num_cont_hb(i)=num_conti
3000 c write (iout,*) "Number of loop steps in EELEC:",ind
3002 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3003 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3005 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3006 ccc eel_loc=eel_loc+eello_turn3
3007 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3010 C-------------------------------------------------------------------------------
3011 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3012 implicit real*8 (a-h,o-z)
3013 include 'DIMENSIONS'
3017 include 'COMMON.CONTROL'
3018 include 'COMMON.IOUNITS'
3019 include 'COMMON.GEO'
3020 include 'COMMON.VAR'
3021 include 'COMMON.LOCAL'
3022 include 'COMMON.CHAIN'
3023 include 'COMMON.DERIV'
3024 include 'COMMON.INTERACT'
3025 include 'COMMON.CONTACTS'
3026 include 'COMMON.TORSION'
3027 include 'COMMON.VECTORS'
3028 include 'COMMON.FFIELD'
3029 include 'COMMON.TIME1'
3030 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3031 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3032 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3033 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3034 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3035 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3037 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3039 double precision scal_el /1.0d0/
3041 double precision scal_el /0.5d0/
3044 C 13-go grudnia roku pamietnego...
3045 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3046 & 0.0d0,1.0d0,0.0d0,
3047 & 0.0d0,0.0d0,1.0d0/
3048 c time00=MPI_Wtime()
3049 cd write (iout,*) "eelecij",i,j
3053 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3054 aaa=app(iteli,itelj)
3055 bbb=bpp(iteli,itelj)
3056 ael6i=ael6(iteli,itelj)
3057 ael3i=ael3(iteli,itelj)
3061 dx_normj=dc_norm(1,j)
3062 dy_normj=dc_norm(2,j)
3063 dz_normj=dc_norm(3,j)
3064 C xj=c(1,j)+0.5D0*dxj-xmedi
3065 C yj=c(2,j)+0.5D0*dyj-ymedi
3066 C zj=c(3,j)+0.5D0*dzj-zmedi
3070 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3072 if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3073 if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3074 C Condition for being inside the proper box
3075 if ((xj.gt.((0.5d0)*boxxsize)).or.
3076 & (xj.lt.((-0.5d0)*boxxsize))) then
3080 if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3081 if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3082 C Condition for being inside the proper box
3083 if ((yj.gt.((0.5d0)*boxysize)).or.
3084 & (yj.lt.((-0.5d0)*boxysize))) then
3088 if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxxsize
3089 if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxxsize
3090 C Condition for being inside the proper box
3091 if ((zj.gt.((0.5d0)*boxzsize)).or.
3092 & (zj.lt.((-0.5d0)*boxzsize))) then
3095 C endif !endPBC condintion
3099 rij=xj*xj+yj*yj+zj*zj
3105 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3106 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3107 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3108 fac=cosa-3.0D0*cosb*cosg
3110 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3111 if (j.eq.i+2) ev1=scal_el*ev1
3116 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3119 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3120 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3123 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3124 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3125 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3126 cd & xmedi,ymedi,zmedi,xj,yj,zj
3128 if (energy_dec) then
3129 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3131 &,iteli,itelj,aaa,evdw1
3132 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3136 C Calculate contributions to the Cartesian gradient.
3139 facvdw=-6*rrmij*(ev1+evdwij)
3140 facel=-3*rrmij*(el1+eesij)
3146 * Radial derivatives. First process both termini of the fragment (i,j)
3152 c ghalf=0.5D0*ggg(k)
3153 c gelc(k,i)=gelc(k,i)+ghalf
3154 c gelc(k,j)=gelc(k,j)+ghalf
3156 c 9/28/08 AL Gradient compotents will be summed only at the end
3158 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3159 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3162 * Loop over residues i+1 thru j-1.
3166 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3173 c ghalf=0.5D0*ggg(k)
3174 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3175 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3177 c 9/28/08 AL Gradient compotents will be summed only at the end
3179 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3180 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3183 * Loop over residues i+1 thru j-1.
3187 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3194 fac=-3*rrmij*(facvdw+facvdw+facel)
3199 * Radial derivatives. First process both termini of the fragment (i,j)
3205 c ghalf=0.5D0*ggg(k)
3206 c gelc(k,i)=gelc(k,i)+ghalf
3207 c gelc(k,j)=gelc(k,j)+ghalf
3209 c 9/28/08 AL Gradient compotents will be summed only at the end
3211 gelc_long(k,j)=gelc(k,j)+ggg(k)
3212 gelc_long(k,i)=gelc(k,i)-ggg(k)
3215 * Loop over residues i+1 thru j-1.
3219 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3222 c 9/28/08 AL Gradient compotents will be summed only at the end
3227 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3228 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3234 ecosa=2.0D0*fac3*fac1+fac4
3237 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3238 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3240 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3241 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3243 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3244 cd & (dcosg(k),k=1,3)
3246 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3249 c ghalf=0.5D0*ggg(k)
3250 c gelc(k,i)=gelc(k,i)+ghalf
3251 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3252 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3253 c gelc(k,j)=gelc(k,j)+ghalf
3254 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3255 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3259 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3264 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3265 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3267 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3268 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3269 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3270 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3272 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3273 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3274 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3276 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3277 C energy of a peptide unit is assumed in the form of a second-order
3278 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3279 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3280 C are computed for EVERY pair of non-contiguous peptide groups.
3282 if (j.lt.nres-1) then
3293 muij(kkk)=mu(k,i)*mu(l,j)
3296 cd write (iout,*) 'EELEC: i',i,' j',j
3297 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3298 cd write(iout,*) 'muij',muij
3299 ury=scalar(uy(1,i),erij)
3300 urz=scalar(uz(1,i),erij)
3301 vry=scalar(uy(1,j),erij)
3302 vrz=scalar(uz(1,j),erij)
3303 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3304 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3305 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3306 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3307 fac=dsqrt(-ael6i)*r3ij
3312 cd write (iout,'(4i5,4f10.5)')
3313 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3314 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3315 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3316 cd & uy(:,j),uz(:,j)
3317 cd write (iout,'(4f10.5)')
3318 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3319 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3320 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3321 cd write (iout,'(9f10.5/)')
3322 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3323 C Derivatives of the elements of A in virtual-bond vectors
3324 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3326 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3327 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3328 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3329 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3330 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3331 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3332 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3333 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3334 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3335 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3336 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3337 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3339 C Compute radial contributions to the gradient
3357 C Add the contributions coming from er
3360 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3361 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3362 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3363 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3366 C Derivatives in DC(i)
3367 cgrad ghalf1=0.5d0*agg(k,1)
3368 cgrad ghalf2=0.5d0*agg(k,2)
3369 cgrad ghalf3=0.5d0*agg(k,3)
3370 cgrad ghalf4=0.5d0*agg(k,4)
3371 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3372 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3373 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3374 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3375 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3376 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3377 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3378 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3379 C Derivatives in DC(i+1)
3380 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3381 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3382 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3383 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3384 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3385 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3386 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3387 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3388 C Derivatives in DC(j)
3389 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3390 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3391 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3392 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3393 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3394 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3395 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3396 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3397 C Derivatives in DC(j+1) or DC(nres-1)
3398 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3399 & -3.0d0*vryg(k,3)*ury)
3400 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3401 & -3.0d0*vrzg(k,3)*ury)
3402 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3403 & -3.0d0*vryg(k,3)*urz)
3404 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3405 & -3.0d0*vrzg(k,3)*urz)
3406 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3408 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3421 aggi(k,l)=-aggi(k,l)
3422 aggi1(k,l)=-aggi1(k,l)
3423 aggj(k,l)=-aggj(k,l)
3424 aggj1(k,l)=-aggj1(k,l)
3427 if (j.lt.nres-1) then
3433 aggi(k,l)=-aggi(k,l)
3434 aggi1(k,l)=-aggi1(k,l)
3435 aggj(k,l)=-aggj(k,l)
3436 aggj1(k,l)=-aggj1(k,l)
3447 aggi(k,l)=-aggi(k,l)
3448 aggi1(k,l)=-aggi1(k,l)
3449 aggj(k,l)=-aggj(k,l)
3450 aggj1(k,l)=-aggj1(k,l)
3455 IF (wel_loc.gt.0.0d0) THEN
3456 C Contribution to the local-electrostatic energy coming from the i-j pair
3457 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3459 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3461 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3462 & 'eelloc',i,j,eel_loc_ij
3463 if (eel_loc_ij.ne.0)
3464 & write (iout,'(a4,2i4,8f9.5)')'chuj',
3465 & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3467 eel_loc=eel_loc+eel_loc_ij
3468 C Partial derivatives in virtual-bond dihedral angles gamma
3470 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3471 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3472 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3473 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3474 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3475 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3476 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3478 ggg(l)=agg(l,1)*muij(1)+
3479 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3480 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3481 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3482 cgrad ghalf=0.5d0*ggg(l)
3483 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3484 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3488 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3491 C Remaining derivatives of eello
3493 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3494 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3495 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3496 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3497 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3498 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3499 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3500 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3503 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3504 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3505 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3506 & .and. num_conti.le.maxconts) then
3507 c write (iout,*) i,j," entered corr"
3509 C Calculate the contact function. The ith column of the array JCONT will
3510 C contain the numbers of atoms that make contacts with the atom I (of numbers
3511 C greater than I). The arrays FACONT and GACONT will contain the values of
3512 C the contact function and its derivative.
3513 c r0ij=1.02D0*rpp(iteli,itelj)
3514 c r0ij=1.11D0*rpp(iteli,itelj)
3515 r0ij=2.20D0*rpp(iteli,itelj)
3516 c r0ij=1.55D0*rpp(iteli,itelj)
3517 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3518 if (fcont.gt.0.0D0) then
3519 num_conti=num_conti+1
3520 if (num_conti.gt.maxconts) then
3521 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3522 & ' will skip next contacts for this conf.'
3524 jcont_hb(num_conti,i)=j
3525 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3526 cd & " jcont_hb",jcont_hb(num_conti,i)
3527 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3528 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3529 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3531 d_cont(num_conti,i)=rij
3532 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3533 C --- Electrostatic-interaction matrix ---
3534 a_chuj(1,1,num_conti,i)=a22
3535 a_chuj(1,2,num_conti,i)=a23
3536 a_chuj(2,1,num_conti,i)=a32
3537 a_chuj(2,2,num_conti,i)=a33
3538 C --- Gradient of rij
3540 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3547 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3548 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3549 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3550 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3551 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3556 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3557 C Calculate contact energies
3559 wij=cosa-3.0D0*cosb*cosg
3562 c fac3=dsqrt(-ael6i)/r0ij**3
3563 fac3=dsqrt(-ael6i)*r3ij
3564 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3565 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3566 if (ees0tmp.gt.0) then
3567 ees0pij=dsqrt(ees0tmp)
3571 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3572 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3573 if (ees0tmp.gt.0) then
3574 ees0mij=dsqrt(ees0tmp)
3579 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3580 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3581 C Diagnostics. Comment out or remove after debugging!
3582 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3583 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3584 c ees0m(num_conti,i)=0.0D0
3586 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3587 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3588 C Angular derivatives of the contact function
3589 ees0pij1=fac3/ees0pij
3590 ees0mij1=fac3/ees0mij
3591 fac3p=-3.0D0*fac3*rrmij
3592 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3593 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3595 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3596 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3597 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3598 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3599 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3600 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3601 ecosap=ecosa1+ecosa2
3602 ecosbp=ecosb1+ecosb2
3603 ecosgp=ecosg1+ecosg2
3604 ecosam=ecosa1-ecosa2
3605 ecosbm=ecosb1-ecosb2
3606 ecosgm=ecosg1-ecosg2
3615 facont_hb(num_conti,i)=fcont
3616 fprimcont=fprimcont/rij
3617 cd facont_hb(num_conti,i)=1.0D0
3618 C Following line is for diagnostics.
3621 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3622 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3625 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3626 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3628 gggp(1)=gggp(1)+ees0pijp*xj
3629 gggp(2)=gggp(2)+ees0pijp*yj
3630 gggp(3)=gggp(3)+ees0pijp*zj
3631 gggm(1)=gggm(1)+ees0mijp*xj
3632 gggm(2)=gggm(2)+ees0mijp*yj
3633 gggm(3)=gggm(3)+ees0mijp*zj
3634 C Derivatives due to the contact function
3635 gacont_hbr(1,num_conti,i)=fprimcont*xj
3636 gacont_hbr(2,num_conti,i)=fprimcont*yj
3637 gacont_hbr(3,num_conti,i)=fprimcont*zj
3640 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3641 c following the change of gradient-summation algorithm.
3643 cgrad ghalfp=0.5D0*gggp(k)
3644 cgrad ghalfm=0.5D0*gggm(k)
3645 gacontp_hb1(k,num_conti,i)=!ghalfp
3646 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3647 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3648 gacontp_hb2(k,num_conti,i)=!ghalfp
3649 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3650 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3651 gacontp_hb3(k,num_conti,i)=gggp(k)
3652 gacontm_hb1(k,num_conti,i)=!ghalfm
3653 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3654 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3655 gacontm_hb2(k,num_conti,i)=!ghalfm
3656 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3657 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3658 gacontm_hb3(k,num_conti,i)=gggm(k)
3660 C Diagnostics. Comment out or remove after debugging!
3662 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3663 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3664 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3665 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3666 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3667 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3670 endif ! num_conti.le.maxconts
3673 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3676 ghalf=0.5d0*agg(l,k)
3677 aggi(l,k)=aggi(l,k)+ghalf
3678 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3679 aggj(l,k)=aggj(l,k)+ghalf
3682 if (j.eq.nres-1 .and. i.lt.j-2) then
3685 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3690 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3693 C-----------------------------------------------------------------------------
3694 subroutine eturn3(i,eello_turn3)
3695 C Third- and fourth-order contributions from turns
3696 implicit real*8 (a-h,o-z)
3697 include 'DIMENSIONS'
3698 include 'COMMON.IOUNITS'
3699 include 'COMMON.GEO'
3700 include 'COMMON.VAR'
3701 include 'COMMON.LOCAL'
3702 include 'COMMON.CHAIN'
3703 include 'COMMON.DERIV'
3704 include 'COMMON.INTERACT'
3705 include 'COMMON.CONTACTS'
3706 include 'COMMON.TORSION'
3707 include 'COMMON.VECTORS'
3708 include 'COMMON.FFIELD'
3709 include 'COMMON.CONTROL'
3711 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3712 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3713 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3714 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3715 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3716 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3717 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3720 c write (iout,*) "eturn3",i,j,j1,j2
3725 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3727 C Third-order contributions
3734 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3735 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3736 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3737 call transpose2(auxmat(1,1),auxmat1(1,1))
3738 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3739 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3740 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3741 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3742 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3743 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3744 cd & ' eello_turn3_num',4*eello_turn3_num
3745 C Derivatives in gamma(i)
3746 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3747 call transpose2(auxmat2(1,1),auxmat3(1,1))
3748 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3749 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3750 C Derivatives in gamma(i+1)
3751 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3752 call transpose2(auxmat2(1,1),auxmat3(1,1))
3753 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3754 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3755 & +0.5d0*(pizda(1,1)+pizda(2,2))
3756 C Cartesian derivatives
3758 c ghalf1=0.5d0*agg(l,1)
3759 c ghalf2=0.5d0*agg(l,2)
3760 c ghalf3=0.5d0*agg(l,3)
3761 c ghalf4=0.5d0*agg(l,4)
3762 a_temp(1,1)=aggi(l,1)!+ghalf1
3763 a_temp(1,2)=aggi(l,2)!+ghalf2
3764 a_temp(2,1)=aggi(l,3)!+ghalf3
3765 a_temp(2,2)=aggi(l,4)!+ghalf4
3766 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3767 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3768 & +0.5d0*(pizda(1,1)+pizda(2,2))
3769 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3770 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3771 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3772 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3773 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3774 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3775 & +0.5d0*(pizda(1,1)+pizda(2,2))
3776 a_temp(1,1)=aggj(l,1)!+ghalf1
3777 a_temp(1,2)=aggj(l,2)!+ghalf2
3778 a_temp(2,1)=aggj(l,3)!+ghalf3
3779 a_temp(2,2)=aggj(l,4)!+ghalf4
3780 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3781 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3782 & +0.5d0*(pizda(1,1)+pizda(2,2))
3783 a_temp(1,1)=aggj1(l,1)
3784 a_temp(1,2)=aggj1(l,2)
3785 a_temp(2,1)=aggj1(l,3)
3786 a_temp(2,2)=aggj1(l,4)
3787 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3788 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3789 & +0.5d0*(pizda(1,1)+pizda(2,2))
3793 C-------------------------------------------------------------------------------
3794 subroutine eturn4(i,eello_turn4)
3795 C Third- and fourth-order contributions from turns
3796 implicit real*8 (a-h,o-z)
3797 include 'DIMENSIONS'
3798 include 'COMMON.IOUNITS'
3799 include 'COMMON.GEO'
3800 include 'COMMON.VAR'
3801 include 'COMMON.LOCAL'
3802 include 'COMMON.CHAIN'
3803 include 'COMMON.DERIV'
3804 include 'COMMON.INTERACT'
3805 include 'COMMON.CONTACTS'
3806 include 'COMMON.TORSION'
3807 include 'COMMON.VECTORS'
3808 include 'COMMON.FFIELD'
3809 include 'COMMON.CONTROL'
3811 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3812 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3813 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3814 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3815 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3816 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3817 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3820 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3822 C Fourth-order contributions
3830 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3831 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3832 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3837 iti1=itortyp(itype(i+1))
3838 iti2=itortyp(itype(i+2))
3839 iti3=itortyp(itype(i+3))
3840 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3841 call transpose2(EUg(1,1,i+1),e1t(1,1))
3842 call transpose2(Eug(1,1,i+2),e2t(1,1))
3843 call transpose2(Eug(1,1,i+3),e3t(1,1))
3844 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3845 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3846 s1=scalar2(b1(1,iti2),auxvec(1))
3847 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3848 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3849 s2=scalar2(b1(1,iti1),auxvec(1))
3850 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3851 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3852 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3853 eello_turn4=eello_turn4-(s1+s2+s3)
3854 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3855 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3856 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3857 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3858 cd & ' eello_turn4_num',8*eello_turn4_num
3859 C Derivatives in gamma(i)
3860 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3861 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3862 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3863 s1=scalar2(b1(1,iti2),auxvec(1))
3864 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3865 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3866 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3867 C Derivatives in gamma(i+1)
3868 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3869 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3870 s2=scalar2(b1(1,iti1),auxvec(1))
3871 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3872 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3873 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3874 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3875 C Derivatives in gamma(i+2)
3876 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3877 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3878 s1=scalar2(b1(1,iti2),auxvec(1))
3879 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3880 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3881 s2=scalar2(b1(1,iti1),auxvec(1))
3882 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3883 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3884 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3885 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3886 C Cartesian derivatives
3887 C Derivatives of this turn contributions in DC(i+2)
3888 if (j.lt.nres-1) then
3890 a_temp(1,1)=agg(l,1)
3891 a_temp(1,2)=agg(l,2)
3892 a_temp(2,1)=agg(l,3)
3893 a_temp(2,2)=agg(l,4)
3894 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3895 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3896 s1=scalar2(b1(1,iti2),auxvec(1))
3897 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3898 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3899 s2=scalar2(b1(1,iti1),auxvec(1))
3900 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3901 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3902 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3904 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3907 C Remaining derivatives of this turn contribution
3909 a_temp(1,1)=aggi(l,1)
3910 a_temp(1,2)=aggi(l,2)
3911 a_temp(2,1)=aggi(l,3)
3912 a_temp(2,2)=aggi(l,4)
3913 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3914 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3915 s1=scalar2(b1(1,iti2),auxvec(1))
3916 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3917 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3918 s2=scalar2(b1(1,iti1),auxvec(1))
3919 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3920 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3921 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3922 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3923 a_temp(1,1)=aggi1(l,1)
3924 a_temp(1,2)=aggi1(l,2)
3925 a_temp(2,1)=aggi1(l,3)
3926 a_temp(2,2)=aggi1(l,4)
3927 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3928 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3929 s1=scalar2(b1(1,iti2),auxvec(1))
3930 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3931 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3932 s2=scalar2(b1(1,iti1),auxvec(1))
3933 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3934 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3935 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3936 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3937 a_temp(1,1)=aggj(l,1)
3938 a_temp(1,2)=aggj(l,2)
3939 a_temp(2,1)=aggj(l,3)
3940 a_temp(2,2)=aggj(l,4)
3941 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3942 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3943 s1=scalar2(b1(1,iti2),auxvec(1))
3944 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3945 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3946 s2=scalar2(b1(1,iti1),auxvec(1))
3947 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3948 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3949 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3950 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3951 a_temp(1,1)=aggj1(l,1)
3952 a_temp(1,2)=aggj1(l,2)
3953 a_temp(2,1)=aggj1(l,3)
3954 a_temp(2,2)=aggj1(l,4)
3955 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3956 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3957 s1=scalar2(b1(1,iti2),auxvec(1))
3958 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3959 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3960 s2=scalar2(b1(1,iti1),auxvec(1))
3961 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3962 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3963 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3964 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3965 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3969 C-----------------------------------------------------------------------------
3970 subroutine vecpr(u,v,w)
3971 implicit real*8(a-h,o-z)
3972 dimension u(3),v(3),w(3)
3973 w(1)=u(2)*v(3)-u(3)*v(2)
3974 w(2)=-u(1)*v(3)+u(3)*v(1)
3975 w(3)=u(1)*v(2)-u(2)*v(1)
3978 C-----------------------------------------------------------------------------
3979 subroutine unormderiv(u,ugrad,unorm,ungrad)
3980 C This subroutine computes the derivatives of a normalized vector u, given
3981 C the derivatives computed without normalization conditions, ugrad. Returns
3984 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3985 double precision vec(3)
3986 double precision scalar
3988 c write (2,*) 'ugrad',ugrad
3991 vec(i)=scalar(ugrad(1,i),u(1))
3993 c write (2,*) 'vec',vec
3996 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3999 c write (2,*) 'ungrad',ungrad
4002 C-----------------------------------------------------------------------------
4003 subroutine escp_soft_sphere(evdw2,evdw2_14)
4005 C This subroutine calculates the excluded-volume interaction energy between
4006 C peptide-group centers and side chains and its gradient in virtual-bond and
4007 C side-chain vectors.
4009 implicit real*8 (a-h,o-z)
4010 include 'DIMENSIONS'
4011 include 'COMMON.GEO'
4012 include 'COMMON.VAR'
4013 include 'COMMON.LOCAL'
4014 include 'COMMON.CHAIN'
4015 include 'COMMON.DERIV'
4016 include 'COMMON.INTERACT'
4017 include 'COMMON.FFIELD'
4018 include 'COMMON.IOUNITS'
4019 include 'COMMON.CONTROL'
4024 cd print '(a)','Enter ESCP'
4025 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4029 do i=iatscp_s,iatscp_e
4030 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4032 xi=0.5D0*(c(1,i)+c(1,i+1))
4033 yi=0.5D0*(c(2,i)+c(2,i+1))
4034 zi=0.5D0*(c(3,i)+c(3,i+1))
4035 C Return atom into box, boxxsize is size of box in x dimension
4037 if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4038 if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4039 C Condition for being inside the proper box
4040 if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4041 & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4045 if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4046 if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4047 C Condition for being inside the proper box
4048 if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4049 & (yi.lt.((yshift-0.5d0)*boxysize))) then
4053 if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxxsize
4054 if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxxsize
4055 C Condition for being inside the proper box
4056 if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4057 & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4060 do iint=1,nscp_gr(i)
4062 do j=iscpstart(i,iint),iscpend(i,iint)
4063 if (itype(j).eq.ntyp1) cycle
4064 itypj=iabs(itype(j))
4065 C Uncomment following three lines for SC-p interactions
4069 C Uncomment following three lines for Ca-p interactions
4074 if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4075 if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4076 C Condition for being inside the proper box
4077 if ((xj.gt.((0.5d0)*boxxsize)).or.
4078 & (xj.lt.((-0.5d0)*boxxsize))) then
4082 if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4083 if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4084 C Condition for being inside the proper box
4085 if ((yj.gt.((0.5d0)*boxysize)).or.
4086 & (yj.lt.((-0.5d0)*boxysize))) then
4090 if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxxsize
4091 if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxxsize
4092 C Condition for being inside the proper box
4093 if ((zj.gt.((0.5d0)*boxzsize)).or.
4094 & (zj.lt.((-0.5d0)*boxzsize))) then
4100 rij=xj*xj+yj*yj+zj*zj
4103 if (rij.lt.r0ijsq) then
4104 evdwij=0.25d0*(rij-r0ijsq)**2
4112 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4117 cgrad if (j.lt.i) then
4118 cd write (iout,*) 'j<i'
4119 C Uncomment following three lines for SC-p interactions
4121 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4124 cd write (iout,*) 'j>i'
4126 cgrad ggg(k)=-ggg(k)
4127 C Uncomment following line for SC-p interactions
4128 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4132 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4134 cgrad kstart=min0(i+1,j)
4135 cgrad kend=max0(i-1,j-1)
4136 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4137 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4138 cgrad do k=kstart,kend
4140 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4144 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4145 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4156 C-----------------------------------------------------------------------------
4157 subroutine escp(evdw2,evdw2_14)
4159 C This subroutine calculates the excluded-volume interaction energy between
4160 C peptide-group centers and side chains and its gradient in virtual-bond and
4161 C side-chain vectors.
4163 implicit real*8 (a-h,o-z)
4164 include 'DIMENSIONS'
4165 include 'COMMON.GEO'
4166 include 'COMMON.VAR'
4167 include 'COMMON.LOCAL'
4168 include 'COMMON.CHAIN'
4169 include 'COMMON.DERIV'
4170 include 'COMMON.INTERACT'
4171 include 'COMMON.FFIELD'
4172 include 'COMMON.IOUNITS'
4173 include 'COMMON.CONTROL'
4177 cd print '(a)','Enter ESCP'
4178 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4182 do i=iatscp_s,iatscp_e
4183 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4185 xi=0.5D0*(c(1,i)+c(1,i+1))
4186 yi=0.5D0*(c(2,i)+c(2,i+1))
4187 zi=0.5D0*(c(3,i)+c(3,i+1))
4188 C Return atom into box, boxxsize is size of box in x dimension
4190 if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4191 if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4192 C Condition for being inside the proper box
4193 if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4194 & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4198 if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4199 if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4200 C Condition for being inside the proper box
4201 if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4202 & (yi.lt.((yshift-0.5d0)*boxysize))) then
4206 if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxxsize
4207 if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxxsize
4208 C Condition for being inside the proper box
4209 if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4210 & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4213 do iint=1,nscp_gr(i)
4215 do j=iscpstart(i,iint),iscpend(i,iint)
4216 itypj=iabs(itype(j))
4217 if (itypj.eq.ntyp1) cycle
4218 C Uncomment following three lines for SC-p interactions
4222 C Uncomment following three lines for Ca-p interactions
4227 if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4228 if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4229 C Condition for being inside the proper box
4230 if ((xj.gt.((0.5d0)*boxxsize)).or.
4231 & (xj.lt.((-0.5d0)*boxxsize))) then
4235 if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4236 if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4237 C Condition for being inside the proper box
4238 if ((yj.gt.((0.5d0)*boxysize)).or.
4239 & (yj.lt.((-0.5d0)*boxysize))) then
4243 if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxxsize
4244 if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxxsize
4245 C Condition for being inside the proper box
4246 if ((zj.gt.((0.5d0)*boxzsize)).or.
4247 & (zj.lt.((-0.5d0)*boxzsize))) then
4253 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4255 e1=fac*fac*aad(itypj,iteli)
4256 e2=fac*bad(itypj,iteli)
4257 if (iabs(j-i) .le. 2) then
4260 evdw2_14=evdw2_14+e1+e2
4264 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4265 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4268 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4270 fac=-(evdwij+e1)*rrij
4274 cgrad if (j.lt.i) then
4275 cd write (iout,*) 'j<i'
4276 C Uncomment following three lines for SC-p interactions
4278 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4281 cd write (iout,*) 'j>i'
4283 cgrad ggg(k)=-ggg(k)
4284 C Uncomment following line for SC-p interactions
4285 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4286 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4290 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4292 cgrad kstart=min0(i+1,j)
4293 cgrad kend=max0(i-1,j-1)
4294 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4295 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4296 cgrad do k=kstart,kend
4298 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4302 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4303 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4314 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4315 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4316 gradx_scp(j,i)=expon*gradx_scp(j,i)
4319 C******************************************************************************
4323 C To save time the factor EXPON has been extracted from ALL components
4324 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4327 C******************************************************************************
4330 C--------------------------------------------------------------------------
4331 subroutine edis(ehpb)
4333 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4335 implicit real*8 (a-h,o-z)
4336 include 'DIMENSIONS'
4337 include 'COMMON.SBRIDGE'
4338 include 'COMMON.CHAIN'
4339 include 'COMMON.DERIV'
4340 include 'COMMON.VAR'
4341 include 'COMMON.INTERACT'
4342 include 'COMMON.IOUNITS'
4345 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4346 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4347 if (link_end.eq.0) return
4348 do i=link_start,link_end
4349 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4350 C CA-CA distance used in regularization of structure.
4353 C iii and jjj point to the residues for which the distance is assigned.
4354 if (ii.gt.nres) then
4361 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4362 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4363 C distance and angle dependent SS bond potential.
4364 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4365 & iabs(itype(jjj)).eq.1) then
4366 call ssbond_ene(iii,jjj,eij)
4368 cd write (iout,*) "eij",eij
4370 C Calculate the distance between the two points and its difference from the
4374 C Get the force constant corresponding to this distance.
4376 C Calculate the contribution to energy.
4377 ehpb=ehpb+waga*rdis*rdis
4379 C Evaluate gradient.
4382 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4383 cd & ' waga=',waga,' fac=',fac
4385 ggg(j)=fac*(c(j,jj)-c(j,ii))
4387 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4388 C If this is a SC-SC distance, we need to calculate the contributions to the
4389 C Cartesian gradient in the SC vectors (ghpbx).
4392 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4393 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4396 cgrad do j=iii,jjj-1
4398 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4402 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4403 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4410 C--------------------------------------------------------------------------
4411 subroutine ssbond_ene(i,j,eij)
4413 C Calculate the distance and angle dependent SS-bond potential energy
4414 C using a free-energy function derived based on RHF/6-31G** ab initio
4415 C calculations of diethyl disulfide.
4417 C A. Liwo and U. Kozlowska, 11/24/03
4419 implicit real*8 (a-h,o-z)
4420 include 'DIMENSIONS'
4421 include 'COMMON.SBRIDGE'
4422 include 'COMMON.CHAIN'
4423 include 'COMMON.DERIV'
4424 include 'COMMON.LOCAL'
4425 include 'COMMON.INTERACT'
4426 include 'COMMON.VAR'
4427 include 'COMMON.IOUNITS'
4428 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4429 itypi=iabs(itype(i))
4433 dxi=dc_norm(1,nres+i)
4434 dyi=dc_norm(2,nres+i)
4435 dzi=dc_norm(3,nres+i)
4436 c dsci_inv=dsc_inv(itypi)
4437 dsci_inv=vbld_inv(nres+i)
4438 itypj=iabs(itype(j))
4439 c dscj_inv=dsc_inv(itypj)
4440 dscj_inv=vbld_inv(nres+j)
4444 dxj=dc_norm(1,nres+j)
4445 dyj=dc_norm(2,nres+j)
4446 dzj=dc_norm(3,nres+j)
4447 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4452 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4453 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4454 om12=dxi*dxj+dyi*dyj+dzi*dzj
4456 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4457 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4463 deltat12=om2-om1+2.0d0
4465 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4466 & +akct*deltad*deltat12
4467 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4468 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4469 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4470 c & " deltat12",deltat12," eij",eij
4471 ed=2*akcm*deltad+akct*deltat12
4473 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4474 eom1=-2*akth*deltat1-pom1-om2*pom2
4475 eom2= 2*akth*deltat2+pom1-om1*pom2
4478 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4479 ghpbx(k,i)=ghpbx(k,i)-ggk
4480 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4481 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4482 ghpbx(k,j)=ghpbx(k,j)+ggk
4483 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4484 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4485 ghpbc(k,i)=ghpbc(k,i)-ggk
4486 ghpbc(k,j)=ghpbc(k,j)+ggk
4489 C Calculate the components of the gradient in DC and X
4493 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4498 C--------------------------------------------------------------------------
4499 subroutine ebond(estr)
4501 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4503 implicit real*8 (a-h,o-z)
4504 include 'DIMENSIONS'
4505 include 'COMMON.LOCAL'
4506 include 'COMMON.GEO'
4507 include 'COMMON.INTERACT'
4508 include 'COMMON.DERIV'
4509 include 'COMMON.VAR'
4510 include 'COMMON.CHAIN'
4511 include 'COMMON.IOUNITS'
4512 include 'COMMON.NAMES'
4513 include 'COMMON.FFIELD'
4514 include 'COMMON.CONTROL'
4515 include 'COMMON.SETUP'
4516 double precision u(3),ud(3)
4519 do i=ibondp_start,ibondp_end
4520 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4521 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4523 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4524 c & *dc(j,i-1)/vbld(i)
4526 c if (energy_dec) write(iout,*)
4527 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4529 C Checking if it involves dummy (NH3+ or COO-) group
4530 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4531 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
4532 diff = vbld(i)-vbldpDUM
4534 C NO vbldp0 is the equlibrium lenght of spring for peptide group
4535 diff = vbld(i)-vbldp0
4537 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4538 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4541 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4543 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4546 estr=0.5d0*AKP*estr+estr1
4548 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4550 do i=ibond_start,ibond_end
4552 if (iti.ne.10 .and. iti.ne.ntyp1) then
4555 diff=vbld(i+nres)-vbldsc0(1,iti)
4556 if (energy_dec) write (iout,*)
4557 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4558 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4559 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4561 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4565 diff=vbld(i+nres)-vbldsc0(j,iti)
4566 ud(j)=aksc(j,iti)*diff
4567 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4581 uprod2=uprod2*u(k)*u(k)
4585 usumsqder=usumsqder+ud(j)*uprod2
4587 estr=estr+uprod/usum
4589 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4597 C--------------------------------------------------------------------------
4598 subroutine ebend(etheta)
4600 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4601 C angles gamma and its derivatives in consecutive thetas and gammas.
4603 implicit real*8 (a-h,o-z)
4604 include 'DIMENSIONS'
4605 include 'COMMON.LOCAL'
4606 include 'COMMON.GEO'
4607 include 'COMMON.INTERACT'
4608 include 'COMMON.DERIV'
4609 include 'COMMON.VAR'
4610 include 'COMMON.CHAIN'
4611 include 'COMMON.IOUNITS'
4612 include 'COMMON.NAMES'
4613 include 'COMMON.FFIELD'
4614 include 'COMMON.CONTROL'
4615 common /calcthet/ term1,term2,termm,diffak,ratak,
4616 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4617 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4618 double precision y(2),z(2)
4620 c time11=dexp(-2*time)
4623 c write (*,'(a,i2)') 'EBEND ICG=',icg
4624 do i=ithet_start,ithet_end
4625 if (itype(i-1).eq.ntyp1) cycle
4626 C Zero the energy function and its derivative at 0 or pi.
4627 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4629 ichir1=isign(1,itype(i-2))
4630 ichir2=isign(1,itype(i))
4631 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4632 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4633 if (itype(i-1).eq.10) then
4634 itype1=isign(10,itype(i-2))
4635 ichir11=isign(1,itype(i-2))
4636 ichir12=isign(1,itype(i-2))
4637 itype2=isign(10,itype(i))
4638 ichir21=isign(1,itype(i))
4639 ichir22=isign(1,itype(i))
4642 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4645 if (phii.ne.phii) phii=150.0
4655 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4658 if (phii1.ne.phii1) phii1=150.0
4670 C Calculate the "mean" value of theta from the part of the distribution
4671 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4672 C In following comments this theta will be referred to as t_c.
4673 thet_pred_mean=0.0d0
4675 athetk=athet(k,it,ichir1,ichir2)
4676 bthetk=bthet(k,it,ichir1,ichir2)
4678 athetk=athet(k,itype1,ichir11,ichir12)
4679 bthetk=bthet(k,itype2,ichir21,ichir22)
4681 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4682 c write(iout,*) 'chuj tu', y(k),z(k)
4684 dthett=thet_pred_mean*ssd
4685 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4686 C Derivatives of the "mean" values in gamma1 and gamma2.
4687 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4688 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4689 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4690 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4692 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4693 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4694 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4695 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4697 if (theta(i).gt.pi-delta) then
4698 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4700 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4701 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4702 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4704 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4706 else if (theta(i).lt.delta) then
4707 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4708 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4709 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4711 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4712 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4715 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4718 etheta=etheta+ethetai
4719 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4720 & 'ebend',i,ethetai,theta(i),itype(i)
4721 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4722 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4723 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4725 C Ufff.... We've done all this!!!
4728 C---------------------------------------------------------------------------
4729 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4731 implicit real*8 (a-h,o-z)
4732 include 'DIMENSIONS'
4733 include 'COMMON.LOCAL'
4734 include 'COMMON.IOUNITS'
4735 common /calcthet/ term1,term2,termm,diffak,ratak,
4736 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4737 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4738 C Calculate the contributions to both Gaussian lobes.
4739 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4740 C The "polynomial part" of the "standard deviation" of this part of
4741 C the distributioni.
4742 write (iout,*) thetai,thet_pred_mean
4745 sig=sig*thet_pred_mean+polthet(j,it)
4747 C Derivative of the "interior part" of the "standard deviation of the"
4748 C gamma-dependent Gaussian lobe in t_c.
4749 sigtc=3*polthet(3,it)
4751 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4754 C Set the parameters of both Gaussian lobes of the distribution.
4755 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4756 fac=sig*sig+sigc0(it)
4759 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4760 sigsqtc=-4.0D0*sigcsq*sigtc
4761 c print *,i,sig,sigtc,sigsqtc
4762 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4763 sigtc=-sigtc/(fac*fac)
4764 C Following variable is sigma(t_c)**(-2)
4765 sigcsq=sigcsq*sigcsq
4767 sig0inv=1.0D0/sig0i**2
4768 delthec=thetai-thet_pred_mean
4769 delthe0=thetai-theta0i
4770 term1=-0.5D0*sigcsq*delthec*delthec
4771 term2=-0.5D0*sig0inv*delthe0*delthe0
4772 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
4773 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4774 C NaNs in taking the logarithm. We extract the largest exponent which is added
4775 C to the energy (this being the log of the distribution) at the end of energy
4776 C term evaluation for this virtual-bond angle.
4777 if (term1.gt.term2) then
4779 term2=dexp(term2-termm)
4783 term1=dexp(term1-termm)
4786 C The ratio between the gamma-independent and gamma-dependent lobes of
4787 C the distribution is a Gaussian function of thet_pred_mean too.
4788 diffak=gthet(2,it)-thet_pred_mean
4789 ratak=diffak/gthet(3,it)**2
4790 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4791 C Let's differentiate it in thet_pred_mean NOW.
4793 C Now put together the distribution terms to make complete distribution.
4794 termexp=term1+ak*term2
4795 termpre=sigc+ak*sig0i
4796 C Contribution of the bending energy from this theta is just the -log of
4797 C the sum of the contributions from the two lobes and the pre-exponential
4798 C factor. Simple enough, isn't it?
4799 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4800 C write (iout,*) 'termexp',termexp,termm,termpre,i
4801 C NOW the derivatives!!!
4802 C 6/6/97 Take into account the deformation.
4803 E_theta=(delthec*sigcsq*term1
4804 & +ak*delthe0*sig0inv*term2)/termexp
4805 E_tc=((sigtc+aktc*sig0i)/termpre
4806 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4807 & aktc*term2)/termexp)
4810 c-----------------------------------------------------------------------------
4811 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4812 implicit real*8 (a-h,o-z)
4813 include 'DIMENSIONS'
4814 include 'COMMON.LOCAL'
4815 include 'COMMON.IOUNITS'
4816 common /calcthet/ term1,term2,termm,diffak,ratak,
4817 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4818 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4819 delthec=thetai-thet_pred_mean
4820 delthe0=thetai-theta0i
4821 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4822 t3 = thetai-thet_pred_mean
4826 t14 = t12+t6*sigsqtc
4828 t21 = thetai-theta0i
4834 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4835 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4836 & *(-t12*t9-ak*sig0inv*t27)
4840 C--------------------------------------------------------------------------
4841 subroutine ebend(etheta)
4843 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4844 C angles gamma and its derivatives in consecutive thetas and gammas.
4845 C ab initio-derived potentials from
4846 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4848 implicit real*8 (a-h,o-z)
4849 include 'DIMENSIONS'
4850 include 'COMMON.LOCAL'
4851 include 'COMMON.GEO'
4852 include 'COMMON.INTERACT'
4853 include 'COMMON.DERIV'
4854 include 'COMMON.VAR'
4855 include 'COMMON.CHAIN'
4856 include 'COMMON.IOUNITS'
4857 include 'COMMON.NAMES'
4858 include 'COMMON.FFIELD'
4859 include 'COMMON.CONTROL'
4860 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4861 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4862 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4863 & sinph1ph2(maxdouble,maxdouble)
4864 logical lprn /.false./, lprn1 /.false./
4866 do i=ithet_start,ithet_end
4867 if ((itype(i-1).eq.ntyp1)) cycle
4868 if (iabs(itype(i+1)).eq.20) iblock=2
4869 if (iabs(itype(i+1)).ne.20) iblock=1
4873 theti2=0.5d0*theta(i)
4874 ityp2=ithetyp((itype(i-1)))
4876 coskt(k)=dcos(k*theti2)
4877 sinkt(k)=dsin(k*theti2)
4879 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4882 if (phii.ne.phii) phii=150.0
4886 ityp1=ithetyp((itype(i-2)))
4887 C propagation of chirality for glycine type
4889 cosph1(k)=dcos(k*phii)
4890 sinph1(k)=dsin(k*phii)
4900 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4903 if (phii1.ne.phii1) phii1=150.0
4908 ityp3=ithetyp((itype(i)))
4910 cosph2(k)=dcos(k*phii1)
4911 sinph2(k)=dsin(k*phii1)
4921 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4924 ccl=cosph1(l)*cosph2(k-l)
4925 ssl=sinph1(l)*sinph2(k-l)
4926 scl=sinph1(l)*cosph2(k-l)
4927 csl=cosph1(l)*sinph2(k-l)
4928 cosph1ph2(l,k)=ccl-ssl
4929 cosph1ph2(k,l)=ccl+ssl
4930 sinph1ph2(l,k)=scl+csl
4931 sinph1ph2(k,l)=scl-csl
4935 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4936 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4937 write (iout,*) "coskt and sinkt"
4939 write (iout,*) k,coskt(k),sinkt(k)
4943 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4944 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4947 & write (iout,*) "k",k,"
4948 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4949 & " ethetai",ethetai
4952 write (iout,*) "cosph and sinph"
4954 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4956 write (iout,*) "cosph1ph2 and sinph2ph2"
4959 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4960 & sinph1ph2(l,k),sinph1ph2(k,l)
4963 write(iout,*) "ethetai",ethetai
4967 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4968 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4969 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4970 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4971 ethetai=ethetai+sinkt(m)*aux
4972 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4973 dephii=dephii+k*sinkt(m)*(
4974 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4975 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4976 dephii1=dephii1+k*sinkt(m)*(
4977 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4978 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4980 & write (iout,*) "m",m," k",k," bbthet",
4981 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4982 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4983 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4984 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4988 & write(iout,*) "ethetai",ethetai
4992 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4993 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4994 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4995 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4996 ethetai=ethetai+sinkt(m)*aux
4997 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4998 dephii=dephii+l*sinkt(m)*(
4999 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5000 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5001 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5002 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5003 dephii1=dephii1+(k-l)*sinkt(m)*(
5004 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5005 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5006 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5007 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5009 write (iout,*) "m",m," k",k," l",l," ffthet",
5010 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5011 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5012 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5013 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5014 & " ethetai",ethetai
5015 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5016 & cosph1ph2(k,l)*sinkt(m),
5017 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5025 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5026 & i,theta(i)*rad2deg,phii*rad2deg,
5027 & phii1*rad2deg,ethetai
5029 etheta=etheta+ethetai
5030 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5031 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5032 gloc(nphi+i-2,icg)=wang*dethetai
5038 c-----------------------------------------------------------------------------
5039 subroutine esc(escloc)
5040 C Calculate the local energy of a side chain and its derivatives in the
5041 C corresponding virtual-bond valence angles THETA and the spherical angles
5043 implicit real*8 (a-h,o-z)
5044 include 'DIMENSIONS'
5045 include 'COMMON.GEO'
5046 include 'COMMON.LOCAL'
5047 include 'COMMON.VAR'
5048 include 'COMMON.INTERACT'
5049 include 'COMMON.DERIV'
5050 include 'COMMON.CHAIN'
5051 include 'COMMON.IOUNITS'
5052 include 'COMMON.NAMES'
5053 include 'COMMON.FFIELD'
5054 include 'COMMON.CONTROL'
5055 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5056 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5057 common /sccalc/ time11,time12,time112,theti,it,nlobit
5060 c write (iout,'(a)') 'ESC'
5061 do i=loc_start,loc_end
5063 if (it.eq.ntyp1) cycle
5064 if (it.eq.10) goto 1
5065 nlobit=nlob(iabs(it))
5066 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5067 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5068 theti=theta(i+1)-pipol
5073 if (x(2).gt.pi-delta) then
5077 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5079 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5080 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5082 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5083 & ddersc0(1),dersc(1))
5084 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5085 & ddersc0(3),dersc(3))
5087 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5089 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5090 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5091 & dersc0(2),esclocbi,dersc02)
5092 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5094 call splinthet(x(2),0.5d0*delta,ss,ssd)
5099 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5101 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5102 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5104 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5106 c write (iout,*) escloci
5107 else if (x(2).lt.delta) then
5111 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5113 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5114 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5116 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5117 & ddersc0(1),dersc(1))
5118 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5119 & ddersc0(3),dersc(3))
5121 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5123 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5124 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5125 & dersc0(2),esclocbi,dersc02)
5126 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5131 call splinthet(x(2),0.5d0*delta,ss,ssd)
5133 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5135 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5136 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5138 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5139 c write (iout,*) escloci
5141 call enesc(x,escloci,dersc,ddummy,.false.)
5144 escloc=escloc+escloci
5145 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5146 & 'escloc',i,escloci
5147 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5149 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5151 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5152 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5157 C---------------------------------------------------------------------------
5158 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5159 implicit real*8 (a-h,o-z)
5160 include 'DIMENSIONS'
5161 include 'COMMON.GEO'
5162 include 'COMMON.LOCAL'
5163 include 'COMMON.IOUNITS'
5164 common /sccalc/ time11,time12,time112,theti,it,nlobit
5165 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5166 double precision contr(maxlob,-1:1)
5168 c write (iout,*) 'it=',it,' nlobit=',nlobit
5172 if (mixed) ddersc(j)=0.0d0
5176 C Because of periodicity of the dependence of the SC energy in omega we have
5177 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5178 C To avoid underflows, first compute & store the exponents.
5186 z(k)=x(k)-censc(k,j,it)
5191 Axk=Axk+gaussc(l,k,j,it)*z(l)
5197 expfac=expfac+Ax(k,j,iii)*z(k)
5205 C As in the case of ebend, we want to avoid underflows in exponentiation and
5206 C subsequent NaNs and INFs in energy calculation.
5207 C Find the largest exponent
5211 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5215 cd print *,'it=',it,' emin=',emin
5217 C Compute the contribution to SC energy and derivatives
5222 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5223 if(adexp.ne.adexp) adexp=1.0
5226 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5228 cd print *,'j=',j,' expfac=',expfac
5229 escloc_i=escloc_i+expfac
5231 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5235 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5236 & +gaussc(k,2,j,it))*expfac
5243 dersc(1)=dersc(1)/cos(theti)**2
5244 ddersc(1)=ddersc(1)/cos(theti)**2
5247 escloci=-(dlog(escloc_i)-emin)
5249 dersc(j)=dersc(j)/escloc_i
5253 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5258 C------------------------------------------------------------------------------
5259 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5260 implicit real*8 (a-h,o-z)
5261 include 'DIMENSIONS'
5262 include 'COMMON.GEO'
5263 include 'COMMON.LOCAL'
5264 include 'COMMON.IOUNITS'
5265 common /sccalc/ time11,time12,time112,theti,it,nlobit
5266 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5267 double precision contr(maxlob)
5278 z(k)=x(k)-censc(k,j,it)
5284 Axk=Axk+gaussc(l,k,j,it)*z(l)
5290 expfac=expfac+Ax(k,j)*z(k)
5295 C As in the case of ebend, we want to avoid underflows in exponentiation and
5296 C subsequent NaNs and INFs in energy calculation.
5297 C Find the largest exponent
5300 if (emin.gt.contr(j)) emin=contr(j)
5304 C Compute the contribution to SC energy and derivatives
5308 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5309 escloc_i=escloc_i+expfac
5311 dersc(k)=dersc(k)+Ax(k,j)*expfac
5313 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5314 & +gaussc(1,2,j,it))*expfac
5318 dersc(1)=dersc(1)/cos(theti)**2
5319 dersc12=dersc12/cos(theti)**2
5320 escloci=-(dlog(escloc_i)-emin)
5322 dersc(j)=dersc(j)/escloc_i
5324 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5328 c----------------------------------------------------------------------------------
5329 subroutine esc(escloc)
5330 C Calculate the local energy of a side chain and its derivatives in the
5331 C corresponding virtual-bond valence angles THETA and the spherical angles
5332 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5333 C added by Urszula Kozlowska. 07/11/2007
5335 implicit real*8 (a-h,o-z)
5336 include 'DIMENSIONS'
5337 include 'COMMON.GEO'
5338 include 'COMMON.LOCAL'
5339 include 'COMMON.VAR'
5340 include 'COMMON.SCROT'
5341 include 'COMMON.INTERACT'
5342 include 'COMMON.DERIV'
5343 include 'COMMON.CHAIN'
5344 include 'COMMON.IOUNITS'
5345 include 'COMMON.NAMES'
5346 include 'COMMON.FFIELD'
5347 include 'COMMON.CONTROL'
5348 include 'COMMON.VECTORS'
5349 double precision x_prime(3),y_prime(3),z_prime(3)
5350 & , sumene,dsc_i,dp2_i,x(65),
5351 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5352 & de_dxx,de_dyy,de_dzz,de_dt
5353 double precision s1_t,s1_6_t,s2_t,s2_6_t
5355 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5356 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5357 & dt_dCi(3),dt_dCi1(3)
5358 common /sccalc/ time11,time12,time112,theti,it,nlobit
5361 do i=loc_start,loc_end
5362 if (itype(i).eq.ntyp1) cycle
5363 costtab(i+1) =dcos(theta(i+1))
5364 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5365 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5366 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5367 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5368 cosfac=dsqrt(cosfac2)
5369 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5370 sinfac=dsqrt(sinfac2)
5372 if (it.eq.10) goto 1
5374 C Compute the axes of tghe local cartesian coordinates system; store in
5375 c x_prime, y_prime and z_prime
5382 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5383 C & dc_norm(3,i+nres)
5385 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5386 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5389 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5392 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5393 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5394 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5395 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5396 c & " xy",scalar(x_prime(1),y_prime(1)),
5397 c & " xz",scalar(x_prime(1),z_prime(1)),
5398 c & " yy",scalar(y_prime(1),y_prime(1)),
5399 c & " yz",scalar(y_prime(1),z_prime(1)),
5400 c & " zz",scalar(z_prime(1),z_prime(1))
5402 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5403 C to local coordinate system. Store in xx, yy, zz.
5409 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5410 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5411 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5418 C Compute the energy of the ith side cbain
5420 c write (2,*) "xx",xx," yy",yy," zz",zz
5423 x(j) = sc_parmin(j,it)
5426 Cc diagnostics - remove later
5428 yy1 = dsin(alph(2))*dcos(omeg(2))
5429 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5430 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5431 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5433 C," --- ", xx_w,yy_w,zz_w
5436 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5437 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5439 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5440 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5442 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5443 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5444 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5445 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5446 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5448 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5449 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5450 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5451 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5452 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5454 dsc_i = 0.743d0+x(61)
5456 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5457 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5458 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5459 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5460 s1=(1+x(63))/(0.1d0 + dscp1)
5461 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5462 s2=(1+x(65))/(0.1d0 + dscp2)
5463 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5464 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5465 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5466 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5468 c & dscp1,dscp2,sumene
5469 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5470 escloc = escloc + sumene
5471 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5476 C This section to check the numerical derivatives of the energy of ith side
5477 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5478 C #define DEBUG in the code to turn it on.
5480 write (2,*) "sumene =",sumene
5484 write (2,*) xx,yy,zz
5485 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5486 de_dxx_num=(sumenep-sumene)/aincr
5488 write (2,*) "xx+ sumene from enesc=",sumenep
5491 write (2,*) xx,yy,zz
5492 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5493 de_dyy_num=(sumenep-sumene)/aincr
5495 write (2,*) "yy+ sumene from enesc=",sumenep
5498 write (2,*) xx,yy,zz
5499 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5500 de_dzz_num=(sumenep-sumene)/aincr
5502 write (2,*) "zz+ sumene from enesc=",sumenep
5503 costsave=cost2tab(i+1)
5504 sintsave=sint2tab(i+1)
5505 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5506 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5507 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5508 de_dt_num=(sumenep-sumene)/aincr
5509 write (2,*) " t+ sumene from enesc=",sumenep
5510 cost2tab(i+1)=costsave
5511 sint2tab(i+1)=sintsave
5512 C End of diagnostics section.
5515 C Compute the gradient of esc
5517 c zz=zz*dsign(1.0,dfloat(itype(i)))
5518 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5519 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5520 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5521 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5522 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5523 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5524 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5525 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5526 pom1=(sumene3*sint2tab(i+1)+sumene1)
5527 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5528 pom2=(sumene4*cost2tab(i+1)+sumene2)
5529 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5530 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5531 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5532 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5534 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5535 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5536 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5538 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5539 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5540 & +(pom1+pom2)*pom_dx
5542 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5545 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5546 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5547 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5549 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5550 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5551 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5552 & +x(59)*zz**2 +x(60)*xx*zz
5553 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5554 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5555 & +(pom1-pom2)*pom_dy
5557 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5560 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5561 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5562 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5563 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5564 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5565 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5566 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5567 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5569 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5572 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5573 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5574 & +pom1*pom_dt1+pom2*pom_dt2
5576 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5581 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5582 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5583 cosfac2xx=cosfac2*xx
5584 sinfac2yy=sinfac2*yy
5586 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5588 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5590 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5591 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5592 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5593 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5594 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5595 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5596 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5597 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5598 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5599 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5603 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5604 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5605 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5606 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5609 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5610 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5611 dZZ_XYZ(k)=vbld_inv(i+nres)*
5612 & (z_prime(k)-zz*dC_norm(k,i+nres))
5614 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5615 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5619 dXX_Ctab(k,i)=dXX_Ci(k)
5620 dXX_C1tab(k,i)=dXX_Ci1(k)
5621 dYY_Ctab(k,i)=dYY_Ci(k)
5622 dYY_C1tab(k,i)=dYY_Ci1(k)
5623 dZZ_Ctab(k,i)=dZZ_Ci(k)
5624 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5625 dXX_XYZtab(k,i)=dXX_XYZ(k)
5626 dYY_XYZtab(k,i)=dYY_XYZ(k)
5627 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5631 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5632 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5633 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5634 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5635 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5637 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5638 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5639 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5640 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5641 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5642 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5643 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5644 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5646 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5647 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5649 C to check gradient call subroutine check_grad
5655 c------------------------------------------------------------------------------
5656 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5658 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5659 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5660 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5661 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5663 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5664 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5666 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5667 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5668 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5669 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5670 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5672 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5673 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5674 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5675 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5676 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5678 dsc_i = 0.743d0+x(61)
5680 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5681 & *(xx*cost2+yy*sint2))
5682 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5683 & *(xx*cost2-yy*sint2))
5684 s1=(1+x(63))/(0.1d0 + dscp1)
5685 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5686 s2=(1+x(65))/(0.1d0 + dscp2)
5687 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5688 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5689 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5694 c------------------------------------------------------------------------------
5695 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5697 C This procedure calculates two-body contact function g(rij) and its derivative:
5700 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5703 C where x=(rij-r0ij)/delta
5705 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5708 double precision rij,r0ij,eps0ij,fcont,fprimcont
5709 double precision x,x2,x4,delta
5713 if (x.lt.-1.0D0) then
5716 else if (x.le.1.0D0) then
5719 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5720 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5727 c------------------------------------------------------------------------------
5728 subroutine splinthet(theti,delta,ss,ssder)
5729 implicit real*8 (a-h,o-z)
5730 include 'DIMENSIONS'
5731 include 'COMMON.VAR'
5732 include 'COMMON.GEO'
5735 if (theti.gt.pipol) then
5736 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5738 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5743 c------------------------------------------------------------------------------
5744 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5746 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5747 double precision ksi,ksi2,ksi3,a1,a2,a3
5748 a1=fprim0*delta/(f1-f0)
5754 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5755 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5758 c------------------------------------------------------------------------------
5759 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5761 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5762 double precision ksi,ksi2,ksi3,a1,a2,a3
5767 a2=3*(f1x-f0x)-2*fprim0x*delta
5768 a3=fprim0x*delta-2*(f1x-f0x)
5769 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5772 C-----------------------------------------------------------------------------
5774 C-----------------------------------------------------------------------------
5775 subroutine etor(etors,edihcnstr)
5776 implicit real*8 (a-h,o-z)
5777 include 'DIMENSIONS'
5778 include 'COMMON.VAR'
5779 include 'COMMON.GEO'
5780 include 'COMMON.LOCAL'
5781 include 'COMMON.TORSION'
5782 include 'COMMON.INTERACT'
5783 include 'COMMON.DERIV'
5784 include 'COMMON.CHAIN'
5785 include 'COMMON.NAMES'
5786 include 'COMMON.IOUNITS'
5787 include 'COMMON.FFIELD'
5788 include 'COMMON.TORCNSTR'
5789 include 'COMMON.CONTROL'
5791 C Set lprn=.true. for debugging
5795 do i=iphi_start,iphi_end
5797 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5798 & .or. itype(i).eq.ntyp1) cycle
5799 itori=itortyp(itype(i-2))
5800 itori1=itortyp(itype(i-1))
5803 C Proline-Proline pair is a special case...
5804 if (itori.eq.3 .and. itori1.eq.3) then
5805 if (phii.gt.-dwapi3) then
5807 fac=1.0D0/(1.0D0-cosphi)
5808 etorsi=v1(1,3,3)*fac
5809 etorsi=etorsi+etorsi
5810 etors=etors+etorsi-v1(1,3,3)
5811 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5812 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5815 v1ij=v1(j+1,itori,itori1)
5816 v2ij=v2(j+1,itori,itori1)
5819 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5820 if (energy_dec) etors_ii=etors_ii+
5821 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5822 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5826 v1ij=v1(j,itori,itori1)
5827 v2ij=v2(j,itori,itori1)
5830 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5831 if (energy_dec) etors_ii=etors_ii+
5832 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5833 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5836 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5839 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5840 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5841 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5842 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5843 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5845 ! 6/20/98 - dihedral angle constraints
5848 itori=idih_constr(i)
5851 if (difi.gt.drange(i)) then
5853 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5854 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5855 else if (difi.lt.-drange(i)) then
5857 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5858 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5860 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5861 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5863 ! write (iout,*) 'edihcnstr',edihcnstr
5866 c------------------------------------------------------------------------------
5867 subroutine etor_d(etors_d)
5871 c----------------------------------------------------------------------------
5873 subroutine etor(etors,edihcnstr)
5874 implicit real*8 (a-h,o-z)
5875 include 'DIMENSIONS'
5876 include 'COMMON.VAR'
5877 include 'COMMON.GEO'
5878 include 'COMMON.LOCAL'
5879 include 'COMMON.TORSION'
5880 include 'COMMON.INTERACT'
5881 include 'COMMON.DERIV'
5882 include 'COMMON.CHAIN'
5883 include 'COMMON.NAMES'
5884 include 'COMMON.IOUNITS'
5885 include 'COMMON.FFIELD'
5886 include 'COMMON.TORCNSTR'
5887 include 'COMMON.CONTROL'
5889 C Set lprn=.true. for debugging
5893 do i=iphi_start,iphi_end
5894 C ANY TWO ARE DUMMY ATOMS in row CYCLE
5895 if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
5896 & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
5897 & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
5898 C For introducing the NH3+ and COO- group please check the etor_d for reference
5901 if (iabs(itype(i)).eq.20) then
5906 itori=itortyp(itype(i-2))
5907 itori1=itortyp(itype(i-1))
5910 C Regular cosine and sine terms
5911 do j=1,nterm(itori,itori1,iblock)
5912 v1ij=v1(j,itori,itori1,iblock)
5913 v2ij=v2(j,itori,itori1,iblock)
5916 etors=etors+v1ij*cosphi+v2ij*sinphi
5917 if (energy_dec) etors_ii=etors_ii+
5918 & v1ij*cosphi+v2ij*sinphi
5919 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5923 C E = SUM ----------------------------------- - v1
5924 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5926 cosphi=dcos(0.5d0*phii)
5927 sinphi=dsin(0.5d0*phii)
5928 do j=1,nlor(itori,itori1,iblock)
5929 vl1ij=vlor1(j,itori,itori1)
5930 vl2ij=vlor2(j,itori,itori1)
5931 vl3ij=vlor3(j,itori,itori1)
5932 pom=vl2ij*cosphi+vl3ij*sinphi
5933 pom1=1.0d0/(pom*pom+1.0d0)
5934 etors=etors+vl1ij*pom1
5935 if (energy_dec) etors_ii=etors_ii+
5938 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5940 C Subtract the constant term
5941 etors=etors-v0(itori,itori1,iblock)
5942 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5943 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5945 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5946 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5947 & (v1(j,itori,itori1,iblock),j=1,6),
5948 & (v2(j,itori,itori1,iblock),j=1,6)
5949 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5950 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5952 ! 6/20/98 - dihedral angle constraints
5954 c do i=1,ndih_constr
5955 do i=idihconstr_start,idihconstr_end
5956 itori=idih_constr(i)
5958 difi=pinorm(phii-phi0(i))
5959 if (difi.gt.drange(i)) then
5961 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5962 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5963 else if (difi.lt.-drange(i)) then
5965 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5966 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5970 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5971 cd & rad2deg*phi0(i), rad2deg*drange(i),
5972 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5974 cd write (iout,*) 'edihcnstr',edihcnstr
5977 c----------------------------------------------------------------------------
5978 subroutine etor_d(etors_d)
5979 C 6/23/01 Compute double torsional energy
5980 implicit real*8 (a-h,o-z)
5981 include 'DIMENSIONS'
5982 include 'COMMON.VAR'
5983 include 'COMMON.GEO'
5984 include 'COMMON.LOCAL'
5985 include 'COMMON.TORSION'
5986 include 'COMMON.INTERACT'
5987 include 'COMMON.DERIV'
5988 include 'COMMON.CHAIN'
5989 include 'COMMON.NAMES'
5990 include 'COMMON.IOUNITS'
5991 include 'COMMON.FFIELD'
5992 include 'COMMON.TORCNSTR'
5994 C Set lprn=.true. for debugging
5998 c write(iout,*) "a tu??"
5999 do i=iphid_start,iphid_end
6000 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6001 if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6002 & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6003 & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6004 & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6005 itori=itortyp(itype(i-2))
6006 itori1=itortyp(itype(i-1))
6007 itori2=itortyp(itype(i))
6013 if (iabs(itype(i+1)).eq.20) iblock=2
6014 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6015 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6016 C if (itype(i+1).eq.ntyp1) iblock=3
6017 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6018 C IS or IS NOT need for this
6019 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6020 C is (itype(i-3).eq.ntyp1) ntblock=2
6021 C ntblock is N-terminal blocking group
6023 C Regular cosine and sine terms
6024 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6025 C Example of changes for NH3+ blocking group
6026 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6027 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6028 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6029 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6030 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6031 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6032 cosphi1=dcos(j*phii)
6033 sinphi1=dsin(j*phii)
6034 cosphi2=dcos(j*phii1)
6035 sinphi2=dsin(j*phii1)
6036 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6037 & v2cij*cosphi2+v2sij*sinphi2
6038 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6039 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6041 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6043 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6044 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6045 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6046 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6047 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6048 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6049 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6050 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6051 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6052 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6053 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6054 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6055 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6056 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6059 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6060 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6065 c------------------------------------------------------------------------------
6066 subroutine eback_sc_corr(esccor)
6067 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6068 c conformational states; temporarily implemented as differences
6069 c between UNRES torsional potentials (dependent on three types of
6070 c residues) and the torsional potentials dependent on all 20 types
6071 c of residues computed from AM1 energy surfaces of terminally-blocked
6072 c amino-acid residues.
6073 implicit real*8 (a-h,o-z)
6074 include 'DIMENSIONS'
6075 include 'COMMON.VAR'
6076 include 'COMMON.GEO'
6077 include 'COMMON.LOCAL'
6078 include 'COMMON.TORSION'
6079 include 'COMMON.SCCOR'
6080 include 'COMMON.INTERACT'
6081 include 'COMMON.DERIV'
6082 include 'COMMON.CHAIN'
6083 include 'COMMON.NAMES'
6084 include 'COMMON.IOUNITS'
6085 include 'COMMON.FFIELD'
6086 include 'COMMON.CONTROL'
6088 C Set lprn=.true. for debugging
6091 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6093 do i=itau_start,itau_end
6094 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6096 isccori=isccortyp(itype(i-2))
6097 isccori1=isccortyp(itype(i-1))
6098 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6100 do intertyp=1,3 !intertyp
6101 cc Added 09 May 2012 (Adasko)
6102 cc Intertyp means interaction type of backbone mainchain correlation:
6103 c 1 = SC...Ca...Ca...Ca
6104 c 2 = Ca...Ca...Ca...SC
6105 c 3 = SC...Ca...Ca...SCi
6107 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6108 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6109 & (itype(i-1).eq.ntyp1)))
6110 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6111 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6112 & .or.(itype(i).eq.ntyp1)))
6113 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6114 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6115 & (itype(i-3).eq.ntyp1)))) cycle
6116 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6117 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6119 do j=1,nterm_sccor(isccori,isccori1)
6120 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6121 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6122 cosphi=dcos(j*tauangle(intertyp,i))
6123 sinphi=dsin(j*tauangle(intertyp,i))
6124 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6125 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6127 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6128 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6130 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6131 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6132 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6133 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6134 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6140 c----------------------------------------------------------------------------
6141 subroutine multibody(ecorr)
6142 C This subroutine calculates multi-body contributions to energy following
6143 C the idea of Skolnick et al. If side chains I and J make a contact and
6144 C at the same time side chains I+1 and J+1 make a contact, an extra
6145 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6146 implicit real*8 (a-h,o-z)
6147 include 'DIMENSIONS'
6148 include 'COMMON.IOUNITS'
6149 include 'COMMON.DERIV'
6150 include 'COMMON.INTERACT'
6151 include 'COMMON.CONTACTS'
6152 double precision gx(3),gx1(3)
6155 C Set lprn=.true. for debugging
6159 write (iout,'(a)') 'Contact function values:'
6161 write (iout,'(i2,20(1x,i2,f10.5))')
6162 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6177 num_conti=num_cont(i)
6178 num_conti1=num_cont(i1)
6183 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6184 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6185 cd & ' ishift=',ishift
6186 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6187 C The system gains extra energy.
6188 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6189 endif ! j1==j+-ishift
6198 c------------------------------------------------------------------------------
6199 double precision function esccorr(i,j,k,l,jj,kk)
6200 implicit real*8 (a-h,o-z)
6201 include 'DIMENSIONS'
6202 include 'COMMON.IOUNITS'
6203 include 'COMMON.DERIV'
6204 include 'COMMON.INTERACT'
6205 include 'COMMON.CONTACTS'
6206 double precision gx(3),gx1(3)
6211 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6212 C Calculate the multi-body contribution to energy.
6213 C Calculate multi-body contributions to the gradient.
6214 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6215 cd & k,l,(gacont(m,kk,k),m=1,3)
6217 gx(m) =ekl*gacont(m,jj,i)
6218 gx1(m)=eij*gacont(m,kk,k)
6219 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6220 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6221 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6222 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6226 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6231 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6237 c------------------------------------------------------------------------------
6238 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6239 C This subroutine calculates multi-body contributions to hydrogen-bonding
6240 implicit real*8 (a-h,o-z)
6241 include 'DIMENSIONS'
6242 include 'COMMON.IOUNITS'
6245 parameter (max_cont=maxconts)
6246 parameter (max_dim=26)
6247 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6248 double precision zapas(max_dim,maxconts,max_fg_procs),
6249 & zapas_recv(max_dim,maxconts,max_fg_procs)
6250 common /przechowalnia/ zapas
6251 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6252 & status_array(MPI_STATUS_SIZE,maxconts*2)
6254 include 'COMMON.SETUP'
6255 include 'COMMON.FFIELD'
6256 include 'COMMON.DERIV'
6257 include 'COMMON.INTERACT'
6258 include 'COMMON.CONTACTS'
6259 include 'COMMON.CONTROL'
6260 include 'COMMON.LOCAL'
6261 double precision gx(3),gx1(3),time00
6264 C Set lprn=.true. for debugging
6269 if (nfgtasks.le.1) goto 30
6271 write (iout,'(a)') 'Contact function values before RECEIVE:'
6273 write (iout,'(2i3,50(1x,i2,f5.2))')
6274 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6275 & j=1,num_cont_hb(i))
6279 do i=1,ntask_cont_from
6282 do i=1,ntask_cont_to
6285 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6287 C Make the list of contacts to send to send to other procesors
6288 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6290 do i=iturn3_start,iturn3_end
6291 c write (iout,*) "make contact list turn3",i," num_cont",
6293 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6295 do i=iturn4_start,iturn4_end
6296 c write (iout,*) "make contact list turn4",i," num_cont",
6298 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6302 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6304 do j=1,num_cont_hb(i)
6307 iproc=iint_sent_local(k,jjc,ii)
6308 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6309 if (iproc.gt.0) then
6310 ncont_sent(iproc)=ncont_sent(iproc)+1
6311 nn=ncont_sent(iproc)
6313 zapas(2,nn,iproc)=jjc
6314 zapas(3,nn,iproc)=facont_hb(j,i)
6315 zapas(4,nn,iproc)=ees0p(j,i)
6316 zapas(5,nn,iproc)=ees0m(j,i)
6317 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6318 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6319 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6320 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6321 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6322 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6323 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6324 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6325 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6326 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6327 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6328 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6329 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6330 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6331 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6332 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6333 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6334 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6335 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6336 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6337 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6344 & "Numbers of contacts to be sent to other processors",
6345 & (ncont_sent(i),i=1,ntask_cont_to)
6346 write (iout,*) "Contacts sent"
6347 do ii=1,ntask_cont_to
6349 iproc=itask_cont_to(ii)
6350 write (iout,*) nn," contacts to processor",iproc,
6351 & " of CONT_TO_COMM group"
6353 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6361 CorrelID1=nfgtasks+fg_rank+1
6363 C Receive the numbers of needed contacts from other processors
6364 do ii=1,ntask_cont_from
6365 iproc=itask_cont_from(ii)
6367 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6368 & FG_COMM,req(ireq),IERR)
6370 c write (iout,*) "IRECV ended"
6372 C Send the number of contacts needed by other processors
6373 do ii=1,ntask_cont_to
6374 iproc=itask_cont_to(ii)
6376 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6377 & FG_COMM,req(ireq),IERR)
6379 c write (iout,*) "ISEND ended"
6380 c write (iout,*) "number of requests (nn)",ireq
6383 & call MPI_Waitall(ireq,req,status_array,ierr)
6385 c & "Numbers of contacts to be received from other processors",
6386 c & (ncont_recv(i),i=1,ntask_cont_from)
6390 do ii=1,ntask_cont_from
6391 iproc=itask_cont_from(ii)
6393 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6394 c & " of CONT_TO_COMM group"
6398 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6399 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6400 c write (iout,*) "ireq,req",ireq,req(ireq)
6403 C Send the contacts to processors that need them
6404 do ii=1,ntask_cont_to
6405 iproc=itask_cont_to(ii)
6407 c write (iout,*) nn," contacts to processor",iproc,
6408 c & " of CONT_TO_COMM group"
6411 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6412 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6413 c write (iout,*) "ireq,req",ireq,req(ireq)
6415 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6419 c write (iout,*) "number of requests (contacts)",ireq
6420 c write (iout,*) "req",(req(i),i=1,4)
6423 & call MPI_Waitall(ireq,req,status_array,ierr)
6424 do iii=1,ntask_cont_from
6425 iproc=itask_cont_from(iii)
6428 write (iout,*) "Received",nn," contacts from processor",iproc,
6429 & " of CONT_FROM_COMM group"
6432 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6437 ii=zapas_recv(1,i,iii)
6438 c Flag the received contacts to prevent double-counting
6439 jj=-zapas_recv(2,i,iii)
6440 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6442 nnn=num_cont_hb(ii)+1
6445 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6446 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6447 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6448 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6449 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6450 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6451 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6452 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6453 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6454 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6455 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6456 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6457 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6458 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6459 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6460 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6461 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6462 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6463 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6464 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6465 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6466 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6467 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6468 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6473 write (iout,'(a)') 'Contact function values after receive:'
6475 write (iout,'(2i3,50(1x,i3,f5.2))')
6476 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6477 & j=1,num_cont_hb(i))
6484 write (iout,'(a)') 'Contact function values:'
6486 write (iout,'(2i3,50(1x,i3,f5.2))')
6487 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6488 & j=1,num_cont_hb(i))
6492 C Remove the loop below after debugging !!!
6499 C Calculate the local-electrostatic correlation terms
6500 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6502 num_conti=num_cont_hb(i)
6503 num_conti1=num_cont_hb(i+1)
6510 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6511 c & ' jj=',jj,' kk=',kk
6512 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6513 & .or. j.lt.0 .and. j1.gt.0) .and.
6514 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6515 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6516 C The system gains extra energy.
6517 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6518 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6519 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6521 else if (j1.eq.j) then
6522 C Contacts I-J and I-(J+1) occur simultaneously.
6523 C The system loses extra energy.
6524 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6529 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6530 c & ' jj=',jj,' kk=',kk
6532 C Contacts I-J and (I+1)-J occur simultaneously.
6533 C The system loses extra energy.
6534 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6541 c------------------------------------------------------------------------------
6542 subroutine add_hb_contact(ii,jj,itask)
6543 implicit real*8 (a-h,o-z)
6544 include "DIMENSIONS"
6545 include "COMMON.IOUNITS"
6548 parameter (max_cont=maxconts)
6549 parameter (max_dim=26)
6550 include "COMMON.CONTACTS"
6551 double precision zapas(max_dim,maxconts,max_fg_procs),
6552 & zapas_recv(max_dim,maxconts,max_fg_procs)
6553 common /przechowalnia/ zapas
6554 integer i,j,ii,jj,iproc,itask(4),nn
6555 c write (iout,*) "itask",itask
6558 if (iproc.gt.0) then
6559 do j=1,num_cont_hb(ii)
6561 c write (iout,*) "i",ii," j",jj," jjc",jjc
6563 ncont_sent(iproc)=ncont_sent(iproc)+1
6564 nn=ncont_sent(iproc)
6565 zapas(1,nn,iproc)=ii
6566 zapas(2,nn,iproc)=jjc
6567 zapas(3,nn,iproc)=facont_hb(j,ii)
6568 zapas(4,nn,iproc)=ees0p(j,ii)
6569 zapas(5,nn,iproc)=ees0m(j,ii)
6570 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6571 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6572 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6573 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6574 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6575 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6576 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6577 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6578 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6579 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6580 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6581 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6582 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6583 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6584 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6585 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6586 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6587 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6588 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6589 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6590 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6598 c------------------------------------------------------------------------------
6599 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6601 C This subroutine calculates multi-body contributions to hydrogen-bonding
6602 implicit real*8 (a-h,o-z)
6603 include 'DIMENSIONS'
6604 include 'COMMON.IOUNITS'
6607 parameter (max_cont=maxconts)
6608 parameter (max_dim=70)
6609 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6610 double precision zapas(max_dim,maxconts,max_fg_procs),
6611 & zapas_recv(max_dim,maxconts,max_fg_procs)
6612 common /przechowalnia/ zapas
6613 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6614 & status_array(MPI_STATUS_SIZE,maxconts*2)
6616 include 'COMMON.SETUP'
6617 include 'COMMON.FFIELD'
6618 include 'COMMON.DERIV'
6619 include 'COMMON.LOCAL'
6620 include 'COMMON.INTERACT'
6621 include 'COMMON.CONTACTS'
6622 include 'COMMON.CHAIN'
6623 include 'COMMON.CONTROL'
6624 double precision gx(3),gx1(3)
6625 integer num_cont_hb_old(maxres)
6627 double precision eello4,eello5,eelo6,eello_turn6
6628 external eello4,eello5,eello6,eello_turn6
6629 C Set lprn=.true. for debugging
6634 num_cont_hb_old(i)=num_cont_hb(i)
6638 if (nfgtasks.le.1) goto 30
6640 write (iout,'(a)') 'Contact function values before RECEIVE:'
6642 write (iout,'(2i3,50(1x,i2,f5.2))')
6643 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6644 & j=1,num_cont_hb(i))
6648 do i=1,ntask_cont_from
6651 do i=1,ntask_cont_to
6654 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6656 C Make the list of contacts to send to send to other procesors
6657 do i=iturn3_start,iturn3_end
6658 c write (iout,*) "make contact list turn3",i," num_cont",
6660 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6662 do i=iturn4_start,iturn4_end
6663 c write (iout,*) "make contact list turn4",i," num_cont",
6665 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6669 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6671 do j=1,num_cont_hb(i)
6674 iproc=iint_sent_local(k,jjc,ii)
6675 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6676 if (iproc.ne.0) then
6677 ncont_sent(iproc)=ncont_sent(iproc)+1
6678 nn=ncont_sent(iproc)
6680 zapas(2,nn,iproc)=jjc
6681 zapas(3,nn,iproc)=d_cont(j,i)
6685 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6690 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6698 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6709 & "Numbers of contacts to be sent to other processors",
6710 & (ncont_sent(i),i=1,ntask_cont_to)
6711 write (iout,*) "Contacts sent"
6712 do ii=1,ntask_cont_to
6714 iproc=itask_cont_to(ii)
6715 write (iout,*) nn," contacts to processor",iproc,
6716 & " of CONT_TO_COMM group"
6718 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6726 CorrelID1=nfgtasks+fg_rank+1
6728 C Receive the numbers of needed contacts from other processors
6729 do ii=1,ntask_cont_from
6730 iproc=itask_cont_from(ii)
6732 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6733 & FG_COMM,req(ireq),IERR)
6735 c write (iout,*) "IRECV ended"
6737 C Send the number of contacts needed by other processors
6738 do ii=1,ntask_cont_to
6739 iproc=itask_cont_to(ii)
6741 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6742 & FG_COMM,req(ireq),IERR)
6744 c write (iout,*) "ISEND ended"
6745 c write (iout,*) "number of requests (nn)",ireq
6748 & call MPI_Waitall(ireq,req,status_array,ierr)
6750 c & "Numbers of contacts to be received from other processors",
6751 c & (ncont_recv(i),i=1,ntask_cont_from)
6755 do ii=1,ntask_cont_from
6756 iproc=itask_cont_from(ii)
6758 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6759 c & " of CONT_TO_COMM group"
6763 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6764 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6765 c write (iout,*) "ireq,req",ireq,req(ireq)
6768 C Send the contacts to processors that need them
6769 do ii=1,ntask_cont_to
6770 iproc=itask_cont_to(ii)
6772 c write (iout,*) nn," contacts to processor",iproc,
6773 c & " of CONT_TO_COMM group"
6776 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6777 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6778 c write (iout,*) "ireq,req",ireq,req(ireq)
6780 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6784 c write (iout,*) "number of requests (contacts)",ireq
6785 c write (iout,*) "req",(req(i),i=1,4)
6788 & call MPI_Waitall(ireq,req,status_array,ierr)
6789 do iii=1,ntask_cont_from
6790 iproc=itask_cont_from(iii)
6793 write (iout,*) "Received",nn," contacts from processor",iproc,
6794 & " of CONT_FROM_COMM group"
6797 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6802 ii=zapas_recv(1,i,iii)
6803 c Flag the received contacts to prevent double-counting
6804 jj=-zapas_recv(2,i,iii)
6805 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6807 nnn=num_cont_hb(ii)+1
6810 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6814 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6819 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6827 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6836 write (iout,'(a)') 'Contact function values after receive:'
6838 write (iout,'(2i3,50(1x,i3,5f6.3))')
6839 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6840 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6847 write (iout,'(a)') 'Contact function values:'
6849 write (iout,'(2i3,50(1x,i2,5f6.3))')
6850 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6851 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6857 C Remove the loop below after debugging !!!
6864 C Calculate the dipole-dipole interaction energies
6865 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6866 do i=iatel_s,iatel_e+1
6867 num_conti=num_cont_hb(i)
6876 C Calculate the local-electrostatic correlation terms
6877 c write (iout,*) "gradcorr5 in eello5 before loop"
6879 c write (iout,'(i5,3f10.5)')
6880 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6882 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6883 c write (iout,*) "corr loop i",i
6885 num_conti=num_cont_hb(i)
6886 num_conti1=num_cont_hb(i+1)
6893 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6894 c & ' jj=',jj,' kk=',kk
6895 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6896 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6897 & .or. j.lt.0 .and. j1.gt.0) .and.
6898 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6899 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6900 C The system gains extra energy.
6902 sqd1=dsqrt(d_cont(jj,i))
6903 sqd2=dsqrt(d_cont(kk,i1))
6904 sred_geom = sqd1*sqd2
6905 IF (sred_geom.lt.cutoff_corr) THEN
6906 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6908 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6909 cd & ' jj=',jj,' kk=',kk
6910 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6911 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6913 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6914 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6917 cd write (iout,*) 'sred_geom=',sred_geom,
6918 cd & ' ekont=',ekont,' fprim=',fprimcont,
6919 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6920 cd write (iout,*) "g_contij",g_contij
6921 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6922 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6923 call calc_eello(i,jp,i+1,jp1,jj,kk)
6924 if (wcorr4.gt.0.0d0)
6925 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6926 if (energy_dec.and.wcorr4.gt.0.0d0)
6927 1 write (iout,'(a6,4i5,0pf7.3)')
6928 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6929 c write (iout,*) "gradcorr5 before eello5"
6931 c write (iout,'(i5,3f10.5)')
6932 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6934 if (wcorr5.gt.0.0d0)
6935 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6936 c write (iout,*) "gradcorr5 after eello5"
6938 c write (iout,'(i5,3f10.5)')
6939 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6941 if (energy_dec.and.wcorr5.gt.0.0d0)
6942 1 write (iout,'(a6,4i5,0pf7.3)')
6943 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6944 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6945 cd write(2,*)'ijkl',i,jp,i+1,jp1
6946 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6947 & .or. wturn6.eq.0.0d0))then
6948 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6949 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6950 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6951 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6952 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6953 cd & 'ecorr6=',ecorr6
6954 cd write (iout,'(4e15.5)') sred_geom,
6955 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6956 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6957 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6958 else if (wturn6.gt.0.0d0
6959 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6960 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6961 eturn6=eturn6+eello_turn6(i,jj,kk)
6962 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6963 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6964 cd write (2,*) 'multibody_eello:eturn6',eturn6
6973 num_cont_hb(i)=num_cont_hb_old(i)
6975 c write (iout,*) "gradcorr5 in eello5"
6977 c write (iout,'(i5,3f10.5)')
6978 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6982 c------------------------------------------------------------------------------
6983 subroutine add_hb_contact_eello(ii,jj,itask)
6984 implicit real*8 (a-h,o-z)
6985 include "DIMENSIONS"
6986 include "COMMON.IOUNITS"
6989 parameter (max_cont=maxconts)
6990 parameter (max_dim=70)
6991 include "COMMON.CONTACTS"
6992 double precision zapas(max_dim,maxconts,max_fg_procs),
6993 & zapas_recv(max_dim,maxconts,max_fg_procs)
6994 common /przechowalnia/ zapas
6995 integer i,j,ii,jj,iproc,itask(4),nn
6996 c write (iout,*) "itask",itask
6999 if (iproc.gt.0) then
7000 do j=1,num_cont_hb(ii)
7002 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7004 ncont_sent(iproc)=ncont_sent(iproc)+1
7005 nn=ncont_sent(iproc)
7006 zapas(1,nn,iproc)=ii
7007 zapas(2,nn,iproc)=jjc
7008 zapas(3,nn,iproc)=d_cont(j,ii)
7012 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7017 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7025 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7037 c------------------------------------------------------------------------------
7038 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7039 implicit real*8 (a-h,o-z)
7040 include 'DIMENSIONS'
7041 include 'COMMON.IOUNITS'
7042 include 'COMMON.DERIV'
7043 include 'COMMON.INTERACT'
7044 include 'COMMON.CONTACTS'
7045 double precision gx(3),gx1(3)
7055 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7056 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7057 C Following 4 lines for diagnostics.
7062 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7063 c & 'Contacts ',i,j,
7064 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7065 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7067 C Calculate the multi-body contribution to energy.
7068 c ecorr=ecorr+ekont*ees
7069 C Calculate multi-body contributions to the gradient.
7070 coeffpees0pij=coeffp*ees0pij
7071 coeffmees0mij=coeffm*ees0mij
7072 coeffpees0pkl=coeffp*ees0pkl
7073 coeffmees0mkl=coeffm*ees0mkl
7075 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7076 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7077 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7078 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7079 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7080 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7081 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7082 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7083 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7084 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7085 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7086 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7087 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7088 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7089 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7090 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7091 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7092 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7093 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7094 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7095 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7096 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7097 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7098 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7099 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7104 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7105 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7106 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7107 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7112 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7113 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7114 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7115 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7118 c write (iout,*) "ehbcorr",ekont*ees
7123 C---------------------------------------------------------------------------
7124 subroutine dipole(i,j,jj)
7125 implicit real*8 (a-h,o-z)
7126 include 'DIMENSIONS'
7127 include 'COMMON.IOUNITS'
7128 include 'COMMON.CHAIN'
7129 include 'COMMON.FFIELD'
7130 include 'COMMON.DERIV'
7131 include 'COMMON.INTERACT'
7132 include 'COMMON.CONTACTS'
7133 include 'COMMON.TORSION'
7134 include 'COMMON.VAR'
7135 include 'COMMON.GEO'
7136 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7138 iti1 = itortyp(itype(i+1))
7139 if (j.lt.nres-1) then
7140 itj1 = itortyp(itype(j+1))
7145 dipi(iii,1)=Ub2(iii,i)
7146 dipderi(iii)=Ub2der(iii,i)
7147 dipi(iii,2)=b1(iii,iti1)
7148 dipj(iii,1)=Ub2(iii,j)
7149 dipderj(iii)=Ub2der(iii,j)
7150 dipj(iii,2)=b1(iii,itj1)
7154 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7157 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7164 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7168 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7173 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7174 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7176 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7178 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7180 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7185 C---------------------------------------------------------------------------
7186 subroutine calc_eello(i,j,k,l,jj,kk)
7188 C This subroutine computes matrices and vectors needed to calculate
7189 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7191 implicit real*8 (a-h,o-z)
7192 include 'DIMENSIONS'
7193 include 'COMMON.IOUNITS'
7194 include 'COMMON.CHAIN'
7195 include 'COMMON.DERIV'
7196 include 'COMMON.INTERACT'
7197 include 'COMMON.CONTACTS'
7198 include 'COMMON.TORSION'
7199 include 'COMMON.VAR'
7200 include 'COMMON.GEO'
7201 include 'COMMON.FFIELD'
7202 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7203 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7206 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7207 cd & ' jj=',jj,' kk=',kk
7208 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7209 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7210 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7213 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7214 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7217 call transpose2(aa1(1,1),aa1t(1,1))
7218 call transpose2(aa2(1,1),aa2t(1,1))
7221 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7222 & aa1tder(1,1,lll,kkk))
7223 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7224 & aa2tder(1,1,lll,kkk))
7228 C parallel orientation of the two CA-CA-CA frames.
7230 iti=itortyp(itype(i))
7234 itk1=itortyp(itype(k+1))
7235 itj=itortyp(itype(j))
7236 if (l.lt.nres-1) then
7237 itl1=itortyp(itype(l+1))
7241 C A1 kernel(j+1) A2T
7243 cd write (iout,'(3f10.5,5x,3f10.5)')
7244 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7246 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7247 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7248 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7249 C Following matrices are needed only for 6-th order cumulants
7250 IF (wcorr6.gt.0.0d0) THEN
7251 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7252 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7253 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7254 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7255 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7256 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7257 & ADtEAderx(1,1,1,1,1,1))
7259 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7260 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7261 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7262 & ADtEA1derx(1,1,1,1,1,1))
7264 C End 6-th order cumulants
7267 cd write (2,*) 'In calc_eello6'
7269 cd write (2,*) 'iii=',iii
7271 cd write (2,*) 'kkk=',kkk
7273 cd write (2,'(3(2f10.5),5x)')
7274 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7279 call transpose2(EUgder(1,1,k),auxmat(1,1))
7280 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7281 call transpose2(EUg(1,1,k),auxmat(1,1))
7282 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7283 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7287 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7288 & EAEAderx(1,1,lll,kkk,iii,1))
7292 C A1T kernel(i+1) A2
7293 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7294 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7295 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7296 C Following matrices are needed only for 6-th order cumulants
7297 IF (wcorr6.gt.0.0d0) THEN
7298 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7299 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7300 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7301 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7302 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7303 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7304 & ADtEAderx(1,1,1,1,1,2))
7305 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7306 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7307 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7308 & ADtEA1derx(1,1,1,1,1,2))
7310 C End 6-th order cumulants
7311 call transpose2(EUgder(1,1,l),auxmat(1,1))
7312 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7313 call transpose2(EUg(1,1,l),auxmat(1,1))
7314 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7315 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7319 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7320 & EAEAderx(1,1,lll,kkk,iii,2))
7325 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7326 C They are needed only when the fifth- or the sixth-order cumulants are
7328 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7329 call transpose2(AEA(1,1,1),auxmat(1,1))
7330 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7331 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7332 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7333 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7334 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7335 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7336 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7337 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7338 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7339 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7340 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7341 call transpose2(AEA(1,1,2),auxmat(1,1))
7342 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7343 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7344 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7345 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7346 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7347 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7348 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7349 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7350 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7351 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7352 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7353 C Calculate the Cartesian derivatives of the vectors.
7357 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7358 call matvec2(auxmat(1,1),b1(1,iti),
7359 & AEAb1derx(1,lll,kkk,iii,1,1))
7360 call matvec2(auxmat(1,1),Ub2(1,i),
7361 & AEAb2derx(1,lll,kkk,iii,1,1))
7362 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7363 & AEAb1derx(1,lll,kkk,iii,2,1))
7364 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7365 & AEAb2derx(1,lll,kkk,iii,2,1))
7366 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7367 call matvec2(auxmat(1,1),b1(1,itj),
7368 & AEAb1derx(1,lll,kkk,iii,1,2))
7369 call matvec2(auxmat(1,1),Ub2(1,j),
7370 & AEAb2derx(1,lll,kkk,iii,1,2))
7371 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7372 & AEAb1derx(1,lll,kkk,iii,2,2))
7373 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7374 & AEAb2derx(1,lll,kkk,iii,2,2))
7381 C Antiparallel orientation of the two CA-CA-CA frames.
7383 iti=itortyp(itype(i))
7387 itk1=itortyp(itype(k+1))
7388 itl=itortyp(itype(l))
7389 itj=itortyp(itype(j))
7390 if (j.lt.nres-1) then
7391 itj1=itortyp(itype(j+1))
7395 C A2 kernel(j-1)T A1T
7396 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7397 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7398 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7399 C Following matrices are needed only for 6-th order cumulants
7400 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7401 & j.eq.i+4 .and. l.eq.i+3)) THEN
7402 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7403 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7404 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7405 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7406 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7407 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7408 & ADtEAderx(1,1,1,1,1,1))
7409 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7410 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7411 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7412 & ADtEA1derx(1,1,1,1,1,1))
7414 C End 6-th order cumulants
7415 call transpose2(EUgder(1,1,k),auxmat(1,1))
7416 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7417 call transpose2(EUg(1,1,k),auxmat(1,1))
7418 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7419 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7423 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7424 & EAEAderx(1,1,lll,kkk,iii,1))
7428 C A2T kernel(i+1)T A1
7429 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7430 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7431 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7432 C Following matrices are needed only for 6-th order cumulants
7433 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7434 & j.eq.i+4 .and. l.eq.i+3)) THEN
7435 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7436 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7437 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7438 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7439 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7440 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7441 & ADtEAderx(1,1,1,1,1,2))
7442 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7443 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7444 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7445 & ADtEA1derx(1,1,1,1,1,2))
7447 C End 6-th order cumulants
7448 call transpose2(EUgder(1,1,j),auxmat(1,1))
7449 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7450 call transpose2(EUg(1,1,j),auxmat(1,1))
7451 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7452 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7456 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7457 & EAEAderx(1,1,lll,kkk,iii,2))
7462 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7463 C They are needed only when the fifth- or the sixth-order cumulants are
7465 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7466 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7467 call transpose2(AEA(1,1,1),auxmat(1,1))
7468 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7469 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7470 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7471 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7472 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7473 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7474 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7475 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7476 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7477 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7478 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7479 call transpose2(AEA(1,1,2),auxmat(1,1))
7480 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7481 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7482 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7483 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7484 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7485 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7486 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7487 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7488 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7489 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7490 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7491 C Calculate the Cartesian derivatives of the vectors.
7495 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7496 call matvec2(auxmat(1,1),b1(1,iti),
7497 & AEAb1derx(1,lll,kkk,iii,1,1))
7498 call matvec2(auxmat(1,1),Ub2(1,i),
7499 & AEAb2derx(1,lll,kkk,iii,1,1))
7500 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7501 & AEAb1derx(1,lll,kkk,iii,2,1))
7502 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7503 & AEAb2derx(1,lll,kkk,iii,2,1))
7504 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7505 call matvec2(auxmat(1,1),b1(1,itl),
7506 & AEAb1derx(1,lll,kkk,iii,1,2))
7507 call matvec2(auxmat(1,1),Ub2(1,l),
7508 & AEAb2derx(1,lll,kkk,iii,1,2))
7509 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7510 & AEAb1derx(1,lll,kkk,iii,2,2))
7511 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7512 & AEAb2derx(1,lll,kkk,iii,2,2))
7521 C---------------------------------------------------------------------------
7522 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7523 & KK,KKderg,AKA,AKAderg,AKAderx)
7527 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7528 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7529 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7534 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7536 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7539 cd if (lprn) write (2,*) 'In kernel'
7541 cd if (lprn) write (2,*) 'kkk=',kkk
7543 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7544 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7546 cd write (2,*) 'lll=',lll
7547 cd write (2,*) 'iii=1'
7549 cd write (2,'(3(2f10.5),5x)')
7550 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7553 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7554 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7556 cd write (2,*) 'lll=',lll
7557 cd write (2,*) 'iii=2'
7559 cd write (2,'(3(2f10.5),5x)')
7560 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7567 C---------------------------------------------------------------------------
7568 double precision function eello4(i,j,k,l,jj,kk)
7569 implicit real*8 (a-h,o-z)
7570 include 'DIMENSIONS'
7571 include 'COMMON.IOUNITS'
7572 include 'COMMON.CHAIN'
7573 include 'COMMON.DERIV'
7574 include 'COMMON.INTERACT'
7575 include 'COMMON.CONTACTS'
7576 include 'COMMON.TORSION'
7577 include 'COMMON.VAR'
7578 include 'COMMON.GEO'
7579 double precision pizda(2,2),ggg1(3),ggg2(3)
7580 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7584 cd print *,'eello4:',i,j,k,l,jj,kk
7585 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7586 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7587 cold eij=facont_hb(jj,i)
7588 cold ekl=facont_hb(kk,k)
7590 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7591 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7592 gcorr_loc(k-1)=gcorr_loc(k-1)
7593 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7595 gcorr_loc(l-1)=gcorr_loc(l-1)
7596 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7598 gcorr_loc(j-1)=gcorr_loc(j-1)
7599 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7604 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7605 & -EAEAderx(2,2,lll,kkk,iii,1)
7606 cd derx(lll,kkk,iii)=0.0d0
7610 cd gcorr_loc(l-1)=0.0d0
7611 cd gcorr_loc(j-1)=0.0d0
7612 cd gcorr_loc(k-1)=0.0d0
7614 cd write (iout,*)'Contacts have occurred for peptide groups',
7615 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7616 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7617 if (j.lt.nres-1) then
7624 if (l.lt.nres-1) then
7632 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7633 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7634 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7635 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7636 cgrad ghalf=0.5d0*ggg1(ll)
7637 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7638 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7639 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7640 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7641 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7642 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7643 cgrad ghalf=0.5d0*ggg2(ll)
7644 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7645 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7646 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7647 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7648 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7649 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7653 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7658 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7663 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7668 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7672 cd write (2,*) iii,gcorr_loc(iii)
7675 cd write (2,*) 'ekont',ekont
7676 cd write (iout,*) 'eello4',ekont*eel4
7679 C---------------------------------------------------------------------------
7680 double precision function eello5(i,j,k,l,jj,kk)
7681 implicit real*8 (a-h,o-z)
7682 include 'DIMENSIONS'
7683 include 'COMMON.IOUNITS'
7684 include 'COMMON.CHAIN'
7685 include 'COMMON.DERIV'
7686 include 'COMMON.INTERACT'
7687 include 'COMMON.CONTACTS'
7688 include 'COMMON.TORSION'
7689 include 'COMMON.VAR'
7690 include 'COMMON.GEO'
7691 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7692 double precision ggg1(3),ggg2(3)
7693 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7698 C /l\ / \ \ / \ / \ / C
7699 C / \ / \ \ / \ / \ / C
7700 C j| o |l1 | o | o| o | | o |o C
7701 C \ |/k\| |/ \| / |/ \| |/ \| C
7702 C \i/ \ / \ / / \ / \ C
7704 C (I) (II) (III) (IV) C
7706 C eello5_1 eello5_2 eello5_3 eello5_4 C
7708 C Antiparallel chains C
7711 C /j\ / \ \ / \ / \ / C
7712 C / \ / \ \ / \ / \ / C
7713 C j1| o |l | o | o| o | | o |o C
7714 C \ |/k\| |/ \| / |/ \| |/ \| C
7715 C \i/ \ / \ / / \ / \ C
7717 C (I) (II) (III) (IV) C
7719 C eello5_1 eello5_2 eello5_3 eello5_4 C
7721 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7723 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7724 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7729 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7731 itk=itortyp(itype(k))
7732 itl=itortyp(itype(l))
7733 itj=itortyp(itype(j))
7738 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7739 cd & eel5_3_num,eel5_4_num)
7743 derx(lll,kkk,iii)=0.0d0
7747 cd eij=facont_hb(jj,i)
7748 cd ekl=facont_hb(kk,k)
7750 cd write (iout,*)'Contacts have occurred for peptide groups',
7751 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7753 C Contribution from the graph I.
7754 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7755 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7756 call transpose2(EUg(1,1,k),auxmat(1,1))
7757 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7758 vv(1)=pizda(1,1)-pizda(2,2)
7759 vv(2)=pizda(1,2)+pizda(2,1)
7760 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7761 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7762 C Explicit gradient in virtual-dihedral angles.
7763 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7764 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7765 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7766 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7767 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7768 vv(1)=pizda(1,1)-pizda(2,2)
7769 vv(2)=pizda(1,2)+pizda(2,1)
7770 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7771 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7772 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7773 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7774 vv(1)=pizda(1,1)-pizda(2,2)
7775 vv(2)=pizda(1,2)+pizda(2,1)
7777 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7778 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7779 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7781 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7782 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7783 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7785 C Cartesian gradient
7789 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7791 vv(1)=pizda(1,1)-pizda(2,2)
7792 vv(2)=pizda(1,2)+pizda(2,1)
7793 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7794 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7795 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7801 C Contribution from graph II
7802 call transpose2(EE(1,1,itk),auxmat(1,1))
7803 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7804 vv(1)=pizda(1,1)+pizda(2,2)
7805 vv(2)=pizda(2,1)-pizda(1,2)
7806 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7807 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7808 C Explicit gradient in virtual-dihedral angles.
7809 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7810 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7811 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7812 vv(1)=pizda(1,1)+pizda(2,2)
7813 vv(2)=pizda(2,1)-pizda(1,2)
7815 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7816 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7817 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7819 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7820 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7821 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7823 C Cartesian gradient
7827 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7829 vv(1)=pizda(1,1)+pizda(2,2)
7830 vv(2)=pizda(2,1)-pizda(1,2)
7831 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7832 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7833 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7841 C Parallel orientation
7842 C Contribution from graph III
7843 call transpose2(EUg(1,1,l),auxmat(1,1))
7844 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7845 vv(1)=pizda(1,1)-pizda(2,2)
7846 vv(2)=pizda(1,2)+pizda(2,1)
7847 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7848 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7849 C Explicit gradient in virtual-dihedral angles.
7850 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7851 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7852 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7853 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7854 vv(1)=pizda(1,1)-pizda(2,2)
7855 vv(2)=pizda(1,2)+pizda(2,1)
7856 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7857 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7858 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7859 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7860 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7861 vv(1)=pizda(1,1)-pizda(2,2)
7862 vv(2)=pizda(1,2)+pizda(2,1)
7863 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7864 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7865 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7866 C Cartesian gradient
7870 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7872 vv(1)=pizda(1,1)-pizda(2,2)
7873 vv(2)=pizda(1,2)+pizda(2,1)
7874 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7875 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7876 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7881 C Contribution from graph IV
7883 call transpose2(EE(1,1,itl),auxmat(1,1))
7884 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7885 vv(1)=pizda(1,1)+pizda(2,2)
7886 vv(2)=pizda(2,1)-pizda(1,2)
7887 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7888 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7889 C Explicit gradient in virtual-dihedral angles.
7890 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7891 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7892 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7893 vv(1)=pizda(1,1)+pizda(2,2)
7894 vv(2)=pizda(2,1)-pizda(1,2)
7895 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7896 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7897 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7898 C Cartesian gradient
7902 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7904 vv(1)=pizda(1,1)+pizda(2,2)
7905 vv(2)=pizda(2,1)-pizda(1,2)
7906 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7907 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7908 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7913 C Antiparallel orientation
7914 C Contribution from graph III
7916 call transpose2(EUg(1,1,j),auxmat(1,1))
7917 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7918 vv(1)=pizda(1,1)-pizda(2,2)
7919 vv(2)=pizda(1,2)+pizda(2,1)
7920 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7921 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7922 C Explicit gradient in virtual-dihedral angles.
7923 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7924 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7925 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7926 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7927 vv(1)=pizda(1,1)-pizda(2,2)
7928 vv(2)=pizda(1,2)+pizda(2,1)
7929 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7930 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7931 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7932 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7933 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7934 vv(1)=pizda(1,1)-pizda(2,2)
7935 vv(2)=pizda(1,2)+pizda(2,1)
7936 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7937 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7938 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7939 C Cartesian gradient
7943 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7945 vv(1)=pizda(1,1)-pizda(2,2)
7946 vv(2)=pizda(1,2)+pizda(2,1)
7947 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7948 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7949 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7954 C Contribution from graph IV
7956 call transpose2(EE(1,1,itj),auxmat(1,1))
7957 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7958 vv(1)=pizda(1,1)+pizda(2,2)
7959 vv(2)=pizda(2,1)-pizda(1,2)
7960 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7961 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7962 C Explicit gradient in virtual-dihedral angles.
7963 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7964 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7965 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7966 vv(1)=pizda(1,1)+pizda(2,2)
7967 vv(2)=pizda(2,1)-pizda(1,2)
7968 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7969 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7970 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7971 C Cartesian gradient
7975 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7977 vv(1)=pizda(1,1)+pizda(2,2)
7978 vv(2)=pizda(2,1)-pizda(1,2)
7979 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7980 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7981 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7987 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7988 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7989 cd write (2,*) 'ijkl',i,j,k,l
7990 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7991 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7993 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7994 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7995 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7996 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7997 if (j.lt.nres-1) then
8004 if (l.lt.nres-1) then
8014 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8015 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8016 C summed up outside the subrouine as for the other subroutines
8017 C handling long-range interactions. The old code is commented out
8018 C with "cgrad" to keep track of changes.
8020 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8021 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8022 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8023 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8024 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8025 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8026 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8027 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8028 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8029 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8031 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8032 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8033 cgrad ghalf=0.5d0*ggg1(ll)
8035 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8036 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8037 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8038 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8039 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8040 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8041 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8042 cgrad ghalf=0.5d0*ggg2(ll)
8044 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8045 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8046 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8047 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8048 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8049 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8054 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8055 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8060 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8061 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8067 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8072 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8076 cd write (2,*) iii,g_corr5_loc(iii)
8079 cd write (2,*) 'ekont',ekont
8080 cd write (iout,*) 'eello5',ekont*eel5
8083 c--------------------------------------------------------------------------
8084 double precision function eello6(i,j,k,l,jj,kk)
8085 implicit real*8 (a-h,o-z)
8086 include 'DIMENSIONS'
8087 include 'COMMON.IOUNITS'
8088 include 'COMMON.CHAIN'
8089 include 'COMMON.DERIV'
8090 include 'COMMON.INTERACT'
8091 include 'COMMON.CONTACTS'
8092 include 'COMMON.TORSION'
8093 include 'COMMON.VAR'
8094 include 'COMMON.GEO'
8095 include 'COMMON.FFIELD'
8096 double precision ggg1(3),ggg2(3)
8097 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8102 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8110 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8111 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8115 derx(lll,kkk,iii)=0.0d0
8119 cd eij=facont_hb(jj,i)
8120 cd ekl=facont_hb(kk,k)
8126 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8127 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8128 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8129 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8130 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8131 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8133 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8134 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8135 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8136 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8137 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8138 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8142 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8144 C If turn contributions are considered, they will be handled separately.
8145 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8146 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8147 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8148 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8149 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8150 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8151 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8153 if (j.lt.nres-1) then
8160 if (l.lt.nres-1) then
8168 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8169 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8170 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8171 cgrad ghalf=0.5d0*ggg1(ll)
8173 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8174 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8175 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8176 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8177 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8178 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8179 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8180 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8181 cgrad ghalf=0.5d0*ggg2(ll)
8182 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8184 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8185 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8186 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8187 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8188 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8189 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8194 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8195 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8200 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8201 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8207 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8212 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8216 cd write (2,*) iii,g_corr6_loc(iii)
8219 cd write (2,*) 'ekont',ekont
8220 cd write (iout,*) 'eello6',ekont*eel6
8223 c--------------------------------------------------------------------------
8224 double precision function eello6_graph1(i,j,k,l,imat,swap)
8225 implicit real*8 (a-h,o-z)
8226 include 'DIMENSIONS'
8227 include 'COMMON.IOUNITS'
8228 include 'COMMON.CHAIN'
8229 include 'COMMON.DERIV'
8230 include 'COMMON.INTERACT'
8231 include 'COMMON.CONTACTS'
8232 include 'COMMON.TORSION'
8233 include 'COMMON.VAR'
8234 include 'COMMON.GEO'
8235 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8239 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8241 C Parallel Antiparallel C
8247 C \ j|/k\| / \ |/k\|l / C
8252 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8253 itk=itortyp(itype(k))
8254 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8255 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8256 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8257 call transpose2(EUgC(1,1,k),auxmat(1,1))
8258 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8259 vv1(1)=pizda1(1,1)-pizda1(2,2)
8260 vv1(2)=pizda1(1,2)+pizda1(2,1)
8261 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8262 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8263 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8264 s5=scalar2(vv(1),Dtobr2(1,i))
8265 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8266 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8267 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8268 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8269 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8270 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8271 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8272 & +scalar2(vv(1),Dtobr2der(1,i)))
8273 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8274 vv1(1)=pizda1(1,1)-pizda1(2,2)
8275 vv1(2)=pizda1(1,2)+pizda1(2,1)
8276 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8277 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8279 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8280 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8281 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8282 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8283 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8285 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8286 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8287 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8288 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8289 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8291 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8292 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8293 vv1(1)=pizda1(1,1)-pizda1(2,2)
8294 vv1(2)=pizda1(1,2)+pizda1(2,1)
8295 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8296 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8297 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8298 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8307 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8308 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8309 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8310 call transpose2(EUgC(1,1,k),auxmat(1,1))
8311 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8313 vv1(1)=pizda1(1,1)-pizda1(2,2)
8314 vv1(2)=pizda1(1,2)+pizda1(2,1)
8315 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8316 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8317 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8318 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8319 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8320 s5=scalar2(vv(1),Dtobr2(1,i))
8321 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8327 c----------------------------------------------------------------------------
8328 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8329 implicit real*8 (a-h,o-z)
8330 include 'DIMENSIONS'
8331 include 'COMMON.IOUNITS'
8332 include 'COMMON.CHAIN'
8333 include 'COMMON.DERIV'
8334 include 'COMMON.INTERACT'
8335 include 'COMMON.CONTACTS'
8336 include 'COMMON.TORSION'
8337 include 'COMMON.VAR'
8338 include 'COMMON.GEO'
8340 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8341 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8344 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8346 C Parallel Antiparallel C
8352 C \ j|/k\| \ |/k\|l C
8357 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8358 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8359 C AL 7/4/01 s1 would occur in the sixth-order moment,
8360 C but not in a cluster cumulant
8362 s1=dip(1,jj,i)*dip(1,kk,k)
8364 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8365 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8366 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8367 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8368 call transpose2(EUg(1,1,k),auxmat(1,1))
8369 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8370 vv(1)=pizda(1,1)-pizda(2,2)
8371 vv(2)=pizda(1,2)+pizda(2,1)
8372 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8373 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8375 eello6_graph2=-(s1+s2+s3+s4)
8377 eello6_graph2=-(s2+s3+s4)
8380 C Derivatives in gamma(i-1)
8383 s1=dipderg(1,jj,i)*dip(1,kk,k)
8385 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8386 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8387 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8388 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8390 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8392 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8394 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8396 C Derivatives in gamma(k-1)
8398 s1=dip(1,jj,i)*dipderg(1,kk,k)
8400 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8401 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8402 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8403 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8404 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8405 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8406 vv(1)=pizda(1,1)-pizda(2,2)
8407 vv(2)=pizda(1,2)+pizda(2,1)
8408 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8410 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8412 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8414 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8415 C Derivatives in gamma(j-1) or gamma(l-1)
8418 s1=dipderg(3,jj,i)*dip(1,kk,k)
8420 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8421 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8422 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8423 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8424 vv(1)=pizda(1,1)-pizda(2,2)
8425 vv(2)=pizda(1,2)+pizda(2,1)
8426 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8429 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8431 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8434 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8435 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8437 C Derivatives in gamma(l-1) or gamma(j-1)
8440 s1=dip(1,jj,i)*dipderg(3,kk,k)
8442 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8443 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8444 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8445 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8446 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8447 vv(1)=pizda(1,1)-pizda(2,2)
8448 vv(2)=pizda(1,2)+pizda(2,1)
8449 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8452 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8454 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8457 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8458 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8460 C Cartesian derivatives.
8462 write (2,*) 'In eello6_graph2'
8464 write (2,*) 'iii=',iii
8466 write (2,*) 'kkk=',kkk
8468 write (2,'(3(2f10.5),5x)')
8469 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8479 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8481 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8484 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8486 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8487 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8489 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8490 call transpose2(EUg(1,1,k),auxmat(1,1))
8491 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8493 vv(1)=pizda(1,1)-pizda(2,2)
8494 vv(2)=pizda(1,2)+pizda(2,1)
8495 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8496 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8498 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8500 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8503 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8505 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8512 c----------------------------------------------------------------------------
8513 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8514 implicit real*8 (a-h,o-z)
8515 include 'DIMENSIONS'
8516 include 'COMMON.IOUNITS'
8517 include 'COMMON.CHAIN'
8518 include 'COMMON.DERIV'
8519 include 'COMMON.INTERACT'
8520 include 'COMMON.CONTACTS'
8521 include 'COMMON.TORSION'
8522 include 'COMMON.VAR'
8523 include 'COMMON.GEO'
8524 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8526 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8528 C Parallel Antiparallel C
8534 C j|/k\| / |/k\|l / C
8539 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8541 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8542 C energy moment and not to the cluster cumulant.
8543 iti=itortyp(itype(i))
8544 if (j.lt.nres-1) then
8545 itj1=itortyp(itype(j+1))
8549 itk=itortyp(itype(k))
8550 itk1=itortyp(itype(k+1))
8551 if (l.lt.nres-1) then
8552 itl1=itortyp(itype(l+1))
8557 s1=dip(4,jj,i)*dip(4,kk,k)
8559 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8560 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8561 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8562 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8563 call transpose2(EE(1,1,itk),auxmat(1,1))
8564 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8565 vv(1)=pizda(1,1)+pizda(2,2)
8566 vv(2)=pizda(2,1)-pizda(1,2)
8567 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8568 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8569 cd & "sum",-(s2+s3+s4)
8571 eello6_graph3=-(s1+s2+s3+s4)
8573 eello6_graph3=-(s2+s3+s4)
8576 C Derivatives in gamma(k-1)
8577 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8578 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8579 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8580 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8581 C Derivatives in gamma(l-1)
8582 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8583 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8584 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8585 vv(1)=pizda(1,1)+pizda(2,2)
8586 vv(2)=pizda(2,1)-pizda(1,2)
8587 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8588 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8589 C Cartesian derivatives.
8595 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8597 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8600 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8602 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8603 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8605 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8606 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8608 vv(1)=pizda(1,1)+pizda(2,2)
8609 vv(2)=pizda(2,1)-pizda(1,2)
8610 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8612 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8614 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8617 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8619 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8621 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8627 c----------------------------------------------------------------------------
8628 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8629 implicit real*8 (a-h,o-z)
8630 include 'DIMENSIONS'
8631 include 'COMMON.IOUNITS'
8632 include 'COMMON.CHAIN'
8633 include 'COMMON.DERIV'
8634 include 'COMMON.INTERACT'
8635 include 'COMMON.CONTACTS'
8636 include 'COMMON.TORSION'
8637 include 'COMMON.VAR'
8638 include 'COMMON.GEO'
8639 include 'COMMON.FFIELD'
8640 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8641 & auxvec1(2),auxmat1(2,2)
8643 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8645 C Parallel Antiparallel C
8651 C \ j|/k\| \ |/k\|l C
8656 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8658 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8659 C energy moment and not to the cluster cumulant.
8660 cd write (2,*) 'eello_graph4: wturn6',wturn6
8661 iti=itortyp(itype(i))
8662 itj=itortyp(itype(j))
8663 if (j.lt.nres-1) then
8664 itj1=itortyp(itype(j+1))
8668 itk=itortyp(itype(k))
8669 if (k.lt.nres-1) then
8670 itk1=itortyp(itype(k+1))
8674 itl=itortyp(itype(l))
8675 if (l.lt.nres-1) then
8676 itl1=itortyp(itype(l+1))
8680 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8681 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8682 cd & ' itl',itl,' itl1',itl1
8685 s1=dip(3,jj,i)*dip(3,kk,k)
8687 s1=dip(2,jj,j)*dip(2,kk,l)
8690 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8691 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8693 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8694 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8696 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8697 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8699 call transpose2(EUg(1,1,k),auxmat(1,1))
8700 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8701 vv(1)=pizda(1,1)-pizda(2,2)
8702 vv(2)=pizda(2,1)+pizda(1,2)
8703 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8704 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8706 eello6_graph4=-(s1+s2+s3+s4)
8708 eello6_graph4=-(s2+s3+s4)
8710 C Derivatives in gamma(i-1)
8714 s1=dipderg(2,jj,i)*dip(3,kk,k)
8716 s1=dipderg(4,jj,j)*dip(2,kk,l)
8719 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8721 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8722 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8724 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8725 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8727 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8728 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8729 cd write (2,*) 'turn6 derivatives'
8731 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8733 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8737 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8739 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8743 C Derivatives in gamma(k-1)
8746 s1=dip(3,jj,i)*dipderg(2,kk,k)
8748 s1=dip(2,jj,j)*dipderg(4,kk,l)
8751 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8752 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8754 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8755 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8757 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8758 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8760 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8761 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8762 vv(1)=pizda(1,1)-pizda(2,2)
8763 vv(2)=pizda(2,1)+pizda(1,2)
8764 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8765 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8767 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8769 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8773 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8775 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8778 C Derivatives in gamma(j-1) or gamma(l-1)
8779 if (l.eq.j+1 .and. l.gt.1) then
8780 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8781 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8782 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8783 vv(1)=pizda(1,1)-pizda(2,2)
8784 vv(2)=pizda(2,1)+pizda(1,2)
8785 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8786 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8787 else if (j.gt.1) then
8788 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8789 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8790 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8791 vv(1)=pizda(1,1)-pizda(2,2)
8792 vv(2)=pizda(2,1)+pizda(1,2)
8793 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8794 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8795 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8797 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8800 C Cartesian derivatives.
8807 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8809 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8813 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8815 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8819 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8821 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8823 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8824 & b1(1,itj1),auxvec(1))
8825 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8827 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8828 & b1(1,itl1),auxvec(1))
8829 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8831 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8833 vv(1)=pizda(1,1)-pizda(2,2)
8834 vv(2)=pizda(2,1)+pizda(1,2)
8835 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8837 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8839 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8842 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8845 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8848 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8850 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8852 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8856 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8858 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8861 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8863 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8871 c----------------------------------------------------------------------------
8872 double precision function eello_turn6(i,jj,kk)
8873 implicit real*8 (a-h,o-z)
8874 include 'DIMENSIONS'
8875 include 'COMMON.IOUNITS'
8876 include 'COMMON.CHAIN'
8877 include 'COMMON.DERIV'
8878 include 'COMMON.INTERACT'
8879 include 'COMMON.CONTACTS'
8880 include 'COMMON.TORSION'
8881 include 'COMMON.VAR'
8882 include 'COMMON.GEO'
8883 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8884 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8886 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8887 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8888 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8889 C the respective energy moment and not to the cluster cumulant.
8898 iti=itortyp(itype(i))
8899 itk=itortyp(itype(k))
8900 itk1=itortyp(itype(k+1))
8901 itl=itortyp(itype(l))
8902 itj=itortyp(itype(j))
8903 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8904 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8905 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8910 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8912 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8916 derx_turn(lll,kkk,iii)=0.0d0
8923 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8925 cd write (2,*) 'eello6_5',eello6_5
8927 call transpose2(AEA(1,1,1),auxmat(1,1))
8928 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8929 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8930 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8932 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8933 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8934 s2 = scalar2(b1(1,itk),vtemp1(1))
8936 call transpose2(AEA(1,1,2),atemp(1,1))
8937 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8938 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8939 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8941 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8942 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8943 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8945 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8946 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8947 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8948 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8949 ss13 = scalar2(b1(1,itk),vtemp4(1))
8950 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8952 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8958 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8959 C Derivatives in gamma(i+2)
8963 call transpose2(AEA(1,1,1),auxmatd(1,1))
8964 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8965 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8966 call transpose2(AEAderg(1,1,2),atempd(1,1))
8967 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8968 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8970 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8971 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8972 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8978 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8979 C Derivatives in gamma(i+3)
8981 call transpose2(AEA(1,1,1),auxmatd(1,1))
8982 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8983 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8984 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8986 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8987 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8988 s2d = scalar2(b1(1,itk),vtemp1d(1))
8990 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8991 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8993 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8995 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8996 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8997 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9005 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9006 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9008 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9009 & -0.5d0*ekont*(s2d+s12d)
9011 C Derivatives in gamma(i+4)
9012 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9013 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9014 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9016 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9017 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9018 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9026 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9028 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9030 C Derivatives in gamma(i+5)
9032 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9033 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9034 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9036 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9037 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9038 s2d = scalar2(b1(1,itk),vtemp1d(1))
9040 call transpose2(AEA(1,1,2),atempd(1,1))
9041 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9042 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9044 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9045 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9047 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9048 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9049 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9057 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9058 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9060 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9061 & -0.5d0*ekont*(s2d+s12d)
9063 C Cartesian derivatives
9068 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9069 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9070 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9072 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9073 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9075 s2d = scalar2(b1(1,itk),vtemp1d(1))
9077 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9078 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9079 s8d = -(atempd(1,1)+atempd(2,2))*
9080 & scalar2(cc(1,1,itl),vtemp2(1))
9082 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9084 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9085 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9092 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9095 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9099 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9100 & - 0.5d0*(s8d+s12d)
9102 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9111 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9113 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9114 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9115 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9116 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9117 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9119 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9120 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9121 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9125 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9126 cd & 16*eel_turn6_num
9128 if (j.lt.nres-1) then
9135 if (l.lt.nres-1) then
9143 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9144 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9145 cgrad ghalf=0.5d0*ggg1(ll)
9147 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9148 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9149 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9150 & +ekont*derx_turn(ll,2,1)
9151 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9152 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9153 & +ekont*derx_turn(ll,4,1)
9154 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9155 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9156 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9157 cgrad ghalf=0.5d0*ggg2(ll)
9159 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9160 & +ekont*derx_turn(ll,2,2)
9161 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9162 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9163 & +ekont*derx_turn(ll,4,2)
9164 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9165 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9166 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9171 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9176 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9182 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9187 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9191 cd write (2,*) iii,g_corr6_loc(iii)
9193 eello_turn6=ekont*eel_turn6
9194 cd write (2,*) 'ekont',ekont
9195 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9199 C-----------------------------------------------------------------------------
9200 double precision function scalar(u,v)
9201 !DIR$ INLINEALWAYS scalar
9203 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9206 double precision u(3),v(3)
9207 cd double precision sc
9215 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9218 crc-------------------------------------------------
9219 SUBROUTINE MATVEC2(A1,V1,V2)
9220 !DIR$ INLINEALWAYS MATVEC2
9222 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9224 implicit real*8 (a-h,o-z)
9225 include 'DIMENSIONS'
9226 DIMENSION A1(2,2),V1(2),V2(2)
9230 c 3 VI=VI+A1(I,K)*V1(K)
9234 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9235 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9240 C---------------------------------------
9241 SUBROUTINE MATMAT2(A1,A2,A3)
9243 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9245 implicit real*8 (a-h,o-z)
9246 include 'DIMENSIONS'
9247 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9248 c DIMENSION AI3(2,2)
9252 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9258 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9259 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9260 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9261 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9269 c-------------------------------------------------------------------------
9270 double precision function scalar2(u,v)
9271 !DIR$ INLINEALWAYS scalar2
9273 double precision u(2),v(2)
9276 scalar2=u(1)*v(1)+u(2)*v(2)
9280 C-----------------------------------------------------------------------------
9282 subroutine transpose2(a,at)
9283 !DIR$ INLINEALWAYS transpose2
9285 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9288 double precision a(2,2),at(2,2)
9295 c--------------------------------------------------------------------------
9296 subroutine transpose(n,a,at)
9299 double precision a(n,n),at(n,n)
9307 C---------------------------------------------------------------------------
9308 subroutine prodmat3(a1,a2,kk,transp,prod)
9309 !DIR$ INLINEALWAYS prodmat3
9311 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9315 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9317 crc double precision auxmat(2,2),prod_(2,2)
9320 crc call transpose2(kk(1,1),auxmat(1,1))
9321 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9322 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9324 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9325 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9326 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9327 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9328 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9329 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9330 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9331 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9334 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9335 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9337 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9338 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9339 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9340 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9341 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9342 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9343 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9344 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9347 c call transpose2(a2(1,1),a2t(1,1))
9350 crc print *,((prod_(i,j),i=1,2),j=1,2)
9351 crc print *,((prod(i,j),i=1,2),j=1,2)