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
31 if (nfgtasks.gt.1) then
37 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
38 if (fg_rank.eq.0) then
39 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
40 c print *,"Processor",myrank," BROADCAST iorder"
41 C FG master sets up the WEIGHTS_ array which will be broadcast to the
42 C FG slaves as WEIGHTS array.
63 C FG Master broadcasts the WEIGHTS_ array
64 call MPI_Bcast(weights_(1),n_ene,
65 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
67 C FG slaves receive the WEIGHTS array
68 call MPI_Bcast(weights(1),n_ene,
69 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
91 time_Bcast=time_Bcast+MPI_Wtime()-time00
92 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
93 c call chainbuild_cart
95 c print *,'Processor',myrank,' calling etotal ipot=',ipot
96 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
98 c if (modecalc.eq.12.or.modecalc.eq.14) then
99 c call int_from_cart1(.false.)
110 C Compute the side-chain and electrostatic interaction energy
112 goto (101,102,103,104,105,106) ipot
113 C Lennard-Jones potential.
114 101 call elj(evdw,evdw_p,evdw_m)
115 cd print '(a)','Exit ELJ'
117 C Lennard-Jones-Kihara potential (shifted).
118 102 call eljk(evdw,evdw_p,evdw_m)
120 C Berne-Pechukas potential (dilated LJ, angular dependence).
121 103 call ebp(evdw,evdw_p,evdw_m)
123 C Gay-Berne potential (shifted LJ, angular dependence).
124 104 call egb(evdw,evdw_p,evdw_m)
126 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
127 105 call egbv(evdw,evdw_p,evdw_m)
129 C Soft-sphere potential
130 106 call e_softsphere(evdw)
132 C Calculate electrostatic (H-bonding) energy of the main chain.
135 C BARTEK for dfa test!
136 if (wdfa_dist.gt.0) then
141 c print*, 'edfad is finished!', edfadis
142 if (wdfa_tor.gt.0) then
147 c print*, 'edfat is finished!', edfator
148 if (wdfa_nei.gt.0) then
153 c print*, 'edfan is finished!', edfanei
154 if (wdfa_beta.gt.0) then
159 c print*, 'edfab is finished!', edfabet
161 cmc Sep-06: egb takes care of dynamic ss bonds too
163 c if (dyn_ss) call dyn_set_nss
165 c print *,"Processor",myrank," computed USCSC"
176 time_vec=time_vec+MPI_Wtime()-time01
178 time_vec=time_vec+tcpu()-time01
181 c print *,"Processor",myrank," left VEC_AND_DERIV"
184 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
185 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
186 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
187 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
189 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
190 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
191 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
192 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
194 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
203 c write (iout,*) "Soft-spheer ELEC potential"
204 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
207 c print *,"Processor",myrank," computed UELEC"
209 C Calculate excluded-volume interaction energy between peptide groups
214 call escp(evdw2,evdw2_14)
220 c write (iout,*) "Soft-sphere SCP potential"
221 call escp_soft_sphere(evdw2,evdw2_14)
224 c Calculate the bond-stretching energy
228 C Calculate the disulfide-bridge and other energy and the contributions
229 C from other distance constraints.
230 cd print *,'Calling EHPB'
232 cd print *,'EHPB exitted succesfully.'
234 C Calculate the virtual-bond-angle energy.
236 if (wang.gt.0d0) then
241 c print *,"Processor",myrank," computed UB"
243 C Calculate the SC local energy.
246 c print *,"Processor",myrank," computed USC"
248 C Calculate the virtual-bond torsional energy.
250 cd print *,'nterm=',nterm
252 call etor(etors,edihcnstr)
258 if (constr_homology.ge.1) then
259 call e_modeller(ehomology_constr)
261 ehomology_constr=0.0d0
265 c write(iout,*) ehomology_constr
266 c print *,"Processor",myrank," computed Utor"
268 C 6/23/01 Calculate double-torsional energy
270 if (wtor_d.gt.0) then
275 c print *,"Processor",myrank," computed Utord"
277 C 21/5/07 Calculate local sicdechain correlation energy
279 if (wsccor.gt.0.0d0) then
280 call eback_sc_corr(esccor)
284 c print *,"Processor",myrank," computed Usccorr"
286 C 12/1/95 Multi-body terms
290 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
291 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
292 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
293 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
294 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
301 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
302 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
303 cd write (iout,*) "multibody_hb ecorr",ecorr
305 c print *,"Processor",myrank," computed Ucorr"
307 C If performing constraint dynamics, call the constraint energy
308 C after the equilibration time
309 if(usampl.and.totT.gt.eq_time) then
318 time_enecalc=time_enecalc+MPI_Wtime()-time00
320 time_enecalc=time_enecalc+tcpu()-time00
323 c print *,"Processor",myrank," computed Uconstr"
336 energia(2)=evdw2-evdw2_14
353 energia(8)=eello_turn3
354 energia(9)=eello_turn4
361 energia(19)=edihcnstr
363 energia(20)=Uconst+Uconst_back
367 energia(24)=ehomology_constr
372 c print *," Processor",myrank," calls SUM_ENERGY"
373 call sum_energy(energia,.true.)
374 if (dyn_ss) call dyn_set_nss
375 c print *," Processor",myrank," left SUM_ENERGY"
378 time_sumene=time_sumene+MPI_Wtime()-time00
380 time_sumene=time_sumene+tcpu()-time00
385 c-------------------------------------------------------------------------------
386 subroutine sum_energy(energia,reduce)
387 implicit real*8 (a-h,o-z)
392 cMS$ATTRIBUTES C :: proc_proc
398 include 'COMMON.SETUP'
399 include 'COMMON.IOUNITS'
400 double precision energia(0:n_ene),enebuff(0:n_ene+1)
401 include 'COMMON.FFIELD'
402 include 'COMMON.DERIV'
403 include 'COMMON.INTERACT'
404 include 'COMMON.SBRIDGE'
405 include 'COMMON.CHAIN'
407 include 'COMMON.CONTROL'
408 include 'COMMON.TIME1'
411 if (nfgtasks.gt.1 .and. reduce) then
413 write (iout,*) "energies before REDUCE"
414 call enerprint(energia)
418 enebuff(i)=energia(i)
421 call MPI_Barrier(FG_COMM,IERR)
422 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
424 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
425 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
427 write (iout,*) "energies after REDUCE"
428 call enerprint(energia)
431 time_Reduce=time_Reduce+MPI_Wtime()-time00
433 if (fg_rank.eq.0) then
436 evdw=energia(22)+wsct*energia(23)
441 evdw2=energia(2)+energia(18)
457 eello_turn3=energia(8)
458 eello_turn4=energia(9)
465 edihcnstr=energia(19)
469 ehomology_constr=energia(24)
475 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
476 & +wang*ebe+wtor*etors+wscloc*escloc
477 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
478 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
479 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
480 & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
481 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
484 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
485 & +wang*ebe+wtor*etors+wscloc*escloc
486 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
487 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
488 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
489 & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
490 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
497 if (isnan(etot).ne.0) energia(0)=1.0d+99
499 if (isnan(etot)) energia(0)=1.0d+99
504 idumm=proc_proc(etot,i)
506 call proc_proc(etot,i)
508 if(i.eq.1)energia(0)=1.0d+99
515 c-------------------------------------------------------------------------------
516 subroutine sum_gradient
517 implicit real*8 (a-h,o-z)
522 cMS$ATTRIBUTES C :: proc_proc
528 double precision gradbufc(3,maxres),gradbufx(3,maxres),
529 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
530 include 'COMMON.SETUP'
531 include 'COMMON.IOUNITS'
532 include 'COMMON.FFIELD'
533 include 'COMMON.DERIV'
534 include 'COMMON.INTERACT'
535 include 'COMMON.SBRIDGE'
536 include 'COMMON.CHAIN'
538 include 'COMMON.CONTROL'
539 include 'COMMON.TIME1'
540 include 'COMMON.MAXGRAD'
541 include 'COMMON.SCCOR'
550 write (iout,*) "sum_gradient gvdwc, gvdwx"
552 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
553 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
554 & (gvdwcT(j,i),j=1,3)
559 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
560 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
561 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
564 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
565 C in virtual-bond-vector coordinates
568 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
570 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
571 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
573 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
575 c write (iout,'(i5,3f10.5,2x,f10.5)')
576 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
578 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
580 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
581 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
590 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
591 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
592 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
593 & wel_loc*gel_loc_long(j,i)+
594 & wcorr*gradcorr_long(j,i)+
595 & wcorr5*gradcorr5_long(j,i)+
596 & wcorr6*gradcorr6_long(j,i)+
597 & wturn6*gcorr6_turn_long(j,i)+
598 & wstrain*ghpbc(j,i)+
599 & wdfa_dist*gdfad(j,i)+
600 & wdfa_tor*gdfat(j,i)+
601 & wdfa_nei*gdfan(j,i)+
602 & wdfa_beta*gdfab(j,i)
608 gradbufc(j,i)=wsc*gvdwc(j,i)+
609 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
610 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
611 & wel_loc*gel_loc_long(j,i)+
612 & wcorr*gradcorr_long(j,i)+
613 & wcorr5*gradcorr5_long(j,i)+
614 & wcorr6*gradcorr6_long(j,i)+
615 & wturn6*gcorr6_turn_long(j,i)+
616 & wstrain*ghpbc(j,i)+
617 & wdfa_dist*gdfad(j,i)+
618 & wdfa_tor*gdfat(j,i)+
619 & wdfa_nei*gdfan(j,i)+
620 & wdfa_beta*gdfab(j,i)
627 gradbufc(j,i)=wsc*gvdwc(j,i)+
628 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
629 & welec*gelc_long(j,i)+
631 & wel_loc*gel_loc_long(j,i)+
632 & wcorr*gradcorr_long(j,i)+
633 & wcorr5*gradcorr5_long(j,i)+
634 & wcorr6*gradcorr6_long(j,i)+
635 & wturn6*gcorr6_turn_long(j,i)+
636 & wstrain*ghpbc(j,i)+
637 & wdfa_dist*gdfad(j,i)+
638 & wdfa_tor*gdfat(j,i)+
639 & wdfa_nei*gdfan(j,i)+
640 & wdfa_beta*gdfab(j,i)
645 if (nfgtasks.gt.1) then
648 write (iout,*) "gradbufc before allreduce"
650 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
656 gradbufc_sum(j,i)=gradbufc(j,i)
659 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
660 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
661 c time_reduce=time_reduce+MPI_Wtime()-time00
663 c write (iout,*) "gradbufc_sum after allreduce"
665 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
670 c time_allreduce=time_allreduce+MPI_Wtime()-time00
678 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
679 write (iout,*) (i," jgrad_start",jgrad_start(i),
680 & " jgrad_end ",jgrad_end(i),
681 & i=igrad_start,igrad_end)
684 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
685 c do not parallelize this part.
687 c do i=igrad_start,igrad_end
688 c do j=jgrad_start(i),jgrad_end(i)
690 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
695 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
699 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
703 write (iout,*) "gradbufc after summing"
705 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
712 write (iout,*) "gradbufc"
714 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
720 gradbufc_sum(j,i)=gradbufc(j,i)
725 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
729 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
734 c gradbufc(k,i)=0.0d0
738 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
743 write (iout,*) "gradbufc after summing"
745 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
753 gradbufc(k,nres)=0.0d0
758 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
759 & wel_loc*gel_loc(j,i)+
760 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
761 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
762 & wel_loc*gel_loc_long(j,i)+
763 & wcorr*gradcorr_long(j,i)+
764 & wcorr5*gradcorr5_long(j,i)+
765 & wcorr6*gradcorr6_long(j,i)+
766 & wturn6*gcorr6_turn_long(j,i))+
768 & wcorr*gradcorr(j,i)+
769 & wturn3*gcorr3_turn(j,i)+
770 & wturn4*gcorr4_turn(j,i)+
771 & wcorr5*gradcorr5(j,i)+
772 & wcorr6*gradcorr6(j,i)+
773 & wturn6*gcorr6_turn(j,i)+
774 & wsccor*gsccorc(j,i)
775 & +wscloc*gscloc(j,i)
777 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
778 & wel_loc*gel_loc(j,i)+
779 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
780 & welec*gelc_long(j,i)+
781 & wel_loc*gel_loc_long(j,i)+
782 & wcorr*gcorr_long(j,i)+
783 & wcorr5*gradcorr5_long(j,i)+
784 & wcorr6*gradcorr6_long(j,i)+
785 & wturn6*gcorr6_turn_long(j,i))+
787 & wcorr*gradcorr(j,i)+
788 & wturn3*gcorr3_turn(j,i)+
789 & wturn4*gcorr4_turn(j,i)+
790 & wcorr5*gradcorr5(j,i)+
791 & wcorr6*gradcorr6(j,i)+
792 & wturn6*gcorr6_turn(j,i)+
793 & wsccor*gsccorc(j,i)
794 & +wscloc*gscloc(j,i)
797 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
798 & wscp*gradx_scp(j,i)+
800 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
801 & wsccor*gsccorx(j,i)
802 & +wscloc*gsclocx(j,i)
804 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
806 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
807 & wsccor*gsccorx(j,i)
808 & +wscloc*gsclocx(j,i)
813 write (iout,*) "gloc before adding corr"
815 write (iout,*) i,gloc(i,icg)
819 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
820 & +wcorr5*g_corr5_loc(i)
821 & +wcorr6*g_corr6_loc(i)
822 & +wturn4*gel_loc_turn4(i)
823 & +wturn3*gel_loc_turn3(i)
824 & +wturn6*gel_loc_turn6(i)
825 & +wel_loc*gel_loc_loc(i)
828 write (iout,*) "gloc after adding corr"
830 write (iout,*) i,gloc(i,icg)
834 if (nfgtasks.gt.1) then
837 gradbufc(j,i)=gradc(j,i,icg)
838 gradbufx(j,i)=gradx(j,i,icg)
842 glocbuf(i)=gloc(i,icg)
845 write (iout,*) "gloc_sc before reduce"
848 write (iout,*) i,j,gloc_sc(j,i,icg)
854 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
858 call MPI_Barrier(FG_COMM,IERR)
859 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
861 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
862 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
863 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
864 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
865 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
866 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
867 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
868 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
869 time_reduce=time_reduce+MPI_Wtime()-time00
871 write (iout,*) "gloc_sc after reduce"
874 write (iout,*) i,j,gloc_sc(j,i,icg)
879 write (iout,*) "gloc after reduce"
881 write (iout,*) i,gloc(i,icg)
886 if (gnorm_check) then
888 c Compute the maximum elements of the gradient
898 gcorr3_turn_max=0.0d0
899 gcorr4_turn_max=0.0d0
902 gcorr6_turn_max=0.0d0
912 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
913 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
915 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
916 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
918 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
919 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
920 & gvdwc_scp_max=gvdwc_scp_norm
921 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
922 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
923 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
924 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
925 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
926 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
927 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
928 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
929 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
930 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
931 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
932 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
933 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
935 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
936 & gcorr3_turn_max=gcorr3_turn_norm
937 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
939 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
940 & gcorr4_turn_max=gcorr4_turn_norm
941 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
942 if (gradcorr5_norm.gt.gradcorr5_max)
943 & gradcorr5_max=gradcorr5_norm
944 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
945 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
946 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
948 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
949 & gcorr6_turn_max=gcorr6_turn_norm
950 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
951 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
952 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
953 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
954 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
955 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
957 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
958 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
960 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
961 if (gradx_scp_norm.gt.gradx_scp_max)
962 & gradx_scp_max=gradx_scp_norm
963 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
964 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
965 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
966 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
967 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
968 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
969 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
970 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
974 open(istat,file=statname,position="append")
976 open(istat,file=statname,access="append")
978 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
979 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
980 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
981 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
982 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
983 & gsccorx_max,gsclocx_max
985 if (gvdwc_max.gt.1.0d4) then
986 write (iout,*) "gvdwc gvdwx gradb gradbx"
988 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
989 & gradb(j,i),gradbx(j,i),j=1,3)
991 call pdbout(0.0d0,'cipiszcze',iout)
997 write (iout,*) "gradc gradx gloc"
999 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
1000 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
1005 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
1007 time_sumgradient=time_sumgradient+tcpu()-time01
1012 c-------------------------------------------------------------------------------
1013 subroutine rescale_weights(t_bath)
1014 implicit real*8 (a-h,o-z)
1015 include 'DIMENSIONS'
1016 include 'COMMON.IOUNITS'
1017 include 'COMMON.FFIELD'
1018 include 'COMMON.SBRIDGE'
1019 double precision kfac /2.4d0/
1020 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
1022 c facT=2*temp0/(t_bath+temp0)
1023 if (rescale_mode.eq.0) then
1029 else if (rescale_mode.eq.1) then
1030 facT=kfac/(kfac-1.0d0+t_bath/temp0)
1031 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1032 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1033 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1034 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1035 else if (rescale_mode.eq.2) then
1041 facT=licznik/dlog(dexp(x)+dexp(-x))
1042 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
1043 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
1044 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
1045 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
1047 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1048 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1050 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1054 welec=weights(3)*fact
1055 wcorr=weights(4)*fact3
1056 wcorr5=weights(5)*fact4
1057 wcorr6=weights(6)*fact5
1058 wel_loc=weights(7)*fact2
1059 wturn3=weights(8)*fact2
1060 wturn4=weights(9)*fact3
1061 wturn6=weights(10)*fact5
1062 wtor=weights(13)*fact
1063 wtor_d=weights(14)*fact2
1064 wsccor=weights(21)*fact
1067 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1071 C------------------------------------------------------------------------
1072 subroutine enerprint(energia)
1073 implicit real*8 (a-h,o-z)
1074 include 'DIMENSIONS'
1075 include 'COMMON.IOUNITS'
1076 include 'COMMON.FFIELD'
1077 include 'COMMON.SBRIDGE'
1079 double precision energia(0:n_ene)
1082 evdw=energia(22)+wsct*energia(23)
1088 evdw2=energia(2)+energia(18)
1100 eello_turn3=energia(8)
1101 eello_turn4=energia(9)
1102 eello_turn6=energia(10)
1108 edihcnstr=energia(19)
1112 ehomology_constr=energia(24)
1114 edfadis = energia(25)
1115 edfator = energia(26)
1116 edfanei = energia(27)
1117 edfabet = energia(28)
1120 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1121 & estr,wbond,ebe,wang,
1122 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1124 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1125 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1126 & edihcnstr,ehomology_constr, ebr*nss,
1127 & Uconst,edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
1128 & edfabet,wdfa_beta,etot
1129 10 format (/'Virtual-chain energies:'//
1130 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
1131 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
1132 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
1133 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
1134 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
1135 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
1136 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
1137 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
1138 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
1139 & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6,
1140 & ' (SS bridges & dist. cnstr.)'/
1141 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1142 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1143 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1144 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
1145 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
1146 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
1147 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
1148 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
1149 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1150 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1151 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1152 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1153 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
1154 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
1155 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
1156 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
1157 & 'ETOT= ',1pE16.6,' (total)')
1159 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1160 & estr,wbond,ebe,wang,
1161 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1163 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1164 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1165 & ehomology_constr,ebr*nss,Uconst,edfadis,wdfa_dist,edfator,
1166 & wdfa_tor,edfanei,wdfa_nei,edfabet,wdfa_beta,
1168 10 format (/'Virtual-chain energies:'//
1169 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1170 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1171 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1172 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1173 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1174 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1175 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1176 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1177 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1178 & ' (SS bridges & dist. cnstr.)'/
1179 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1180 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1181 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1182 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1183 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1184 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1185 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1186 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1187 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1188 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1189 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1190 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1191 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
1192 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
1193 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
1194 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
1195 & 'ETOT= ',1pE16.6,' (total)')
1199 C-----------------------------------------------------------------------
1200 subroutine elj(evdw,evdw_p,evdw_m)
1202 C This subroutine calculates the interaction energy of nonbonded side chains
1203 C assuming the LJ potential of interaction.
1205 implicit real*8 (a-h,o-z)
1206 include 'DIMENSIONS'
1207 parameter (accur=1.0d-10)
1208 include 'COMMON.GEO'
1209 include 'COMMON.VAR'
1210 include 'COMMON.LOCAL'
1211 include 'COMMON.CHAIN'
1212 include 'COMMON.DERIV'
1213 include 'COMMON.INTERACT'
1214 include 'COMMON.TORSION'
1215 include 'COMMON.SBRIDGE'
1216 include 'COMMON.NAMES'
1217 include 'COMMON.IOUNITS'
1218 include 'COMMON.CONTACTS'
1220 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1222 do i=iatsc_s,iatsc_e
1231 C Calculate SC interaction energy.
1233 do iint=1,nint_gr(i)
1234 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1235 cd & 'iend=',iend(i,iint)
1236 do j=istart(i,iint),iend(i,iint)
1241 C Change 12/1/95 to calculate four-body interactions
1242 rij=xj*xj+yj*yj+zj*zj
1244 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1245 eps0ij=eps(itypi,itypj)
1247 e1=fac*fac*aa(itypi,itypj)
1248 e2=fac*bb(itypi,itypj)
1250 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1251 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1252 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1253 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1254 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1255 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1257 if (bb(itypi,itypj).gt.0) then
1258 evdw_p=evdw_p+evdwij
1260 evdw_m=evdw_m+evdwij
1266 C Calculate the components of the gradient in DC and X
1268 fac=-rrij*(e1+evdwij)
1273 if (bb(itypi,itypj).gt.0.0d0) then
1275 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1276 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1277 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1278 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1282 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1283 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1284 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1285 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1290 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1291 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1292 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1293 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1298 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1302 C 12/1/95, revised on 5/20/97
1304 C Calculate the contact function. The ith column of the array JCONT will
1305 C contain the numbers of atoms that make contacts with the atom I (of numbers
1306 C greater than I). The arrays FACONT and GACONT will contain the values of
1307 C the contact function and its derivative.
1309 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1310 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1311 C Uncomment next line, if the correlation interactions are contact function only
1312 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1314 sigij=sigma(itypi,itypj)
1315 r0ij=rs0(itypi,itypj)
1317 C Check whether the SC's are not too far to make a contact.
1320 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1321 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1323 if (fcont.gt.0.0D0) then
1324 C If the SC-SC distance if close to sigma, apply spline.
1325 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1326 cAdam & fcont1,fprimcont1)
1327 cAdam fcont1=1.0d0-fcont1
1328 cAdam if (fcont1.gt.0.0d0) then
1329 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1330 cAdam fcont=fcont*fcont1
1332 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1333 cga eps0ij=1.0d0/dsqrt(eps0ij)
1335 cga gg(k)=gg(k)*eps0ij
1337 cga eps0ij=-evdwij*eps0ij
1338 C Uncomment for AL's type of SC correlation interactions.
1339 cadam eps0ij=-evdwij
1340 num_conti=num_conti+1
1341 jcont(num_conti,i)=j
1342 facont(num_conti,i)=fcont*eps0ij
1343 fprimcont=eps0ij*fprimcont/rij
1345 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1346 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1347 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1348 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1349 gacont(1,num_conti,i)=-fprimcont*xj
1350 gacont(2,num_conti,i)=-fprimcont*yj
1351 gacont(3,num_conti,i)=-fprimcont*zj
1352 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1353 cd write (iout,'(2i3,3f10.5)')
1354 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1360 num_cont(i)=num_conti
1364 gvdwc(j,i)=expon*gvdwc(j,i)
1365 gvdwx(j,i)=expon*gvdwx(j,i)
1368 C******************************************************************************
1372 C To save time, the factor of EXPON has been extracted from ALL components
1373 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1376 C******************************************************************************
1379 C-----------------------------------------------------------------------------
1380 subroutine eljk(evdw,evdw_p,evdw_m)
1382 C This subroutine calculates the interaction energy of nonbonded side chains
1383 C assuming the LJK potential of interaction.
1385 implicit real*8 (a-h,o-z)
1386 include 'DIMENSIONS'
1387 include 'COMMON.GEO'
1388 include 'COMMON.VAR'
1389 include 'COMMON.LOCAL'
1390 include 'COMMON.CHAIN'
1391 include 'COMMON.DERIV'
1392 include 'COMMON.INTERACT'
1393 include 'COMMON.IOUNITS'
1394 include 'COMMON.NAMES'
1397 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1399 do i=iatsc_s,iatsc_e
1406 C Calculate SC interaction energy.
1408 do iint=1,nint_gr(i)
1409 do j=istart(i,iint),iend(i,iint)
1414 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1415 fac_augm=rrij**expon
1416 e_augm=augm(itypi,itypj)*fac_augm
1417 r_inv_ij=dsqrt(rrij)
1419 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1420 fac=r_shift_inv**expon
1421 e1=fac*fac*aa(itypi,itypj)
1422 e2=fac*bb(itypi,itypj)
1424 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1425 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1426 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1427 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1428 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1429 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1430 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1432 if (bb(itypi,itypj).gt.0) then
1433 evdw_p=evdw_p+evdwij
1435 evdw_m=evdw_m+evdwij
1441 C Calculate the components of the gradient in DC and X
1443 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1448 if (bb(itypi,itypj).gt.0.0d0) then
1450 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1451 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1452 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1453 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1457 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1458 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1459 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1460 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1465 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1466 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1467 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1468 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1473 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1481 gvdwc(j,i)=expon*gvdwc(j,i)
1482 gvdwx(j,i)=expon*gvdwx(j,i)
1487 C-----------------------------------------------------------------------------
1488 subroutine ebp(evdw,evdw_p,evdw_m)
1490 C This subroutine calculates the interaction energy of nonbonded side chains
1491 C assuming the Berne-Pechukas potential of interaction.
1493 implicit real*8 (a-h,o-z)
1494 include 'DIMENSIONS'
1495 include 'COMMON.GEO'
1496 include 'COMMON.VAR'
1497 include 'COMMON.LOCAL'
1498 include 'COMMON.CHAIN'
1499 include 'COMMON.DERIV'
1500 include 'COMMON.NAMES'
1501 include 'COMMON.INTERACT'
1502 include 'COMMON.IOUNITS'
1503 include 'COMMON.CALC'
1504 common /srutu/ icall
1505 c double precision rrsave(maxdim)
1508 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1510 c if (icall.eq.0) then
1516 do i=iatsc_s,iatsc_e
1522 dxi=dc_norm(1,nres+i)
1523 dyi=dc_norm(2,nres+i)
1524 dzi=dc_norm(3,nres+i)
1525 c dsci_inv=dsc_inv(itypi)
1526 dsci_inv=vbld_inv(i+nres)
1528 C Calculate SC interaction energy.
1530 do iint=1,nint_gr(i)
1531 do j=istart(i,iint),iend(i,iint)
1534 c dscj_inv=dsc_inv(itypj)
1535 dscj_inv=vbld_inv(j+nres)
1536 chi1=chi(itypi,itypj)
1537 chi2=chi(itypj,itypi)
1544 alf12=0.5D0*(alf1+alf2)
1545 C For diagnostics only!!!
1558 dxj=dc_norm(1,nres+j)
1559 dyj=dc_norm(2,nres+j)
1560 dzj=dc_norm(3,nres+j)
1561 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1562 cd if (icall.eq.0) then
1568 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1570 C Calculate whole angle-dependent part of epsilon and contributions
1571 C to its derivatives
1572 fac=(rrij*sigsq)**expon2
1573 e1=fac*fac*aa(itypi,itypj)
1574 e2=fac*bb(itypi,itypj)
1575 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1576 eps2der=evdwij*eps3rt
1577 eps3der=evdwij*eps2rt
1578 evdwij=evdwij*eps2rt*eps3rt
1580 if (bb(itypi,itypj).gt.0) then
1581 evdw_p=evdw_p+evdwij
1583 evdw_m=evdw_m+evdwij
1589 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1590 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1591 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1592 cd & restyp(itypi),i,restyp(itypj),j,
1593 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1594 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1595 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1598 C Calculate gradient components.
1599 e1=e1*eps1*eps2rt**2*eps3rt**2
1600 fac=-expon*(e1+evdwij)
1603 C Calculate radial part of the gradient
1607 C Calculate the angular part of the gradient and sum add the contributions
1608 C to the appropriate components of the Cartesian gradient.
1610 if (bb(itypi,itypj).gt.0) then
1624 C-----------------------------------------------------------------------------
1625 subroutine egb(evdw,evdw_p,evdw_m)
1627 C This subroutine calculates the interaction energy of nonbonded side chains
1628 C assuming the Gay-Berne potential of interaction.
1630 implicit real*8 (a-h,o-z)
1631 include 'DIMENSIONS'
1632 include 'COMMON.GEO'
1633 include 'COMMON.VAR'
1634 include 'COMMON.LOCAL'
1635 include 'COMMON.CHAIN'
1636 include 'COMMON.DERIV'
1637 include 'COMMON.NAMES'
1638 include 'COMMON.INTERACT'
1639 include 'COMMON.IOUNITS'
1640 include 'COMMON.CALC'
1641 include 'COMMON.CONTROL'
1642 include 'COMMON.SBRIDGE'
1645 ccccc energy_dec=.false.
1646 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1651 c if (icall.eq.0) lprn=.false.
1653 do i=iatsc_s,iatsc_e
1659 dxi=dc_norm(1,nres+i)
1660 dyi=dc_norm(2,nres+i)
1661 dzi=dc_norm(3,nres+i)
1662 c dsci_inv=dsc_inv(itypi)
1663 dsci_inv=vbld_inv(i+nres)
1664 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1665 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1667 C Calculate SC interaction energy.
1669 do iint=1,nint_gr(i)
1670 do j=istart(i,iint),iend(i,iint)
1671 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1672 call dyn_ssbond_ene(i,j,evdwij)
1674 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1675 & 'evdw',i,j,evdwij,' ss'
1679 c dscj_inv=dsc_inv(itypj)
1680 dscj_inv=vbld_inv(j+nres)
1681 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1682 c & 1.0d0/vbld(j+nres)
1683 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1684 sig0ij=sigma(itypi,itypj)
1685 chi1=chi(itypi,itypj)
1686 chi2=chi(itypj,itypi)
1693 alf12=0.5D0*(alf1+alf2)
1694 C For diagnostics only!!!
1707 dxj=dc_norm(1,nres+j)
1708 dyj=dc_norm(2,nres+j)
1709 dzj=dc_norm(3,nres+j)
1710 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1711 c write (iout,*) "j",j," dc_norm",
1712 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1713 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1715 C Calculate angle-dependent terms of energy and contributions to their
1719 sig=sig0ij*dsqrt(sigsq)
1720 rij_shift=1.0D0/rij-sig+sig0ij
1721 c for diagnostics; uncomment
1722 c rij_shift=1.2*sig0ij
1723 C I hate to put IF's in the loops, but here don't have another choice!!!!
1724 if (rij_shift.le.0.0D0) then
1726 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1727 cd & restyp(itypi),i,restyp(itypj),j,
1728 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1732 c---------------------------------------------------------------
1733 rij_shift=1.0D0/rij_shift
1734 fac=rij_shift**expon
1735 e1=fac*fac*aa(itypi,itypj)
1736 e2=fac*bb(itypi,itypj)
1737 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1738 eps2der=evdwij*eps3rt
1739 eps3der=evdwij*eps2rt
1740 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1741 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1742 evdwij=evdwij*eps2rt*eps3rt
1744 if (bb(itypi,itypj).gt.0) then
1745 evdw_p=evdw_p+evdwij
1747 evdw_m=evdw_m+evdwij
1753 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1754 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1755 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1756 & restyp(itypi),i,restyp(itypj),j,
1757 & epsi,sigm,chi1,chi2,chip1,chip2,
1758 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1759 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1763 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1766 C Calculate gradient components.
1767 e1=e1*eps1*eps2rt**2*eps3rt**2
1768 fac=-expon*(e1+evdwij)*rij_shift
1772 C Calculate the radial part of the gradient
1776 C Calculate angular part of the gradient.
1778 if (bb(itypi,itypj).gt.0) then
1790 c write (iout,*) "Number of loop steps in EGB:",ind
1791 cccc energy_dec=.false.
1794 C-----------------------------------------------------------------------------
1795 subroutine egbv(evdw,evdw_p,evdw_m)
1797 C This subroutine calculates the interaction energy of nonbonded side chains
1798 C assuming the Gay-Berne-Vorobjev potential of interaction.
1800 implicit real*8 (a-h,o-z)
1801 include 'DIMENSIONS'
1802 include 'COMMON.GEO'
1803 include 'COMMON.VAR'
1804 include 'COMMON.LOCAL'
1805 include 'COMMON.CHAIN'
1806 include 'COMMON.DERIV'
1807 include 'COMMON.NAMES'
1808 include 'COMMON.INTERACT'
1809 include 'COMMON.IOUNITS'
1810 include 'COMMON.CALC'
1811 common /srutu/ icall
1814 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1817 c if (icall.eq.0) lprn=.true.
1819 do i=iatsc_s,iatsc_e
1825 dxi=dc_norm(1,nres+i)
1826 dyi=dc_norm(2,nres+i)
1827 dzi=dc_norm(3,nres+i)
1828 c dsci_inv=dsc_inv(itypi)
1829 dsci_inv=vbld_inv(i+nres)
1831 C Calculate SC interaction energy.
1833 do iint=1,nint_gr(i)
1834 do j=istart(i,iint),iend(i,iint)
1837 c dscj_inv=dsc_inv(itypj)
1838 dscj_inv=vbld_inv(j+nres)
1839 sig0ij=sigma(itypi,itypj)
1840 r0ij=r0(itypi,itypj)
1841 chi1=chi(itypi,itypj)
1842 chi2=chi(itypj,itypi)
1849 alf12=0.5D0*(alf1+alf2)
1850 C For diagnostics only!!!
1863 dxj=dc_norm(1,nres+j)
1864 dyj=dc_norm(2,nres+j)
1865 dzj=dc_norm(3,nres+j)
1866 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1868 C Calculate angle-dependent terms of energy and contributions to their
1872 sig=sig0ij*dsqrt(sigsq)
1873 rij_shift=1.0D0/rij-sig+r0ij
1874 C I hate to put IF's in the loops, but here don't have another choice!!!!
1875 if (rij_shift.le.0.0D0) then
1880 c---------------------------------------------------------------
1881 rij_shift=1.0D0/rij_shift
1882 fac=rij_shift**expon
1883 e1=fac*fac*aa(itypi,itypj)
1884 e2=fac*bb(itypi,itypj)
1885 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1886 eps2der=evdwij*eps3rt
1887 eps3der=evdwij*eps2rt
1888 fac_augm=rrij**expon
1889 e_augm=augm(itypi,itypj)*fac_augm
1890 evdwij=evdwij*eps2rt*eps3rt
1892 if (bb(itypi,itypj).gt.0) then
1893 evdw_p=evdw_p+evdwij+e_augm
1895 evdw_m=evdw_m+evdwij+e_augm
1898 evdw=evdw+evdwij+e_augm
1901 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1902 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1903 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1904 & restyp(itypi),i,restyp(itypj),j,
1905 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1906 & chi1,chi2,chip1,chip2,
1907 & eps1,eps2rt**2,eps3rt**2,
1908 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1911 C Calculate gradient components.
1912 e1=e1*eps1*eps2rt**2*eps3rt**2
1913 fac=-expon*(e1+evdwij)*rij_shift
1915 fac=rij*fac-2*expon*rrij*e_augm
1916 C Calculate the radial part of the gradient
1920 C Calculate angular part of the gradient.
1922 if (bb(itypi,itypj).gt.0) then
1934 C-----------------------------------------------------------------------------
1935 subroutine sc_angular
1936 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1937 C om12. Called by ebp, egb, and egbv.
1939 include 'COMMON.CALC'
1940 include 'COMMON.IOUNITS'
1944 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1945 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1946 om12=dxi*dxj+dyi*dyj+dzi*dzj
1948 C Calculate eps1(om12) and its derivative in om12
1949 faceps1=1.0D0-om12*chiom12
1950 faceps1_inv=1.0D0/faceps1
1951 eps1=dsqrt(faceps1_inv)
1952 C Following variable is eps1*deps1/dom12
1953 eps1_om12=faceps1_inv*chiom12
1958 c write (iout,*) "om12",om12," eps1",eps1
1959 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1964 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1965 sigsq=1.0D0-facsig*faceps1_inv
1966 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1967 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1968 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1974 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1975 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1977 C Calculate eps2 and its derivatives in om1, om2, and om12.
1980 chipom12=chip12*om12
1981 facp=1.0D0-om12*chipom12
1983 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1984 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1985 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1986 C Following variable is the square root of eps2
1987 eps2rt=1.0D0-facp1*facp_inv
1988 C Following three variables are the derivatives of the square root of eps
1989 C in om1, om2, and om12.
1990 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1991 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1992 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1993 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1994 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1995 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1996 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1997 c & " eps2rt_om12",eps2rt_om12
1998 C Calculate whole angle-dependent part of epsilon and contributions
1999 C to its derivatives
2003 C----------------------------------------------------------------------------
2004 subroutine sc_grad_T
2005 implicit real*8 (a-h,o-z)
2006 include 'DIMENSIONS'
2007 include 'COMMON.CHAIN'
2008 include 'COMMON.DERIV'
2009 include 'COMMON.CALC'
2010 include 'COMMON.IOUNITS'
2011 double precision dcosom1(3),dcosom2(3)
2012 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2013 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2014 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2015 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2019 c eom12=evdwij*eps1_om12
2021 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2022 c & " sigder",sigder
2023 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2024 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2026 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2027 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2030 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2032 c write (iout,*) "gg",(gg(k),k=1,3)
2034 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
2035 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2036 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2037 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
2038 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2039 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2040 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2041 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2042 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2043 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2046 C Calculate the components of the gradient in DC and X
2050 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2054 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
2055 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
2060 C----------------------------------------------------------------------------
2062 implicit real*8 (a-h,o-z)
2063 include 'DIMENSIONS'
2064 include 'COMMON.CHAIN'
2065 include 'COMMON.DERIV'
2066 include 'COMMON.CALC'
2067 include 'COMMON.IOUNITS'
2068 double precision dcosom1(3),dcosom2(3)
2069 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2070 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2071 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2072 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2076 c eom12=evdwij*eps1_om12
2078 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2079 c & " sigder",sigder
2080 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2081 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2083 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2084 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2087 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2089 c write (iout,*) "gg",(gg(k),k=1,3)
2091 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2092 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2093 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2094 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2095 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2096 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2097 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2098 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2099 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2100 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2103 C Calculate the components of the gradient in DC and X
2107 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2111 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2112 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2116 C-----------------------------------------------------------------------
2117 subroutine e_softsphere(evdw)
2119 C This subroutine calculates the interaction energy of nonbonded side chains
2120 C assuming the LJ potential of interaction.
2122 implicit real*8 (a-h,o-z)
2123 include 'DIMENSIONS'
2124 parameter (accur=1.0d-10)
2125 include 'COMMON.GEO'
2126 include 'COMMON.VAR'
2127 include 'COMMON.LOCAL'
2128 include 'COMMON.CHAIN'
2129 include 'COMMON.DERIV'
2130 include 'COMMON.INTERACT'
2131 include 'COMMON.TORSION'
2132 include 'COMMON.SBRIDGE'
2133 include 'COMMON.NAMES'
2134 include 'COMMON.IOUNITS'
2135 include 'COMMON.CONTACTS'
2137 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2139 do i=iatsc_s,iatsc_e
2146 C Calculate SC interaction energy.
2148 do iint=1,nint_gr(i)
2149 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2150 cd & 'iend=',iend(i,iint)
2151 do j=istart(i,iint),iend(i,iint)
2156 rij=xj*xj+yj*yj+zj*zj
2157 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2158 r0ij=r0(itypi,itypj)
2160 c print *,i,j,r0ij,dsqrt(rij)
2161 if (rij.lt.r0ijsq) then
2162 evdwij=0.25d0*(rij-r0ijsq)**2
2170 C Calculate the components of the gradient in DC and X
2176 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2177 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2178 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2179 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2183 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2191 C--------------------------------------------------------------------------
2192 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2195 C Soft-sphere potential of p-p interaction
2197 implicit real*8 (a-h,o-z)
2198 include 'DIMENSIONS'
2199 include 'COMMON.CONTROL'
2200 include 'COMMON.IOUNITS'
2201 include 'COMMON.GEO'
2202 include 'COMMON.VAR'
2203 include 'COMMON.LOCAL'
2204 include 'COMMON.CHAIN'
2205 include 'COMMON.DERIV'
2206 include 'COMMON.INTERACT'
2207 include 'COMMON.CONTACTS'
2208 include 'COMMON.TORSION'
2209 include 'COMMON.VECTORS'
2210 include 'COMMON.FFIELD'
2212 cd write(iout,*) 'In EELEC_soft_sphere'
2219 do i=iatel_s,iatel_e
2223 xmedi=c(1,i)+0.5d0*dxi
2224 ymedi=c(2,i)+0.5d0*dyi
2225 zmedi=c(3,i)+0.5d0*dzi
2227 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2228 do j=ielstart(i),ielend(i)
2232 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2233 r0ij=rpp(iteli,itelj)
2238 xj=c(1,j)+0.5D0*dxj-xmedi
2239 yj=c(2,j)+0.5D0*dyj-ymedi
2240 zj=c(3,j)+0.5D0*dzj-zmedi
2241 rij=xj*xj+yj*yj+zj*zj
2242 if (rij.lt.r0ijsq) then
2243 evdw1ij=0.25d0*(rij-r0ijsq)**2
2251 C Calculate contributions to the Cartesian gradient.
2257 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2258 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2261 * Loop over residues i+1 thru j-1.
2265 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2270 cgrad do i=nnt,nct-1
2272 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2274 cgrad do j=i+1,nct-1
2276 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2282 c------------------------------------------------------------------------------
2283 subroutine vec_and_deriv
2284 implicit real*8 (a-h,o-z)
2285 include 'DIMENSIONS'
2289 include 'COMMON.IOUNITS'
2290 include 'COMMON.GEO'
2291 include 'COMMON.VAR'
2292 include 'COMMON.LOCAL'
2293 include 'COMMON.CHAIN'
2294 include 'COMMON.VECTORS'
2295 include 'COMMON.SETUP'
2296 include 'COMMON.TIME1'
2297 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2298 C Compute the local reference systems. For reference system (i), the
2299 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2300 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2302 do i=ivec_start,ivec_end
2306 if (i.eq.nres-1) then
2307 C Case of the last full residue
2308 C Compute the Z-axis
2309 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2310 costh=dcos(pi-theta(nres))
2311 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2315 C Compute the derivatives of uz
2317 uzder(2,1,1)=-dc_norm(3,i-1)
2318 uzder(3,1,1)= dc_norm(2,i-1)
2319 uzder(1,2,1)= dc_norm(3,i-1)
2321 uzder(3,2,1)=-dc_norm(1,i-1)
2322 uzder(1,3,1)=-dc_norm(2,i-1)
2323 uzder(2,3,1)= dc_norm(1,i-1)
2326 uzder(2,1,2)= dc_norm(3,i)
2327 uzder(3,1,2)=-dc_norm(2,i)
2328 uzder(1,2,2)=-dc_norm(3,i)
2330 uzder(3,2,2)= dc_norm(1,i)
2331 uzder(1,3,2)= dc_norm(2,i)
2332 uzder(2,3,2)=-dc_norm(1,i)
2334 C Compute the Y-axis
2337 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2339 C Compute the derivatives of uy
2342 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2343 & -dc_norm(k,i)*dc_norm(j,i-1)
2344 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2346 uyder(j,j,1)=uyder(j,j,1)-costh
2347 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2352 uygrad(l,k,j,i)=uyder(l,k,j)
2353 uzgrad(l,k,j,i)=uzder(l,k,j)
2357 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2358 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2359 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2360 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2363 C Compute the Z-axis
2364 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2365 costh=dcos(pi-theta(i+2))
2366 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2370 C Compute the derivatives of uz
2372 uzder(2,1,1)=-dc_norm(3,i+1)
2373 uzder(3,1,1)= dc_norm(2,i+1)
2374 uzder(1,2,1)= dc_norm(3,i+1)
2376 uzder(3,2,1)=-dc_norm(1,i+1)
2377 uzder(1,3,1)=-dc_norm(2,i+1)
2378 uzder(2,3,1)= dc_norm(1,i+1)
2381 uzder(2,1,2)= dc_norm(3,i)
2382 uzder(3,1,2)=-dc_norm(2,i)
2383 uzder(1,2,2)=-dc_norm(3,i)
2385 uzder(3,2,2)= dc_norm(1,i)
2386 uzder(1,3,2)= dc_norm(2,i)
2387 uzder(2,3,2)=-dc_norm(1,i)
2389 C Compute the Y-axis
2392 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2394 C Compute the derivatives of uy
2397 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2398 & -dc_norm(k,i)*dc_norm(j,i+1)
2399 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2401 uyder(j,j,1)=uyder(j,j,1)-costh
2402 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2407 uygrad(l,k,j,i)=uyder(l,k,j)
2408 uzgrad(l,k,j,i)=uzder(l,k,j)
2412 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2413 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2414 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2415 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2419 vbld_inv_temp(1)=vbld_inv(i+1)
2420 if (i.lt.nres-1) then
2421 vbld_inv_temp(2)=vbld_inv(i+2)
2423 vbld_inv_temp(2)=vbld_inv(i)
2428 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2429 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2434 #if defined(PARVEC) && defined(MPI)
2435 if (nfgtasks1.gt.1) then
2437 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2438 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2439 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2440 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2441 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2443 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2444 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2446 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2447 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2448 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2449 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2450 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2451 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2452 time_gather=time_gather+MPI_Wtime()-time00
2454 c if (fg_rank.eq.0) then
2455 c write (iout,*) "Arrays UY and UZ"
2457 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2464 C-----------------------------------------------------------------------------
2465 subroutine check_vecgrad
2466 implicit real*8 (a-h,o-z)
2467 include 'DIMENSIONS'
2468 include 'COMMON.IOUNITS'
2469 include 'COMMON.GEO'
2470 include 'COMMON.VAR'
2471 include 'COMMON.LOCAL'
2472 include 'COMMON.CHAIN'
2473 include 'COMMON.VECTORS'
2474 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2475 dimension uyt(3,maxres),uzt(3,maxres)
2476 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2477 double precision delta /1.0d-7/
2480 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2481 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2482 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2483 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2484 cd & (dc_norm(if90,i),if90=1,3)
2485 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2486 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2487 cd write(iout,'(a)')
2493 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2494 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2507 cd write (iout,*) 'i=',i
2509 erij(k)=dc_norm(k,i)
2513 dc_norm(k,i)=erij(k)
2515 dc_norm(j,i)=dc_norm(j,i)+delta
2516 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2518 c dc_norm(k,i)=dc_norm(k,i)/fac
2520 c write (iout,*) (dc_norm(k,i),k=1,3)
2521 c write (iout,*) (erij(k),k=1,3)
2524 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2525 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2526 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2527 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2529 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2530 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2531 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2534 dc_norm(k,i)=erij(k)
2537 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2538 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2539 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2540 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2541 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2542 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2543 cd write (iout,'(a)')
2548 C--------------------------------------------------------------------------
2549 subroutine set_matrices
2550 implicit real*8 (a-h,o-z)
2551 include 'DIMENSIONS'
2554 include "COMMON.SETUP"
2556 integer status(MPI_STATUS_SIZE)
2558 include 'COMMON.IOUNITS'
2559 include 'COMMON.GEO'
2560 include 'COMMON.VAR'
2561 include 'COMMON.LOCAL'
2562 include 'COMMON.CHAIN'
2563 include 'COMMON.DERIV'
2564 include 'COMMON.INTERACT'
2565 include 'COMMON.CONTACTS'
2566 include 'COMMON.TORSION'
2567 include 'COMMON.VECTORS'
2568 include 'COMMON.FFIELD'
2569 double precision auxvec(2),auxmat(2,2)
2571 C Compute the virtual-bond-torsional-angle dependent quantities needed
2572 C to calculate the el-loc multibody terms of various order.
2575 do i=ivec_start+2,ivec_end+2
2579 if (i .lt. nres+1) then
2616 if (i .gt. 3 .and. i .lt. nres+1) then
2617 obrot_der(1,i-2)=-sin1
2618 obrot_der(2,i-2)= cos1
2619 Ugder(1,1,i-2)= sin1
2620 Ugder(1,2,i-2)=-cos1
2621 Ugder(2,1,i-2)=-cos1
2622 Ugder(2,2,i-2)=-sin1
2625 obrot2_der(1,i-2)=-dwasin2
2626 obrot2_der(2,i-2)= dwacos2
2627 Ug2der(1,1,i-2)= dwasin2
2628 Ug2der(1,2,i-2)=-dwacos2
2629 Ug2der(2,1,i-2)=-dwacos2
2630 Ug2der(2,2,i-2)=-dwasin2
2632 obrot_der(1,i-2)=0.0d0
2633 obrot_der(2,i-2)=0.0d0
2634 Ugder(1,1,i-2)=0.0d0
2635 Ugder(1,2,i-2)=0.0d0
2636 Ugder(2,1,i-2)=0.0d0
2637 Ugder(2,2,i-2)=0.0d0
2638 obrot2_der(1,i-2)=0.0d0
2639 obrot2_der(2,i-2)=0.0d0
2640 Ug2der(1,1,i-2)=0.0d0
2641 Ug2der(1,2,i-2)=0.0d0
2642 Ug2der(2,1,i-2)=0.0d0
2643 Ug2der(2,2,i-2)=0.0d0
2645 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2646 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2647 iti = itortyp(itype(i-2))
2651 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2652 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2653 iti1 = itortyp(itype(i-1))
2657 cd write (iout,*) '*******i',i,' iti1',iti
2658 cd write (iout,*) 'b1',b1(:,iti)
2659 cd write (iout,*) 'b2',b2(:,iti)
2660 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2661 c if (i .gt. iatel_s+2) then
2662 if (i .gt. nnt+2) then
2663 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2664 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2665 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2667 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2668 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2669 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2670 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2671 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2682 DtUg2(l,k,i-2)=0.0d0
2686 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2687 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2689 muder(k,i-2)=Ub2der(k,i-2)
2691 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2692 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2693 iti1 = itortyp(itype(i-1))
2698 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2700 cd write (iout,*) 'mu ',mu(:,i-2)
2701 cd write (iout,*) 'mu1',mu1(:,i-2)
2702 cd write (iout,*) 'mu2',mu2(:,i-2)
2703 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2705 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2706 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2707 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2708 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2709 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2710 C Vectors and matrices dependent on a single virtual-bond dihedral.
2711 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2712 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2713 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2714 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2715 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2716 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2717 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2718 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2719 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2722 C Matrices dependent on two consecutive virtual-bond dihedrals.
2723 C The order of matrices is from left to right.
2724 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2726 c do i=max0(ivec_start,2),ivec_end
2728 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2729 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2730 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2731 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2732 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2733 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2734 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2735 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2738 #if defined(MPI) && defined(PARMAT)
2740 c if (fg_rank.eq.0) then
2741 write (iout,*) "Arrays UG and UGDER before GATHER"
2743 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2744 & ((ug(l,k,i),l=1,2),k=1,2),
2745 & ((ugder(l,k,i),l=1,2),k=1,2)
2747 write (iout,*) "Arrays UG2 and UG2DER"
2749 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2750 & ((ug2(l,k,i),l=1,2),k=1,2),
2751 & ((ug2der(l,k,i),l=1,2),k=1,2)
2753 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2755 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2756 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2757 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2759 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2761 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2762 & costab(i),sintab(i),costab2(i),sintab2(i)
2764 write (iout,*) "Array MUDER"
2766 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2770 if (nfgtasks.gt.1) then
2772 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2773 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2774 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2776 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2777 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2779 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2780 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2782 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2783 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2785 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2786 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2788 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2789 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2791 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2792 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2794 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2795 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2796 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2797 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2798 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2799 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2800 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2801 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2802 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2803 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2804 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2805 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2806 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2808 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2809 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2811 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2812 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2814 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2815 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2817 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2818 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2820 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2821 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2823 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2824 & ivec_count(fg_rank1),
2825 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2827 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2828 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2830 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2831 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2833 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2834 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2836 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2837 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2839 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2840 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2842 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2843 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2845 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2846 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2848 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2849 & ivec_count(fg_rank1),
2850 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2852 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2853 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2855 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2856 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2858 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2859 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2861 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2862 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2864 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2865 & ivec_count(fg_rank1),
2866 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2868 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2869 & ivec_count(fg_rank1),
2870 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2872 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2873 & ivec_count(fg_rank1),
2874 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2875 & MPI_MAT2,FG_COMM1,IERR)
2876 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2877 & ivec_count(fg_rank1),
2878 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2879 & MPI_MAT2,FG_COMM1,IERR)
2882 c Passes matrix info through the ring
2885 if (irecv.lt.0) irecv=nfgtasks1-1
2888 if (inext.ge.nfgtasks1) inext=0
2890 c write (iout,*) "isend",isend," irecv",irecv
2892 lensend=lentyp(isend)
2893 lenrecv=lentyp(irecv)
2894 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2895 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2896 c & MPI_ROTAT1(lensend),inext,2200+isend,
2897 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2898 c & iprev,2200+irecv,FG_COMM,status,IERR)
2899 c write (iout,*) "Gather ROTAT1"
2901 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2902 c & MPI_ROTAT2(lensend),inext,3300+isend,
2903 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2904 c & iprev,3300+irecv,FG_COMM,status,IERR)
2905 c write (iout,*) "Gather ROTAT2"
2907 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2908 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2909 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2910 & iprev,4400+irecv,FG_COMM,status,IERR)
2911 c write (iout,*) "Gather ROTAT_OLD"
2913 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2914 & MPI_PRECOMP11(lensend),inext,5500+isend,
2915 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2916 & iprev,5500+irecv,FG_COMM,status,IERR)
2917 c write (iout,*) "Gather PRECOMP11"
2919 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2920 & MPI_PRECOMP12(lensend),inext,6600+isend,
2921 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2922 & iprev,6600+irecv,FG_COMM,status,IERR)
2923 c write (iout,*) "Gather PRECOMP12"
2925 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2927 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2928 & MPI_ROTAT2(lensend),inext,7700+isend,
2929 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2930 & iprev,7700+irecv,FG_COMM,status,IERR)
2931 c write (iout,*) "Gather PRECOMP21"
2933 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2934 & MPI_PRECOMP22(lensend),inext,8800+isend,
2935 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2936 & iprev,8800+irecv,FG_COMM,status,IERR)
2937 c write (iout,*) "Gather PRECOMP22"
2939 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2940 & MPI_PRECOMP23(lensend),inext,9900+isend,
2941 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2942 & MPI_PRECOMP23(lenrecv),
2943 & iprev,9900+irecv,FG_COMM,status,IERR)
2944 c write (iout,*) "Gather PRECOMP23"
2949 if (irecv.lt.0) irecv=nfgtasks1-1
2952 time_gather=time_gather+MPI_Wtime()-time00
2955 c if (fg_rank.eq.0) then
2956 write (iout,*) "Arrays UG and UGDER"
2958 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2959 & ((ug(l,k,i),l=1,2),k=1,2),
2960 & ((ugder(l,k,i),l=1,2),k=1,2)
2962 write (iout,*) "Arrays UG2 and UG2DER"
2964 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2965 & ((ug2(l,k,i),l=1,2),k=1,2),
2966 & ((ug2der(l,k,i),l=1,2),k=1,2)
2968 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2970 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2971 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2972 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2974 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2976 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2977 & costab(i),sintab(i),costab2(i),sintab2(i)
2979 write (iout,*) "Array MUDER"
2981 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2987 cd iti = itortyp(itype(i))
2990 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2991 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2996 C--------------------------------------------------------------------------
2997 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2999 C This subroutine calculates the average interaction energy and its gradient
3000 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3001 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3002 C The potential depends both on the distance of peptide-group centers and on
3003 C the orientation of the CA-CA virtual bonds.
3005 implicit real*8 (a-h,o-z)
3009 include 'DIMENSIONS'
3010 include 'COMMON.CONTROL'
3011 include 'COMMON.SETUP'
3012 include 'COMMON.IOUNITS'
3013 include 'COMMON.GEO'
3014 include 'COMMON.VAR'
3015 include 'COMMON.LOCAL'
3016 include 'COMMON.CHAIN'
3017 include 'COMMON.DERIV'
3018 include 'COMMON.INTERACT'
3019 include 'COMMON.CONTACTS'
3020 include 'COMMON.TORSION'
3021 include 'COMMON.VECTORS'
3022 include 'COMMON.FFIELD'
3023 include 'COMMON.TIME1'
3024 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3025 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3026 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3027 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3028 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3029 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3031 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3033 double precision scal_el /1.0d0/
3035 double precision scal_el /0.5d0/
3038 C 13-go grudnia roku pamietnego...
3039 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3040 & 0.0d0,1.0d0,0.0d0,
3041 & 0.0d0,0.0d0,1.0d0/
3042 cd write(iout,*) 'In EELEC'
3044 cd write(iout,*) 'Type',i
3045 cd write(iout,*) 'B1',B1(:,i)
3046 cd write(iout,*) 'B2',B2(:,i)
3047 cd write(iout,*) 'CC',CC(:,:,i)
3048 cd write(iout,*) 'DD',DD(:,:,i)
3049 cd write(iout,*) 'EE',EE(:,:,i)
3051 cd call check_vecgrad
3053 if (icheckgrad.eq.1) then
3055 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3057 dc_norm(k,i)=dc(k,i)*fac
3059 c write (iout,*) 'i',i,' fac',fac
3062 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3063 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3064 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3065 c call vec_and_deriv
3071 time_mat=time_mat+MPI_Wtime()-time01
3075 cd write (iout,*) 'i=',i
3077 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3080 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3081 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3094 cd print '(a)','Enter EELEC'
3095 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3097 gel_loc_loc(i)=0.0d0
3102 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3104 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3106 do i=iturn3_start,iturn3_end
3110 dx_normi=dc_norm(1,i)
3111 dy_normi=dc_norm(2,i)
3112 dz_normi=dc_norm(3,i)
3113 xmedi=c(1,i)+0.5d0*dxi
3114 ymedi=c(2,i)+0.5d0*dyi
3115 zmedi=c(3,i)+0.5d0*dzi
3117 call eelecij(i,i+2,ees,evdw1,eel_loc)
3118 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3119 num_cont_hb(i)=num_conti
3121 do i=iturn4_start,iturn4_end
3125 dx_normi=dc_norm(1,i)
3126 dy_normi=dc_norm(2,i)
3127 dz_normi=dc_norm(3,i)
3128 xmedi=c(1,i)+0.5d0*dxi
3129 ymedi=c(2,i)+0.5d0*dyi
3130 zmedi=c(3,i)+0.5d0*dzi
3131 num_conti=num_cont_hb(i)
3132 call eelecij(i,i+3,ees,evdw1,eel_loc)
3133 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3134 num_cont_hb(i)=num_conti
3137 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3139 do i=iatel_s,iatel_e
3143 dx_normi=dc_norm(1,i)
3144 dy_normi=dc_norm(2,i)
3145 dz_normi=dc_norm(3,i)
3146 xmedi=c(1,i)+0.5d0*dxi
3147 ymedi=c(2,i)+0.5d0*dyi
3148 zmedi=c(3,i)+0.5d0*dzi
3149 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3150 num_conti=num_cont_hb(i)
3151 do j=ielstart(i),ielend(i)
3152 call eelecij(i,j,ees,evdw1,eel_loc)
3154 num_cont_hb(i)=num_conti
3156 c write (iout,*) "Number of loop steps in EELEC:",ind
3158 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3159 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3161 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3162 ccc eel_loc=eel_loc+eello_turn3
3163 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3166 C-------------------------------------------------------------------------------
3167 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3168 implicit real*8 (a-h,o-z)
3169 include 'DIMENSIONS'
3173 include 'COMMON.CONTROL'
3174 include 'COMMON.IOUNITS'
3175 include 'COMMON.GEO'
3176 include 'COMMON.VAR'
3177 include 'COMMON.LOCAL'
3178 include 'COMMON.CHAIN'
3179 include 'COMMON.DERIV'
3180 include 'COMMON.INTERACT'
3181 include 'COMMON.CONTACTS'
3182 include 'COMMON.TORSION'
3183 include 'COMMON.VECTORS'
3184 include 'COMMON.FFIELD'
3185 include 'COMMON.TIME1'
3186 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3187 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3188 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3189 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3190 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3191 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3193 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3195 double precision scal_el /1.0d0/
3197 double precision scal_el /0.5d0/
3200 C 13-go grudnia roku pamietnego...
3201 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3202 & 0.0d0,1.0d0,0.0d0,
3203 & 0.0d0,0.0d0,1.0d0/
3204 c time00=MPI_Wtime()
3205 cd write (iout,*) "eelecij",i,j
3209 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3210 aaa=app(iteli,itelj)
3211 bbb=bpp(iteli,itelj)
3212 ael6i=ael6(iteli,itelj)
3213 ael3i=ael3(iteli,itelj)
3217 dx_normj=dc_norm(1,j)
3218 dy_normj=dc_norm(2,j)
3219 dz_normj=dc_norm(3,j)
3220 xj=c(1,j)+0.5D0*dxj-xmedi
3221 yj=c(2,j)+0.5D0*dyj-ymedi
3222 zj=c(3,j)+0.5D0*dzj-zmedi
3223 rij=xj*xj+yj*yj+zj*zj
3229 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3230 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3231 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3232 fac=cosa-3.0D0*cosb*cosg
3234 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3235 if (j.eq.i+2) ev1=scal_el*ev1
3240 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3243 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3244 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3247 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3248 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3249 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3250 cd & xmedi,ymedi,zmedi,xj,yj,zj
3252 if (energy_dec) then
3253 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3254 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3258 C Calculate contributions to the Cartesian gradient.
3261 facvdw=-6*rrmij*(ev1+evdwij)
3262 facel=-3*rrmij*(el1+eesij)
3268 * Radial derivatives. First process both termini of the fragment (i,j)
3274 c ghalf=0.5D0*ggg(k)
3275 c gelc(k,i)=gelc(k,i)+ghalf
3276 c gelc(k,j)=gelc(k,j)+ghalf
3278 c 9/28/08 AL Gradient compotents will be summed only at the end
3280 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3281 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3284 * Loop over residues i+1 thru j-1.
3288 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3295 c ghalf=0.5D0*ggg(k)
3296 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3297 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3299 c 9/28/08 AL Gradient compotents will be summed only at the end
3301 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3302 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3305 * Loop over residues i+1 thru j-1.
3309 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3316 fac=-3*rrmij*(facvdw+facvdw+facel)
3321 * Radial derivatives. First process both termini of the fragment (i,j)
3327 c ghalf=0.5D0*ggg(k)
3328 c gelc(k,i)=gelc(k,i)+ghalf
3329 c gelc(k,j)=gelc(k,j)+ghalf
3331 c 9/28/08 AL Gradient compotents will be summed only at the end
3333 gelc_long(k,j)=gelc(k,j)+ggg(k)
3334 gelc_long(k,i)=gelc(k,i)-ggg(k)
3337 * Loop over residues i+1 thru j-1.
3341 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3344 c 9/28/08 AL Gradient compotents will be summed only at the end
3349 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3350 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3356 ecosa=2.0D0*fac3*fac1+fac4
3359 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3360 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3362 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3363 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3365 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3366 cd & (dcosg(k),k=1,3)
3368 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3371 c ghalf=0.5D0*ggg(k)
3372 c gelc(k,i)=gelc(k,i)+ghalf
3373 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3374 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3375 c gelc(k,j)=gelc(k,j)+ghalf
3376 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3377 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3381 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3386 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3387 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3389 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3390 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3391 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3392 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3394 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3395 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3396 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3398 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3399 C energy of a peptide unit is assumed in the form of a second-order
3400 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3401 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3402 C are computed for EVERY pair of non-contiguous peptide groups.
3404 if (j.lt.nres-1) then
3415 muij(kkk)=mu(k,i)*mu(l,j)
3418 cd write (iout,*) 'EELEC: i',i,' j',j
3419 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3420 cd write(iout,*) 'muij',muij
3421 ury=scalar(uy(1,i),erij)
3422 urz=scalar(uz(1,i),erij)
3423 vry=scalar(uy(1,j),erij)
3424 vrz=scalar(uz(1,j),erij)
3425 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3426 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3427 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3428 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3429 fac=dsqrt(-ael6i)*r3ij
3434 cd write (iout,'(4i5,4f10.5)')
3435 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3436 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3437 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3438 cd & uy(:,j),uz(:,j)
3439 cd write (iout,'(4f10.5)')
3440 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3441 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3442 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3443 cd write (iout,'(9f10.5/)')
3444 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3445 C Derivatives of the elements of A in virtual-bond vectors
3446 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3448 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3449 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3450 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3451 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3452 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3453 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3454 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3455 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3456 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3457 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3458 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3459 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3461 C Compute radial contributions to the gradient
3479 C Add the contributions coming from er
3482 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3483 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3484 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3485 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3488 C Derivatives in DC(i)
3489 cgrad ghalf1=0.5d0*agg(k,1)
3490 cgrad ghalf2=0.5d0*agg(k,2)
3491 cgrad ghalf3=0.5d0*agg(k,3)
3492 cgrad ghalf4=0.5d0*agg(k,4)
3493 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3494 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3495 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3496 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3497 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3498 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3499 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3500 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3501 C Derivatives in DC(i+1)
3502 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3503 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3504 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3505 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3506 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3507 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3508 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3509 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3510 C Derivatives in DC(j)
3511 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3512 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3513 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3514 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3515 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3516 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3517 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3518 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3519 C Derivatives in DC(j+1) or DC(nres-1)
3520 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3521 & -3.0d0*vryg(k,3)*ury)
3522 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3523 & -3.0d0*vrzg(k,3)*ury)
3524 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3525 & -3.0d0*vryg(k,3)*urz)
3526 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3527 & -3.0d0*vrzg(k,3)*urz)
3528 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3530 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3543 aggi(k,l)=-aggi(k,l)
3544 aggi1(k,l)=-aggi1(k,l)
3545 aggj(k,l)=-aggj(k,l)
3546 aggj1(k,l)=-aggj1(k,l)
3549 if (j.lt.nres-1) then
3555 aggi(k,l)=-aggi(k,l)
3556 aggi1(k,l)=-aggi1(k,l)
3557 aggj(k,l)=-aggj(k,l)
3558 aggj1(k,l)=-aggj1(k,l)
3569 aggi(k,l)=-aggi(k,l)
3570 aggi1(k,l)=-aggi1(k,l)
3571 aggj(k,l)=-aggj(k,l)
3572 aggj1(k,l)=-aggj1(k,l)
3577 IF (wel_loc.gt.0.0d0) THEN
3578 C Contribution to the local-electrostatic energy coming from the i-j pair
3579 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3581 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3583 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3584 & 'eelloc',i,j,eel_loc_ij
3586 eel_loc=eel_loc+eel_loc_ij
3587 C Partial derivatives in virtual-bond dihedral angles gamma
3589 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3590 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3591 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3592 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3593 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3594 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3595 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3597 ggg(l)=agg(l,1)*muij(1)+
3598 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3599 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3600 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3601 cgrad ghalf=0.5d0*ggg(l)
3602 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3603 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3607 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3610 C Remaining derivatives of eello
3612 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3613 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3614 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3615 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3616 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3617 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3618 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3619 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3622 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3623 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3624 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3625 & .and. num_conti.le.maxconts) then
3626 c write (iout,*) i,j," entered corr"
3628 C Calculate the contact function. The ith column of the array JCONT will
3629 C contain the numbers of atoms that make contacts with the atom I (of numbers
3630 C greater than I). The arrays FACONT and GACONT will contain the values of
3631 C the contact function and its derivative.
3632 c r0ij=1.02D0*rpp(iteli,itelj)
3633 c r0ij=1.11D0*rpp(iteli,itelj)
3634 r0ij=2.20D0*rpp(iteli,itelj)
3635 c r0ij=1.55D0*rpp(iteli,itelj)
3636 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3637 if (fcont.gt.0.0D0) then
3638 num_conti=num_conti+1
3639 if (num_conti.gt.maxconts) then
3640 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3641 & ' will skip next contacts for this conf.'
3643 jcont_hb(num_conti,i)=j
3644 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3645 cd & " jcont_hb",jcont_hb(num_conti,i)
3646 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3647 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3648 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3650 d_cont(num_conti,i)=rij
3651 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3652 C --- Electrostatic-interaction matrix ---
3653 a_chuj(1,1,num_conti,i)=a22
3654 a_chuj(1,2,num_conti,i)=a23
3655 a_chuj(2,1,num_conti,i)=a32
3656 a_chuj(2,2,num_conti,i)=a33
3657 C --- Gradient of rij
3659 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3666 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3667 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3668 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3669 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3670 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3675 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3676 C Calculate contact energies
3678 wij=cosa-3.0D0*cosb*cosg
3681 c fac3=dsqrt(-ael6i)/r0ij**3
3682 fac3=dsqrt(-ael6i)*r3ij
3683 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3684 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3685 if (ees0tmp.gt.0) then
3686 ees0pij=dsqrt(ees0tmp)
3690 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3691 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3692 if (ees0tmp.gt.0) then
3693 ees0mij=dsqrt(ees0tmp)
3698 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3699 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3700 C Diagnostics. Comment out or remove after debugging!
3701 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3702 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3703 c ees0m(num_conti,i)=0.0D0
3705 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3706 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3707 C Angular derivatives of the contact function
3708 ees0pij1=fac3/ees0pij
3709 ees0mij1=fac3/ees0mij
3710 fac3p=-3.0D0*fac3*rrmij
3711 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3712 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3714 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3715 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3716 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3717 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3718 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3719 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3720 ecosap=ecosa1+ecosa2
3721 ecosbp=ecosb1+ecosb2
3722 ecosgp=ecosg1+ecosg2
3723 ecosam=ecosa1-ecosa2
3724 ecosbm=ecosb1-ecosb2
3725 ecosgm=ecosg1-ecosg2
3734 facont_hb(num_conti,i)=fcont
3735 fprimcont=fprimcont/rij
3736 cd facont_hb(num_conti,i)=1.0D0
3737 C Following line is for diagnostics.
3740 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3741 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3744 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3745 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3747 gggp(1)=gggp(1)+ees0pijp*xj
3748 gggp(2)=gggp(2)+ees0pijp*yj
3749 gggp(3)=gggp(3)+ees0pijp*zj
3750 gggm(1)=gggm(1)+ees0mijp*xj
3751 gggm(2)=gggm(2)+ees0mijp*yj
3752 gggm(3)=gggm(3)+ees0mijp*zj
3753 C Derivatives due to the contact function
3754 gacont_hbr(1,num_conti,i)=fprimcont*xj
3755 gacont_hbr(2,num_conti,i)=fprimcont*yj
3756 gacont_hbr(3,num_conti,i)=fprimcont*zj
3759 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3760 c following the change of gradient-summation algorithm.
3762 cgrad ghalfp=0.5D0*gggp(k)
3763 cgrad ghalfm=0.5D0*gggm(k)
3764 gacontp_hb1(k,num_conti,i)=!ghalfp
3765 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3766 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3767 gacontp_hb2(k,num_conti,i)=!ghalfp
3768 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3769 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3770 gacontp_hb3(k,num_conti,i)=gggp(k)
3771 gacontm_hb1(k,num_conti,i)=!ghalfm
3772 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3773 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3774 gacontm_hb2(k,num_conti,i)=!ghalfm
3775 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3776 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3777 gacontm_hb3(k,num_conti,i)=gggm(k)
3779 C Diagnostics. Comment out or remove after debugging!
3781 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3782 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3783 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3784 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3785 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3786 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3789 endif ! num_conti.le.maxconts
3792 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3795 ghalf=0.5d0*agg(l,k)
3796 aggi(l,k)=aggi(l,k)+ghalf
3797 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3798 aggj(l,k)=aggj(l,k)+ghalf
3801 if (j.eq.nres-1 .and. i.lt.j-2) then
3804 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3809 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3812 C-----------------------------------------------------------------------------
3813 subroutine eturn3(i,eello_turn3)
3814 C Third- and fourth-order contributions from turns
3815 implicit real*8 (a-h,o-z)
3816 include 'DIMENSIONS'
3817 include 'COMMON.IOUNITS'
3818 include 'COMMON.GEO'
3819 include 'COMMON.VAR'
3820 include 'COMMON.LOCAL'
3821 include 'COMMON.CHAIN'
3822 include 'COMMON.DERIV'
3823 include 'COMMON.INTERACT'
3824 include 'COMMON.CONTACTS'
3825 include 'COMMON.TORSION'
3826 include 'COMMON.VECTORS'
3827 include 'COMMON.FFIELD'
3828 include 'COMMON.CONTROL'
3830 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3831 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3832 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3833 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3834 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3835 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3836 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3839 c write (iout,*) "eturn3",i,j,j1,j2
3844 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3846 C Third-order contributions
3853 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3854 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3855 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3856 call transpose2(auxmat(1,1),auxmat1(1,1))
3857 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3858 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3859 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3860 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3861 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3862 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3863 cd & ' eello_turn3_num',4*eello_turn3_num
3864 C Derivatives in gamma(i)
3865 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3866 call transpose2(auxmat2(1,1),auxmat3(1,1))
3867 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3868 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3869 C Derivatives in gamma(i+1)
3870 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3871 call transpose2(auxmat2(1,1),auxmat3(1,1))
3872 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3873 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3874 & +0.5d0*(pizda(1,1)+pizda(2,2))
3875 C Cartesian derivatives
3877 c ghalf1=0.5d0*agg(l,1)
3878 c ghalf2=0.5d0*agg(l,2)
3879 c ghalf3=0.5d0*agg(l,3)
3880 c ghalf4=0.5d0*agg(l,4)
3881 a_temp(1,1)=aggi(l,1)!+ghalf1
3882 a_temp(1,2)=aggi(l,2)!+ghalf2
3883 a_temp(2,1)=aggi(l,3)!+ghalf3
3884 a_temp(2,2)=aggi(l,4)!+ghalf4
3885 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3886 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3887 & +0.5d0*(pizda(1,1)+pizda(2,2))
3888 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3889 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3890 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3891 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3892 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3893 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3894 & +0.5d0*(pizda(1,1)+pizda(2,2))
3895 a_temp(1,1)=aggj(l,1)!+ghalf1
3896 a_temp(1,2)=aggj(l,2)!+ghalf2
3897 a_temp(2,1)=aggj(l,3)!+ghalf3
3898 a_temp(2,2)=aggj(l,4)!+ghalf4
3899 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3900 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3901 & +0.5d0*(pizda(1,1)+pizda(2,2))
3902 a_temp(1,1)=aggj1(l,1)
3903 a_temp(1,2)=aggj1(l,2)
3904 a_temp(2,1)=aggj1(l,3)
3905 a_temp(2,2)=aggj1(l,4)
3906 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3907 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3908 & +0.5d0*(pizda(1,1)+pizda(2,2))
3912 C-------------------------------------------------------------------------------
3913 subroutine eturn4(i,eello_turn4)
3914 C Third- and fourth-order contributions from turns
3915 implicit real*8 (a-h,o-z)
3916 include 'DIMENSIONS'
3917 include 'COMMON.IOUNITS'
3918 include 'COMMON.GEO'
3919 include 'COMMON.VAR'
3920 include 'COMMON.LOCAL'
3921 include 'COMMON.CHAIN'
3922 include 'COMMON.DERIV'
3923 include 'COMMON.INTERACT'
3924 include 'COMMON.CONTACTS'
3925 include 'COMMON.TORSION'
3926 include 'COMMON.VECTORS'
3927 include 'COMMON.FFIELD'
3928 include 'COMMON.CONTROL'
3930 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3931 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3932 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3933 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3934 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3935 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3936 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3939 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3941 C Fourth-order contributions
3949 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3950 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3951 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3956 iti1=itortyp(itype(i+1))
3957 iti2=itortyp(itype(i+2))
3958 iti3=itortyp(itype(i+3))
3959 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3960 call transpose2(EUg(1,1,i+1),e1t(1,1))
3961 call transpose2(Eug(1,1,i+2),e2t(1,1))
3962 call transpose2(Eug(1,1,i+3),e3t(1,1))
3963 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3964 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3965 s1=scalar2(b1(1,iti2),auxvec(1))
3966 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3967 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3968 s2=scalar2(b1(1,iti1),auxvec(1))
3969 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3970 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3971 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3972 eello_turn4=eello_turn4-(s1+s2+s3)
3973 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3974 & 'eturn4',i,j,-(s1+s2+s3)
3975 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3976 cd & ' eello_turn4_num',8*eello_turn4_num
3977 C Derivatives in gamma(i)
3978 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3979 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3980 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3981 s1=scalar2(b1(1,iti2),auxvec(1))
3982 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3983 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3984 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3985 C Derivatives in gamma(i+1)
3986 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3987 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3988 s2=scalar2(b1(1,iti1),auxvec(1))
3989 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3990 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3991 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3992 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3993 C Derivatives in gamma(i+2)
3994 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3995 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3996 s1=scalar2(b1(1,iti2),auxvec(1))
3997 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3998 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3999 s2=scalar2(b1(1,iti1),auxvec(1))
4000 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4001 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4002 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4003 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4004 C Cartesian derivatives
4005 C Derivatives of this turn contributions in DC(i+2)
4006 if (j.lt.nres-1) then
4008 a_temp(1,1)=agg(l,1)
4009 a_temp(1,2)=agg(l,2)
4010 a_temp(2,1)=agg(l,3)
4011 a_temp(2,2)=agg(l,4)
4012 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4013 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4014 s1=scalar2(b1(1,iti2),auxvec(1))
4015 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4016 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4017 s2=scalar2(b1(1,iti1),auxvec(1))
4018 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4019 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4020 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4022 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4025 C Remaining derivatives of this turn contribution
4027 a_temp(1,1)=aggi(l,1)
4028 a_temp(1,2)=aggi(l,2)
4029 a_temp(2,1)=aggi(l,3)
4030 a_temp(2,2)=aggi(l,4)
4031 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4032 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4033 s1=scalar2(b1(1,iti2),auxvec(1))
4034 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4035 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4036 s2=scalar2(b1(1,iti1),auxvec(1))
4037 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4038 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4039 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4040 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4041 a_temp(1,1)=aggi1(l,1)
4042 a_temp(1,2)=aggi1(l,2)
4043 a_temp(2,1)=aggi1(l,3)
4044 a_temp(2,2)=aggi1(l,4)
4045 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4046 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4047 s1=scalar2(b1(1,iti2),auxvec(1))
4048 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4049 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4050 s2=scalar2(b1(1,iti1),auxvec(1))
4051 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4052 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4053 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4054 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4055 a_temp(1,1)=aggj(l,1)
4056 a_temp(1,2)=aggj(l,2)
4057 a_temp(2,1)=aggj(l,3)
4058 a_temp(2,2)=aggj(l,4)
4059 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4060 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4061 s1=scalar2(b1(1,iti2),auxvec(1))
4062 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4063 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4064 s2=scalar2(b1(1,iti1),auxvec(1))
4065 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4066 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4067 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4068 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4069 a_temp(1,1)=aggj1(l,1)
4070 a_temp(1,2)=aggj1(l,2)
4071 a_temp(2,1)=aggj1(l,3)
4072 a_temp(2,2)=aggj1(l,4)
4073 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4074 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4075 s1=scalar2(b1(1,iti2),auxvec(1))
4076 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4077 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4078 s2=scalar2(b1(1,iti1),auxvec(1))
4079 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4080 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4081 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4082 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4083 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4087 C-----------------------------------------------------------------------------
4088 subroutine vecpr(u,v,w)
4089 implicit real*8(a-h,o-z)
4090 dimension u(3),v(3),w(3)
4091 w(1)=u(2)*v(3)-u(3)*v(2)
4092 w(2)=-u(1)*v(3)+u(3)*v(1)
4093 w(3)=u(1)*v(2)-u(2)*v(1)
4096 C-----------------------------------------------------------------------------
4097 subroutine unormderiv(u,ugrad,unorm,ungrad)
4098 C This subroutine computes the derivatives of a normalized vector u, given
4099 C the derivatives computed without normalization conditions, ugrad. Returns
4102 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4103 double precision vec(3)
4104 double precision scalar
4106 c write (2,*) 'ugrad',ugrad
4109 vec(i)=scalar(ugrad(1,i),u(1))
4111 c write (2,*) 'vec',vec
4114 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4117 c write (2,*) 'ungrad',ungrad
4120 C-----------------------------------------------------------------------------
4121 subroutine escp_soft_sphere(evdw2,evdw2_14)
4123 C This subroutine calculates the excluded-volume interaction energy between
4124 C peptide-group centers and side chains and its gradient in virtual-bond and
4125 C side-chain vectors.
4127 implicit real*8 (a-h,o-z)
4128 include 'DIMENSIONS'
4129 include 'COMMON.GEO'
4130 include 'COMMON.VAR'
4131 include 'COMMON.LOCAL'
4132 include 'COMMON.CHAIN'
4133 include 'COMMON.DERIV'
4134 include 'COMMON.INTERACT'
4135 include 'COMMON.FFIELD'
4136 include 'COMMON.IOUNITS'
4137 include 'COMMON.CONTROL'
4142 cd print '(a)','Enter ESCP'
4143 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4144 do i=iatscp_s,iatscp_e
4146 xi=0.5D0*(c(1,i)+c(1,i+1))
4147 yi=0.5D0*(c(2,i)+c(2,i+1))
4148 zi=0.5D0*(c(3,i)+c(3,i+1))
4150 do iint=1,nscp_gr(i)
4152 do j=iscpstart(i,iint),iscpend(i,iint)
4154 C Uncomment following three lines for SC-p interactions
4158 C Uncomment following three lines for Ca-p interactions
4162 rij=xj*xj+yj*yj+zj*zj
4165 if (rij.lt.r0ijsq) then
4166 evdwij=0.25d0*(rij-r0ijsq)**2
4174 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4179 cgrad if (j.lt.i) then
4180 cd write (iout,*) 'j<i'
4181 C Uncomment following three lines for SC-p interactions
4183 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4186 cd write (iout,*) 'j>i'
4188 cgrad ggg(k)=-ggg(k)
4189 C Uncomment following line for SC-p interactions
4190 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4194 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4196 cgrad kstart=min0(i+1,j)
4197 cgrad kend=max0(i-1,j-1)
4198 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4199 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4200 cgrad do k=kstart,kend
4202 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4206 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4207 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4215 C-----------------------------------------------------------------------------
4216 subroutine escp(evdw2,evdw2_14)
4218 C This subroutine calculates the excluded-volume interaction energy between
4219 C peptide-group centers and side chains and its gradient in virtual-bond and
4220 C side-chain vectors.
4222 implicit real*8 (a-h,o-z)
4223 include 'DIMENSIONS'
4224 include 'COMMON.GEO'
4225 include 'COMMON.VAR'
4226 include 'COMMON.LOCAL'
4227 include 'COMMON.CHAIN'
4228 include 'COMMON.DERIV'
4229 include 'COMMON.INTERACT'
4230 include 'COMMON.FFIELD'
4231 include 'COMMON.IOUNITS'
4232 include 'COMMON.CONTROL'
4236 cd print '(a)','Enter ESCP'
4237 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4238 do i=iatscp_s,iatscp_e
4240 xi=0.5D0*(c(1,i)+c(1,i+1))
4241 yi=0.5D0*(c(2,i)+c(2,i+1))
4242 zi=0.5D0*(c(3,i)+c(3,i+1))
4244 do iint=1,nscp_gr(i)
4246 do j=iscpstart(i,iint),iscpend(i,iint)
4248 C Uncomment following three lines for SC-p interactions
4252 C Uncomment following three lines for Ca-p interactions
4256 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4258 e1=fac*fac*aad(itypj,iteli)
4259 e2=fac*bad(itypj,iteli)
4260 if (iabs(j-i) .le. 2) then
4263 evdw2_14=evdw2_14+e1+e2
4267 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4268 & 'evdw2',i,j,evdwij
4270 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4272 fac=-(evdwij+e1)*rrij
4276 cgrad if (j.lt.i) then
4277 cd write (iout,*) 'j<i'
4278 C Uncomment following three lines for SC-p interactions
4280 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4283 cd write (iout,*) 'j>i'
4285 cgrad ggg(k)=-ggg(k)
4286 C Uncomment following line for SC-p interactions
4287 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4288 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4292 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4294 cgrad kstart=min0(i+1,j)
4295 cgrad kend=max0(i-1,j-1)
4296 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4297 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4298 cgrad do k=kstart,kend
4300 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4304 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4305 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4313 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4314 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4315 gradx_scp(j,i)=expon*gradx_scp(j,i)
4318 C******************************************************************************
4322 C To save time the factor EXPON has been extracted from ALL components
4323 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4326 C******************************************************************************
4329 C--------------------------------------------------------------------------
4330 subroutine edis(ehpb)
4332 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4334 implicit real*8 (a-h,o-z)
4335 include 'DIMENSIONS'
4336 include 'COMMON.SBRIDGE'
4337 include 'COMMON.CHAIN'
4338 include 'COMMON.DERIV'
4339 include 'COMMON.VAR'
4340 include 'COMMON.INTERACT'
4341 include 'COMMON.IOUNITS'
4344 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4345 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4346 if (link_end.eq.0) return
4347 do i=link_start,link_end
4348 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4349 C CA-CA distance used in regularization of structure.
4352 C iii and jjj point to the residues for which the distance is assigned.
4353 if (ii.gt.nres) then
4360 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4361 c & dhpb(i),dhpb1(i),forcon(i)
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 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4365 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4366 if (.not.dyn_ss .and. i.le.nss) then
4367 C 15/02/13 CC dynamic SSbond - additional check
4369 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4370 call ssbond_ene(iii,jjj,eij)
4373 cd write (iout,*) "eij",eij
4374 else if (ii.gt.nres .and. jj.gt.nres) then
4375 c Restraints from contact prediction
4377 if (dhpb1(i).gt.0.0d0) then
4378 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4379 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4380 c write (iout,*) "beta nmr",
4381 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4385 C Get the force constant corresponding to this distance.
4387 C Calculate the contribution to energy.
4388 ehpb=ehpb+waga*rdis*rdis
4389 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4391 C Evaluate gradient.
4396 ggg(j)=fac*(c(j,jj)-c(j,ii))
4399 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4400 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4403 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4404 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4407 C Calculate the distance between the two points and its difference from the
4410 if (dhpb1(i).gt.0.0d0) then
4411 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4412 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4413 c write (iout,*) "alph nmr",
4414 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4417 C Get the force constant corresponding to this distance.
4419 C Calculate the contribution to energy.
4420 ehpb=ehpb+waga*rdis*rdis
4421 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4423 C Evaluate gradient.
4427 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4428 cd & ' waga=',waga,' fac=',fac
4430 ggg(j)=fac*(c(j,jj)-c(j,ii))
4432 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4433 C If this is a SC-SC distance, we need to calculate the contributions to the
4434 C Cartesian gradient in the SC vectors (ghpbx).
4437 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4438 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4441 cgrad do j=iii,jjj-1
4443 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4447 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4448 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4455 C--------------------------------------------------------------------------
4456 subroutine ssbond_ene(i,j,eij)
4458 C Calculate the distance and angle dependent SS-bond potential energy
4459 C using a free-energy function derived based on RHF/6-31G** ab initio
4460 C calculations of diethyl disulfide.
4462 C A. Liwo and U. Kozlowska, 11/24/03
4464 implicit real*8 (a-h,o-z)
4465 include 'DIMENSIONS'
4466 include 'COMMON.SBRIDGE'
4467 include 'COMMON.CHAIN'
4468 include 'COMMON.DERIV'
4469 include 'COMMON.LOCAL'
4470 include 'COMMON.INTERACT'
4471 include 'COMMON.VAR'
4472 include 'COMMON.IOUNITS'
4473 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4478 dxi=dc_norm(1,nres+i)
4479 dyi=dc_norm(2,nres+i)
4480 dzi=dc_norm(3,nres+i)
4481 c dsci_inv=dsc_inv(itypi)
4482 dsci_inv=vbld_inv(nres+i)
4484 c dscj_inv=dsc_inv(itypj)
4485 dscj_inv=vbld_inv(nres+j)
4489 dxj=dc_norm(1,nres+j)
4490 dyj=dc_norm(2,nres+j)
4491 dzj=dc_norm(3,nres+j)
4492 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4497 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4498 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4499 om12=dxi*dxj+dyi*dyj+dzi*dzj
4501 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4502 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4508 deltat12=om2-om1+2.0d0
4510 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4511 & +akct*deltad*deltat12+ebr
4512 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4513 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4514 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4515 c & " deltat12",deltat12," eij",eij
4516 ed=2*akcm*deltad+akct*deltat12
4518 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4519 eom1=-2*akth*deltat1-pom1-om2*pom2
4520 eom2= 2*akth*deltat2+pom1-om1*pom2
4523 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4524 ghpbx(k,i)=ghpbx(k,i)-ggk
4525 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4526 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4527 ghpbx(k,j)=ghpbx(k,j)+ggk
4528 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4529 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4530 ghpbc(k,i)=ghpbc(k,i)-ggk
4531 ghpbc(k,j)=ghpbc(k,j)+ggk
4534 C Calculate the components of the gradient in DC and X
4538 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4543 C--------------------------------------------------------------------------
4544 subroutine ebond(estr)
4546 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4548 implicit real*8 (a-h,o-z)
4549 include 'DIMENSIONS'
4550 include 'COMMON.LOCAL'
4551 include 'COMMON.GEO'
4552 include 'COMMON.INTERACT'
4553 include 'COMMON.DERIV'
4554 include 'COMMON.VAR'
4555 include 'COMMON.CHAIN'
4556 include 'COMMON.IOUNITS'
4557 include 'COMMON.NAMES'
4558 include 'COMMON.FFIELD'
4559 include 'COMMON.CONTROL'
4560 include 'COMMON.SETUP'
4561 double precision u(3),ud(3)
4563 do i=ibondp_start,ibondp_end
4564 diff = vbld(i)-vbldp0
4565 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4568 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4570 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4574 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4576 do i=ibond_start,ibond_end
4581 diff=vbld(i+nres)-vbldsc0(1,iti)
4582 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4583 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4584 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4586 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4590 diff=vbld(i+nres)-vbldsc0(j,iti)
4591 ud(j)=aksc(j,iti)*diff
4592 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4606 uprod2=uprod2*u(k)*u(k)
4610 usumsqder=usumsqder+ud(j)*uprod2
4612 estr=estr+uprod/usum
4614 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4622 C--------------------------------------------------------------------------
4623 subroutine ebend(etheta)
4625 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4626 C angles gamma and its derivatives in consecutive thetas and gammas.
4628 implicit real*8 (a-h,o-z)
4629 include 'DIMENSIONS'
4630 include 'COMMON.LOCAL'
4631 include 'COMMON.GEO'
4632 include 'COMMON.INTERACT'
4633 include 'COMMON.DERIV'
4634 include 'COMMON.VAR'
4635 include 'COMMON.CHAIN'
4636 include 'COMMON.IOUNITS'
4637 include 'COMMON.NAMES'
4638 include 'COMMON.FFIELD'
4639 include 'COMMON.CONTROL'
4640 common /calcthet/ term1,term2,termm,diffak,ratak,
4641 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4642 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4643 double precision y(2),z(2)
4645 c time11=dexp(-2*time)
4648 c write (*,'(a,i2)') 'EBEND ICG=',icg
4649 do i=ithet_start,ithet_end
4650 C Zero the energy function and its derivative at 0 or pi.
4651 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4656 if (phii.ne.phii) phii=150.0
4669 if (phii1.ne.phii1) phii1=150.0
4681 C Calculate the "mean" value of theta from the part of the distribution
4682 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4683 C In following comments this theta will be referred to as t_c.
4684 thet_pred_mean=0.0d0
4688 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4690 dthett=thet_pred_mean*ssd
4691 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4692 C Derivatives of the "mean" values in gamma1 and gamma2.
4693 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4694 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4695 if (theta(i).gt.pi-delta) then
4696 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4698 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4699 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4700 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4702 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4704 else if (theta(i).lt.delta) then
4705 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4706 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4707 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4709 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4710 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4713 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4716 etheta=etheta+ethetai
4717 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4719 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4720 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4721 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4723 C Ufff.... We've done all this!!!
4726 C---------------------------------------------------------------------------
4727 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4729 implicit real*8 (a-h,o-z)
4730 include 'DIMENSIONS'
4731 include 'COMMON.LOCAL'
4732 include 'COMMON.IOUNITS'
4733 common /calcthet/ term1,term2,termm,diffak,ratak,
4734 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4735 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4736 C Calculate the contributions to both Gaussian lobes.
4737 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4738 C The "polynomial part" of the "standard deviation" of this part of
4742 sig=sig*thet_pred_mean+polthet(j,it)
4744 C Derivative of the "interior part" of the "standard deviation of the"
4745 C gamma-dependent Gaussian lobe in t_c.
4746 sigtc=3*polthet(3,it)
4748 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4751 C Set the parameters of both Gaussian lobes of the distribution.
4752 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4753 fac=sig*sig+sigc0(it)
4756 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4757 sigsqtc=-4.0D0*sigcsq*sigtc
4758 c print *,i,sig,sigtc,sigsqtc
4759 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4760 sigtc=-sigtc/(fac*fac)
4761 C Following variable is sigma(t_c)**(-2)
4762 sigcsq=sigcsq*sigcsq
4764 sig0inv=1.0D0/sig0i**2
4765 delthec=thetai-thet_pred_mean
4766 delthe0=thetai-theta0i
4767 term1=-0.5D0*sigcsq*delthec*delthec
4768 term2=-0.5D0*sig0inv*delthe0*delthe0
4769 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4770 C NaNs in taking the logarithm. We extract the largest exponent which is added
4771 C to the energy (this being the log of the distribution) at the end of energy
4772 C term evaluation for this virtual-bond angle.
4773 if (term1.gt.term2) then
4775 term2=dexp(term2-termm)
4779 term1=dexp(term1-termm)
4782 C The ratio between the gamma-independent and gamma-dependent lobes of
4783 C the distribution is a Gaussian function of thet_pred_mean too.
4784 diffak=gthet(2,it)-thet_pred_mean
4785 ratak=diffak/gthet(3,it)**2
4786 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4787 C Let's differentiate it in thet_pred_mean NOW.
4789 C Now put together the distribution terms to make complete distribution.
4790 termexp=term1+ak*term2
4791 termpre=sigc+ak*sig0i
4792 C Contribution of the bending energy from this theta is just the -log of
4793 C the sum of the contributions from the two lobes and the pre-exponential
4794 C factor. Simple enough, isn't it?
4795 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4796 C NOW the derivatives!!!
4797 C 6/6/97 Take into account the deformation.
4798 E_theta=(delthec*sigcsq*term1
4799 & +ak*delthe0*sig0inv*term2)/termexp
4800 E_tc=((sigtc+aktc*sig0i)/termpre
4801 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4802 & aktc*term2)/termexp)
4805 c-----------------------------------------------------------------------------
4806 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4807 implicit real*8 (a-h,o-z)
4808 include 'DIMENSIONS'
4809 include 'COMMON.LOCAL'
4810 include 'COMMON.IOUNITS'
4811 common /calcthet/ term1,term2,termm,diffak,ratak,
4812 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4813 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4814 delthec=thetai-thet_pred_mean
4815 delthe0=thetai-theta0i
4816 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4817 t3 = thetai-thet_pred_mean
4821 t14 = t12+t6*sigsqtc
4823 t21 = thetai-theta0i
4829 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4830 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4831 & *(-t12*t9-ak*sig0inv*t27)
4835 C--------------------------------------------------------------------------
4836 subroutine ebend(etheta)
4838 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4839 C angles gamma and its derivatives in consecutive thetas and gammas.
4840 C ab initio-derived potentials from
4841 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4843 implicit real*8 (a-h,o-z)
4844 include 'DIMENSIONS'
4845 include 'COMMON.LOCAL'
4846 include 'COMMON.GEO'
4847 include 'COMMON.INTERACT'
4848 include 'COMMON.DERIV'
4849 include 'COMMON.VAR'
4850 include 'COMMON.CHAIN'
4851 include 'COMMON.IOUNITS'
4852 include 'COMMON.NAMES'
4853 include 'COMMON.FFIELD'
4854 include 'COMMON.CONTROL'
4855 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4856 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4857 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4858 & sinph1ph2(maxdouble,maxdouble)
4859 logical lprn /.false./, lprn1 /.false./
4861 do i=ithet_start,ithet_end
4865 theti2=0.5d0*theta(i)
4866 ityp2=ithetyp(itype(i-1))
4868 coskt(k)=dcos(k*theti2)
4869 sinkt(k)=dsin(k*theti2)
4874 if (phii.ne.phii) phii=150.0
4878 ityp1=ithetyp(itype(i-2))
4880 cosph1(k)=dcos(k*phii)
4881 sinph1(k)=dsin(k*phii)
4894 if (phii1.ne.phii1) phii1=150.0
4899 ityp3=ithetyp(itype(i))
4901 cosph2(k)=dcos(k*phii1)
4902 sinph2(k)=dsin(k*phii1)
4912 ethetai=aa0thet(ityp1,ityp2,ityp3)
4915 ccl=cosph1(l)*cosph2(k-l)
4916 ssl=sinph1(l)*sinph2(k-l)
4917 scl=sinph1(l)*cosph2(k-l)
4918 csl=cosph1(l)*sinph2(k-l)
4919 cosph1ph2(l,k)=ccl-ssl
4920 cosph1ph2(k,l)=ccl+ssl
4921 sinph1ph2(l,k)=scl+csl
4922 sinph1ph2(k,l)=scl-csl
4926 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4927 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4928 write (iout,*) "coskt and sinkt"
4930 write (iout,*) k,coskt(k),sinkt(k)
4934 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4935 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4938 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4939 & " ethetai",ethetai
4942 write (iout,*) "cosph and sinph"
4944 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4946 write (iout,*) "cosph1ph2 and sinph2ph2"
4949 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4950 & sinph1ph2(l,k),sinph1ph2(k,l)
4953 write(iout,*) "ethetai",ethetai
4957 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4958 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4959 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4960 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4961 ethetai=ethetai+sinkt(m)*aux
4962 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4963 dephii=dephii+k*sinkt(m)*(
4964 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4965 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4966 dephii1=dephii1+k*sinkt(m)*(
4967 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4968 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4970 & write (iout,*) "m",m," k",k," bbthet",
4971 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4972 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4973 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4974 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4978 & write(iout,*) "ethetai",ethetai
4982 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4983 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4984 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4985 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4986 ethetai=ethetai+sinkt(m)*aux
4987 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4988 dephii=dephii+l*sinkt(m)*(
4989 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4990 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4991 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4992 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4993 dephii1=dephii1+(k-l)*sinkt(m)*(
4994 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4995 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4996 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4997 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4999 write (iout,*) "m",m," k",k," l",l," ffthet",
5000 & ffthet(l,k,m,ityp1,ityp2,ityp3),
5001 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
5002 & ggthet(l,k,m,ityp1,ityp2,ityp3),
5003 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5004 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5005 & cosph1ph2(k,l)*sinkt(m),
5006 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5013 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
5014 & 'ebe', i,theta(i)*rad2deg,phii*rad2deg,
5015 & phii1*rad2deg,ethetai
5017 etheta=etheta+ethetai
5018 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5019 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5020 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5026 c-----------------------------------------------------------------------------
5027 subroutine esc(escloc)
5028 C Calculate the local energy of a side chain and its derivatives in the
5029 C corresponding virtual-bond valence angles THETA and the spherical angles
5031 implicit real*8 (a-h,o-z)
5032 include 'DIMENSIONS'
5033 include 'COMMON.GEO'
5034 include 'COMMON.LOCAL'
5035 include 'COMMON.VAR'
5036 include 'COMMON.INTERACT'
5037 include 'COMMON.DERIV'
5038 include 'COMMON.CHAIN'
5039 include 'COMMON.IOUNITS'
5040 include 'COMMON.NAMES'
5041 include 'COMMON.FFIELD'
5042 include 'COMMON.CONTROL'
5043 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5044 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5045 common /sccalc/ time11,time12,time112,theti,it,nlobit
5048 c write (iout,'(a)') 'ESC'
5049 do i=loc_start,loc_end
5051 if (it.eq.10) goto 1
5053 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5054 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5055 theti=theta(i+1)-pipol
5060 if (x(2).gt.pi-delta) then
5064 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5066 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5067 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5069 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5070 & ddersc0(1),dersc(1))
5071 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5072 & ddersc0(3),dersc(3))
5074 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5076 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5077 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5078 & dersc0(2),esclocbi,dersc02)
5079 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5081 call splinthet(x(2),0.5d0*delta,ss,ssd)
5086 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5088 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5089 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5091 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5093 c write (iout,*) escloci
5094 else if (x(2).lt.delta) then
5098 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5100 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5101 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5103 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5104 & ddersc0(1),dersc(1))
5105 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5106 & ddersc0(3),dersc(3))
5108 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5110 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5111 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5112 & dersc0(2),esclocbi,dersc02)
5113 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5118 call splinthet(x(2),0.5d0*delta,ss,ssd)
5120 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5122 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5123 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5125 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5126 c write (iout,*) escloci
5128 call enesc(x,escloci,dersc,ddummy,.false.)
5131 escloc=escloc+escloci
5132 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5133 & 'escloc',i,escloci
5134 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5136 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5138 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5139 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5144 C---------------------------------------------------------------------------
5145 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5146 implicit real*8 (a-h,o-z)
5147 include 'DIMENSIONS'
5148 include 'COMMON.GEO'
5149 include 'COMMON.LOCAL'
5150 include 'COMMON.IOUNITS'
5151 common /sccalc/ time11,time12,time112,theti,it,nlobit
5152 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5153 double precision contr(maxlob,-1:1)
5155 c write (iout,*) 'it=',it,' nlobit=',nlobit
5159 if (mixed) ddersc(j)=0.0d0
5163 C Because of periodicity of the dependence of the SC energy in omega we have
5164 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5165 C To avoid underflows, first compute & store the exponents.
5173 z(k)=x(k)-censc(k,j,it)
5178 Axk=Axk+gaussc(l,k,j,it)*z(l)
5184 expfac=expfac+Ax(k,j,iii)*z(k)
5192 C As in the case of ebend, we want to avoid underflows in exponentiation and
5193 C subsequent NaNs and INFs in energy calculation.
5194 C Find the largest exponent
5198 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5202 cd print *,'it=',it,' emin=',emin
5204 C Compute the contribution to SC energy and derivatives
5209 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5210 if(adexp.ne.adexp) adexp=1.0
5213 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5215 cd print *,'j=',j,' expfac=',expfac
5216 escloc_i=escloc_i+expfac
5218 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5222 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5223 & +gaussc(k,2,j,it))*expfac
5230 dersc(1)=dersc(1)/cos(theti)**2
5231 ddersc(1)=ddersc(1)/cos(theti)**2
5234 escloci=-(dlog(escloc_i)-emin)
5236 dersc(j)=dersc(j)/escloc_i
5240 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5245 C------------------------------------------------------------------------------
5246 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5247 implicit real*8 (a-h,o-z)
5248 include 'DIMENSIONS'
5249 include 'COMMON.GEO'
5250 include 'COMMON.LOCAL'
5251 include 'COMMON.IOUNITS'
5252 common /sccalc/ time11,time12,time112,theti,it,nlobit
5253 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5254 double precision contr(maxlob)
5265 z(k)=x(k)-censc(k,j,it)
5271 Axk=Axk+gaussc(l,k,j,it)*z(l)
5277 expfac=expfac+Ax(k,j)*z(k)
5282 C As in the case of ebend, we want to avoid underflows in exponentiation and
5283 C subsequent NaNs and INFs in energy calculation.
5284 C Find the largest exponent
5287 if (emin.gt.contr(j)) emin=contr(j)
5291 C Compute the contribution to SC energy and derivatives
5295 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5296 escloc_i=escloc_i+expfac
5298 dersc(k)=dersc(k)+Ax(k,j)*expfac
5300 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5301 & +gaussc(1,2,j,it))*expfac
5305 dersc(1)=dersc(1)/cos(theti)**2
5306 dersc12=dersc12/cos(theti)**2
5307 escloci=-(dlog(escloc_i)-emin)
5309 dersc(j)=dersc(j)/escloc_i
5311 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5315 c----------------------------------------------------------------------------------
5316 subroutine esc(escloc)
5317 C Calculate the local energy of a side chain and its derivatives in the
5318 C corresponding virtual-bond valence angles THETA and the spherical angles
5319 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5320 C added by Urszula Kozlowska. 07/11/2007
5322 implicit real*8 (a-h,o-z)
5323 include 'DIMENSIONS'
5324 include 'COMMON.GEO'
5325 include 'COMMON.LOCAL'
5326 include 'COMMON.VAR'
5327 include 'COMMON.SCROT'
5328 include 'COMMON.INTERACT'
5329 include 'COMMON.DERIV'
5330 include 'COMMON.CHAIN'
5331 include 'COMMON.IOUNITS'
5332 include 'COMMON.NAMES'
5333 include 'COMMON.FFIELD'
5334 include 'COMMON.CONTROL'
5335 include 'COMMON.VECTORS'
5336 double precision x_prime(3),y_prime(3),z_prime(3)
5337 & , sumene,dsc_i,dp2_i,x(65),
5338 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5339 & de_dxx,de_dyy,de_dzz,de_dt
5340 double precision s1_t,s1_6_t,s2_t,s2_6_t
5342 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5343 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5344 & dt_dCi(3),dt_dCi1(3)
5345 common /sccalc/ time11,time12,time112,theti,it,nlobit
5348 do i=loc_start,loc_end
5349 costtab(i+1) =dcos(theta(i+1))
5350 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5351 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5352 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5353 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5354 cosfac=dsqrt(cosfac2)
5355 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5356 sinfac=dsqrt(sinfac2)
5358 if (it.eq.10) goto 1
5360 C Compute the axes of tghe local cartesian coordinates system; store in
5361 c x_prime, y_prime and z_prime
5368 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5369 C & dc_norm(3,i+nres)
5371 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5372 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5375 z_prime(j) = -uz(j,i-1)
5378 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5379 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5380 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5381 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5382 c & " xy",scalar(x_prime(1),y_prime(1)),
5383 c & " xz",scalar(x_prime(1),z_prime(1)),
5384 c & " yy",scalar(y_prime(1),y_prime(1)),
5385 c & " yz",scalar(y_prime(1),z_prime(1)),
5386 c & " zz",scalar(z_prime(1),z_prime(1))
5388 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5389 C to local coordinate system. Store in xx, yy, zz.
5395 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5396 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5397 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5404 C Compute the energy of the ith side cbain
5406 c write (2,*) "xx",xx," yy",yy," zz",zz
5409 x(j) = sc_parmin(j,it)
5412 Cc diagnostics - remove later
5414 yy1 = dsin(alph(2))*dcos(omeg(2))
5415 zz1 = -dsin(alph(2))*dsin(omeg(2))
5416 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5417 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5419 C," --- ", xx_w,yy_w,zz_w
5422 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5423 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5425 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5426 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5428 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5429 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5430 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5431 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5432 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5434 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5435 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5436 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5437 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5438 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5440 dsc_i = 0.743d0+x(61)
5442 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5443 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5444 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5445 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5446 s1=(1+x(63))/(0.1d0 + dscp1)
5447 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5448 s2=(1+x(65))/(0.1d0 + dscp2)
5449 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5450 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5451 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5452 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5454 c & dscp1,dscp2,sumene
5455 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5456 escloc = escloc + sumene
5457 c write (2,*) "i",i," escloc",sumene,escloc
5460 C This section to check the numerical derivatives of the energy of ith side
5461 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5462 C #define DEBUG in the code to turn it on.
5464 write (2,*) "sumene =",sumene
5468 write (2,*) xx,yy,zz
5469 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5470 de_dxx_num=(sumenep-sumene)/aincr
5472 write (2,*) "xx+ sumene from enesc=",sumenep
5475 write (2,*) xx,yy,zz
5476 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5477 de_dyy_num=(sumenep-sumene)/aincr
5479 write (2,*) "yy+ sumene from enesc=",sumenep
5482 write (2,*) xx,yy,zz
5483 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5484 de_dzz_num=(sumenep-sumene)/aincr
5486 write (2,*) "zz+ sumene from enesc=",sumenep
5487 costsave=cost2tab(i+1)
5488 sintsave=sint2tab(i+1)
5489 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5490 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5491 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5492 de_dt_num=(sumenep-sumene)/aincr
5493 write (2,*) " t+ sumene from enesc=",sumenep
5494 cost2tab(i+1)=costsave
5495 sint2tab(i+1)=sintsave
5496 C End of diagnostics section.
5499 C Compute the gradient of esc
5501 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5502 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5503 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5504 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5505 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5506 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5507 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5508 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5509 pom1=(sumene3*sint2tab(i+1)+sumene1)
5510 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5511 pom2=(sumene4*cost2tab(i+1)+sumene2)
5512 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5513 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5514 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5515 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5517 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5518 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5519 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5521 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5522 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5523 & +(pom1+pom2)*pom_dx
5525 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5528 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5529 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5530 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5532 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5533 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5534 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5535 & +x(59)*zz**2 +x(60)*xx*zz
5536 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5537 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5538 & +(pom1-pom2)*pom_dy
5540 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5543 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5544 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5545 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5546 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5547 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5548 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5549 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5550 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5552 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5555 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5556 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5557 & +pom1*pom_dt1+pom2*pom_dt2
5559 write(2,*), "de_dt = ", de_dt,de_dt_num
5563 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5564 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5565 cosfac2xx=cosfac2*xx
5566 sinfac2yy=sinfac2*yy
5568 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5570 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5572 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5573 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5574 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5575 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5576 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5577 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5578 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5579 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5580 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5581 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5585 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5586 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5589 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5590 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5591 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5593 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5594 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5598 dXX_Ctab(k,i)=dXX_Ci(k)
5599 dXX_C1tab(k,i)=dXX_Ci1(k)
5600 dYY_Ctab(k,i)=dYY_Ci(k)
5601 dYY_C1tab(k,i)=dYY_Ci1(k)
5602 dZZ_Ctab(k,i)=dZZ_Ci(k)
5603 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5604 dXX_XYZtab(k,i)=dXX_XYZ(k)
5605 dYY_XYZtab(k,i)=dYY_XYZ(k)
5606 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5610 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5611 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5612 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5613 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5614 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5616 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5617 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5618 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5619 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5620 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5621 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5622 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5623 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5625 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5626 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5628 C to check gradient call subroutine check_grad
5634 c------------------------------------------------------------------------------
5635 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5637 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5638 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5639 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5640 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5642 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5643 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5645 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5646 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5647 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5648 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5649 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5651 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5652 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5653 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5654 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5655 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5657 dsc_i = 0.743d0+x(61)
5659 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5660 & *(xx*cost2+yy*sint2))
5661 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5662 & *(xx*cost2-yy*sint2))
5663 s1=(1+x(63))/(0.1d0 + dscp1)
5664 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5665 s2=(1+x(65))/(0.1d0 + dscp2)
5666 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5667 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5668 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5673 c------------------------------------------------------------------------------
5674 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5676 C This procedure calculates two-body contact function g(rij) and its derivative:
5679 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5682 C where x=(rij-r0ij)/delta
5684 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5687 double precision rij,r0ij,eps0ij,fcont,fprimcont
5688 double precision x,x2,x4,delta
5692 if (x.lt.-1.0D0) then
5695 else if (x.le.1.0D0) then
5698 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5699 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5706 c------------------------------------------------------------------------------
5707 subroutine splinthet(theti,delta,ss,ssder)
5708 implicit real*8 (a-h,o-z)
5709 include 'DIMENSIONS'
5710 include 'COMMON.VAR'
5711 include 'COMMON.GEO'
5714 if (theti.gt.pipol) then
5715 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5717 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5722 c------------------------------------------------------------------------------
5723 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5725 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5726 double precision ksi,ksi2,ksi3,a1,a2,a3
5727 a1=fprim0*delta/(f1-f0)
5733 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5734 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5737 c------------------------------------------------------------------------------
5738 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5740 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5741 double precision ksi,ksi2,ksi3,a1,a2,a3
5746 a2=3*(f1x-f0x)-2*fprim0x*delta
5747 a3=fprim0x*delta-2*(f1x-f0x)
5748 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5751 C-----------------------------------------------------------------------------
5753 C-----------------------------------------------------------------------------
5754 subroutine etor(etors,edihcnstr)
5755 implicit real*8 (a-h,o-z)
5756 include 'DIMENSIONS'
5757 include 'COMMON.VAR'
5758 include 'COMMON.GEO'
5759 include 'COMMON.LOCAL'
5760 include 'COMMON.TORSION'
5761 include 'COMMON.INTERACT'
5762 include 'COMMON.DERIV'
5763 include 'COMMON.CHAIN'
5764 include 'COMMON.NAMES'
5765 include 'COMMON.IOUNITS'
5766 include 'COMMON.FFIELD'
5767 include 'COMMON.TORCNSTR'
5768 include 'COMMON.CONTROL'
5770 C Set lprn=.true. for debugging
5774 do i=iphi_start,iphi_end
5776 itori=itortyp(itype(i-2))
5777 itori1=itortyp(itype(i-1))
5780 C Proline-Proline pair is a special case...
5781 if (itori.eq.3 .and. itori1.eq.3) then
5782 if (phii.gt.-dwapi3) then
5784 fac=1.0D0/(1.0D0-cosphi)
5785 etorsi=v1(1,3,3)*fac
5786 etorsi=etorsi+etorsi
5787 etors=etors+etorsi-v1(1,3,3)
5788 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5789 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5792 v1ij=v1(j+1,itori,itori1)
5793 v2ij=v2(j+1,itori,itori1)
5796 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5797 if (energy_dec) etors_ii=etors_ii+
5798 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5799 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5803 v1ij=v1(j,itori,itori1)
5804 v2ij=v2(j,itori,itori1)
5807 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5808 if (energy_dec) etors_ii=etors_ii+
5809 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5810 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5813 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5816 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5817 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5818 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5819 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5820 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5822 ! 6/20/98 - dihedral angle constraints
5825 itori=idih_constr(i)
5828 if (difi.gt.drange(i)) then
5830 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5831 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5832 else if (difi.lt.-drange(i)) then
5834 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5835 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5837 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5838 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5840 ! write (iout,*) 'edihcnstr',edihcnstr
5843 c------------------------------------------------------------------------------
5844 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
5845 subroutine e_modeller(ehomology_constr)
5846 ehomology_constr=0.0
5847 write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
5850 C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
5852 c------------------------------------------------------------------------------
5853 subroutine etor_d(etors_d)
5857 c----------------------------------------------------------------------------
5859 subroutine etor(etors,edihcnstr)
5860 implicit real*8 (a-h,o-z)
5861 include 'DIMENSIONS'
5862 include 'COMMON.VAR'
5863 include 'COMMON.GEO'
5864 include 'COMMON.LOCAL'
5865 include 'COMMON.TORSION'
5866 include 'COMMON.INTERACT'
5867 include 'COMMON.DERIV'
5868 include 'COMMON.CHAIN'
5869 include 'COMMON.NAMES'
5870 include 'COMMON.IOUNITS'
5871 include 'COMMON.FFIELD'
5872 include 'COMMON.TORCNSTR'
5873 include 'COMMON.CONTROL'
5875 C Set lprn=.true. for debugging
5879 do i=iphi_start,iphi_end
5881 itori=itortyp(itype(i-2))
5882 itori1=itortyp(itype(i-1))
5885 C Regular cosine and sine terms
5886 do j=1,nterm(itori,itori1)
5887 v1ij=v1(j,itori,itori1)
5888 v2ij=v2(j,itori,itori1)
5891 etors=etors+v1ij*cosphi+v2ij*sinphi
5892 if (energy_dec) etors_ii=etors_ii+
5893 & v1ij*cosphi+v2ij*sinphi
5894 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5898 C E = SUM ----------------------------------- - v1
5899 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5901 cosphi=dcos(0.5d0*phii)
5902 sinphi=dsin(0.5d0*phii)
5903 do j=1,nlor(itori,itori1)
5904 vl1ij=vlor1(j,itori,itori1)
5905 vl2ij=vlor2(j,itori,itori1)
5906 vl3ij=vlor3(j,itori,itori1)
5907 pom=vl2ij*cosphi+vl3ij*sinphi
5908 pom1=1.0d0/(pom*pom+1.0d0)
5909 etors=etors+vl1ij*pom1
5910 if (energy_dec) etors_ii=etors_ii+
5913 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5915 C Subtract the constant term
5916 etors=etors-v0(itori,itori1)
5917 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5918 & 'etor',i,etors_ii-v0(itori,itori1)
5920 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5921 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5922 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5923 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5924 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5926 ! 6/20/98 - dihedral angle constraints
5928 c do i=1,ndih_constr
5929 do i=idihconstr_start,idihconstr_end
5930 itori=idih_constr(i)
5932 difi=pinorm(phii-phi0(i))
5933 if (difi.gt.drange(i)) then
5935 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5936 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5937 else if (difi.lt.-drange(i)) then
5939 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5940 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5944 c write (iout,*) "gloci", gloc(i-3,icg)
5945 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5946 cd & rad2deg*phi0(i), rad2deg*drange(i),
5947 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5949 cd write (iout,*) 'edihcnstr',edihcnstr
5952 c----------------------------------------------------------------------------
5953 c MODELLER restraint function
5954 subroutine e_modeller(ehomology_constr)
5955 implicit real*8 (a-h,o-z)
5956 include 'DIMENSIONS'
5958 integer nnn, i, j, k, ki, irec, l
5959 integer katy, odleglosci, test7
5960 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
5961 real*8 distance(max_template),distancek(max_template),
5962 & min_odl,godl(max_template),dih_diff(max_template)
5964 include 'COMMON.SBRIDGE'
5965 include 'COMMON.CHAIN'
5966 include 'COMMON.GEO'
5967 include 'COMMON.DERIV'
5968 include 'COMMON.LOCAL'
5969 include 'COMMON.INTERACT'
5970 include 'COMMON.VAR'
5971 include 'COMMON.IOUNITS'
5973 include 'COMMON.CONTROL'
5977 distancek(i)=9999999.9
5983 c Pseudo-energy and gradient from homology restraints (MODELLER-like
5985 C AL 5/2/14 - Introduce list of restraints
5986 do ii = link_start_homo,link_end_homo
5990 do k=1,constr_homology
5991 distance(k)=odl(k,ii)-dij
5993 & 0.5d0*waga_dist(iset)*distance(k)**2*sigma_odl(k,ii)
5996 min_odl=minval(distancek)
5998 write (iout,*) "ij dij",i,j,dij
5999 write (iout,*) "distance",(distance(k),k=1,constr_homology)
6000 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
6001 write (iout,* )"min_odl",min_odl
6004 do k=1,constr_homology
6005 c Nie wiem po co to liczycie jeszcze raz!
6006 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
6007 c & (2*(sigma_odl(i,j,k))**2))
6008 godl(k)=dexp(-distancek(k)+min_odl)
6009 odleg2=odleg2+godl(k)
6011 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
6012 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
6013 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
6014 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
6018 write (iout,*) "godl",(godl(k),k=1,constr_homology)
6019 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2
6021 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
6025 do k=1,constr_homology
6026 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6027 c & *waga_dist(iset))+min_odl
6028 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist(iset)
6029 sum_sgodl=sum_sgodl+sgodl
6031 c sgodl2=sgodl2+sgodl
6032 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
6033 c write(iout,*) "constr_homology=",constr_homology
6034 c write(iout,*) i, j, k, "TEST K"
6037 grad_odl3=sum_sgodl/(sum_godl*dij)
6040 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
6041 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
6042 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6044 ccc write(iout,*) godl, sgodl, grad_odl3
6046 c grad_odl=grad_odl+grad_odl3
6049 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
6050 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
6051 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
6052 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6053 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
6054 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
6055 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
6056 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6059 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
6060 ccc & dLOG(odleg2),"-odleg=", -odleg
6063 c Pseudo-energy and gradient from dihedral-angle restraints from
6064 c homology templates
6065 c write (iout,*) "End of distance loop"
6068 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
6069 do i=idihconstr_start_homo,idihconstr_end_homo
6071 c betai=beta(i,i+1,i+2,i+3)
6073 do k=1,constr_homology
6074 dih_diff(k)=pinorm(dih(k,i)-betai)
6075 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
6076 c & -(6.28318-dih_diff(i,k))
6077 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
6078 c & 6.28318+dih_diff(i,k)
6080 kat3=-0.5d0*waga_angle(iset)*dih_diff(k)**2*sigma_dih(k,i)
6083 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
6087 write (iout,*) "i",i," betai",betai," kat2",kat2
6088 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
6090 if (kat2.le.1.0d-14) cycle
6091 kat=kat-dLOG(kat2/constr_homology)
6093 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
6094 ccc & dLOG(kat2), "-kat=", -kat
6096 c ----------------------------------------------------------------------
6098 c ----------------------------------------------------------------------
6102 do k=1,constr_homology
6103 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle(iset)
6104 sum_sgdih=sum_sgdih+sgdih
6106 grad_dih3=sum_sgdih/sum_gdih
6108 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
6109 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
6110 ccc & gloc(nphi+i-3,icg)
6111 gloc(i,icg)=gloc(i,icg)+grad_dih3
6112 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
6113 ccc & gloc(nphi+i-3,icg)
6118 c Total energy from homology restraints
6120 write (iout,*) "odleg",odleg," kat",kat
6122 ehomology_constr=odleg+kat
6125 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
6126 747 format(a12,i4,i4,i4,f8.3,f8.3)
6127 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
6128 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
6129 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
6130 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
6133 c------------------------------------------------------------------------------
6134 subroutine etor_d(etors_d)
6135 C 6/23/01 Compute double torsional energy
6136 implicit real*8 (a-h,o-z)
6137 include 'DIMENSIONS'
6138 include 'COMMON.VAR'
6139 include 'COMMON.GEO'
6140 include 'COMMON.LOCAL'
6141 include 'COMMON.TORSION'
6142 include 'COMMON.INTERACT'
6143 include 'COMMON.DERIV'
6144 include 'COMMON.CHAIN'
6145 include 'COMMON.NAMES'
6146 include 'COMMON.IOUNITS'
6147 include 'COMMON.FFIELD'
6148 include 'COMMON.TORCNSTR'
6150 C Set lprn=.true. for debugging
6154 do i=iphid_start,iphid_end
6155 itori=itortyp(itype(i-2))
6156 itori1=itortyp(itype(i-1))
6157 itori2=itortyp(itype(i))
6162 do j=1,ntermd_1(itori,itori1,itori2)
6163 v1cij=v1c(1,j,itori,itori1,itori2)
6164 v1sij=v1s(1,j,itori,itori1,itori2)
6165 v2cij=v1c(2,j,itori,itori1,itori2)
6166 v2sij=v1s(2,j,itori,itori1,itori2)
6167 cosphi1=dcos(j*phii)
6168 sinphi1=dsin(j*phii)
6169 cosphi2=dcos(j*phii1)
6170 sinphi2=dsin(j*phii1)
6171 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6172 & v2cij*cosphi2+v2sij*sinphi2
6173 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6174 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6176 do k=2,ntermd_2(itori,itori1,itori2)
6178 v1cdij = v2c(k,l,itori,itori1,itori2)
6179 v2cdij = v2c(l,k,itori,itori1,itori2)
6180 v1sdij = v2s(k,l,itori,itori1,itori2)
6181 v2sdij = v2s(l,k,itori,itori1,itori2)
6182 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6183 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6184 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6185 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6186 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6187 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6188 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6189 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6190 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6191 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6194 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6195 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6196 c write (iout,*) "gloci", gloc(i-3,icg)
6201 c------------------------------------------------------------------------------
6202 subroutine eback_sc_corr(esccor)
6203 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6204 c conformational states; temporarily implemented as differences
6205 c between UNRES torsional potentials (dependent on three types of
6206 c residues) and the torsional potentials dependent on all 20 types
6207 c of residues computed from AM1 energy surfaces of terminally-blocked
6208 c amino-acid residues.
6209 implicit real*8 (a-h,o-z)
6210 include 'DIMENSIONS'
6211 include 'COMMON.VAR'
6212 include 'COMMON.GEO'
6213 include 'COMMON.LOCAL'
6214 include 'COMMON.TORSION'
6215 include 'COMMON.SCCOR'
6216 include 'COMMON.INTERACT'
6217 include 'COMMON.DERIV'
6218 include 'COMMON.CHAIN'
6219 include 'COMMON.NAMES'
6220 include 'COMMON.IOUNITS'
6221 include 'COMMON.FFIELD'
6222 include 'COMMON.CONTROL'
6224 C Set lprn=.true. for debugging
6227 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6229 do i=itau_start,itau_end
6231 isccori=isccortyp(itype(i-2))
6232 isccori1=isccortyp(itype(i-1))
6234 cccc Added 9 May 2012
6235 cc Tauangle is torsional engle depending on the value of first digit
6236 c(see comment below)
6237 cc Omicron is flat angle depending on the value of first digit
6238 c(see comment below)
6241 do intertyp=1,3 !intertyp
6242 cc Added 09 May 2012 (Adasko)
6243 cc Intertyp means interaction type of backbone mainchain correlation:
6244 c 1 = SC...Ca...Ca...Ca
6245 c 2 = Ca...Ca...Ca...SC
6246 c 3 = SC...Ca...Ca...SCi
6248 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6249 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6250 & (itype(i-1).eq.21)))
6251 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6252 & .or.(itype(i-2).eq.21)))
6253 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6254 & (itype(i-1).eq.21)))) cycle
6255 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6256 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6258 do j=1,nterm_sccor(isccori,isccori1)
6259 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6260 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6261 cosphi=dcos(j*tauangle(intertyp,i))
6262 sinphi=dsin(j*tauangle(intertyp,i))
6263 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6264 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6266 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6267 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6268 c &gloc_sc(intertyp,i-3,icg)
6270 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6271 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6272 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6273 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6274 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6278 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6282 c----------------------------------------------------------------------------
6283 subroutine multibody(ecorr)
6284 C This subroutine calculates multi-body contributions to energy following
6285 C the idea of Skolnick et al. If side chains I and J make a contact and
6286 C at the same time side chains I+1 and J+1 make a contact, an extra
6287 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6288 implicit real*8 (a-h,o-z)
6289 include 'DIMENSIONS'
6290 include 'COMMON.IOUNITS'
6291 include 'COMMON.DERIV'
6292 include 'COMMON.INTERACT'
6293 include 'COMMON.CONTACTS'
6294 double precision gx(3),gx1(3)
6297 C Set lprn=.true. for debugging
6301 write (iout,'(a)') 'Contact function values:'
6303 write (iout,'(i2,20(1x,i2,f10.5))')
6304 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6319 num_conti=num_cont(i)
6320 num_conti1=num_cont(i1)
6325 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6326 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6327 cd & ' ishift=',ishift
6328 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6329 C The system gains extra energy.
6330 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6331 endif ! j1==j+-ishift
6340 c------------------------------------------------------------------------------
6341 double precision function esccorr(i,j,k,l,jj,kk)
6342 implicit real*8 (a-h,o-z)
6343 include 'DIMENSIONS'
6344 include 'COMMON.IOUNITS'
6345 include 'COMMON.DERIV'
6346 include 'COMMON.INTERACT'
6347 include 'COMMON.CONTACTS'
6348 double precision gx(3),gx1(3)
6353 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6354 C Calculate the multi-body contribution to energy.
6355 C Calculate multi-body contributions to the gradient.
6356 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6357 cd & k,l,(gacont(m,kk,k),m=1,3)
6359 gx(m) =ekl*gacont(m,jj,i)
6360 gx1(m)=eij*gacont(m,kk,k)
6361 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6362 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6363 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6364 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6368 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6373 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6379 c------------------------------------------------------------------------------
6380 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6381 C This subroutine calculates multi-body contributions to hydrogen-bonding
6382 implicit real*8 (a-h,o-z)
6383 include 'DIMENSIONS'
6384 include 'COMMON.IOUNITS'
6387 parameter (max_cont=maxconts)
6388 parameter (max_dim=26)
6389 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6390 double precision zapas(max_dim,maxconts,max_fg_procs),
6391 & zapas_recv(max_dim,maxconts,max_fg_procs)
6392 common /przechowalnia/ zapas
6393 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6394 & status_array(MPI_STATUS_SIZE,maxconts*2)
6396 include 'COMMON.SETUP'
6397 include 'COMMON.FFIELD'
6398 include 'COMMON.DERIV'
6399 include 'COMMON.INTERACT'
6400 include 'COMMON.CONTACTS'
6401 include 'COMMON.CONTROL'
6402 include 'COMMON.LOCAL'
6403 double precision gx(3),gx1(3),time00
6406 C Set lprn=.true. for debugging
6411 if (nfgtasks.le.1) goto 30
6413 write (iout,'(a)') 'Contact function values before RECEIVE:'
6415 write (iout,'(2i3,50(1x,i2,f5.2))')
6416 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6417 & j=1,num_cont_hb(i))
6421 do i=1,ntask_cont_from
6424 do i=1,ntask_cont_to
6427 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6429 C Make the list of contacts to send to send to other procesors
6430 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6432 do i=iturn3_start,iturn3_end
6433 c write (iout,*) "make contact list turn3",i," num_cont",
6435 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6437 do i=iturn4_start,iturn4_end
6438 c write (iout,*) "make contact list turn4",i," num_cont",
6440 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6444 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6446 do j=1,num_cont_hb(i)
6449 iproc=iint_sent_local(k,jjc,ii)
6450 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6451 if (iproc.gt.0) then
6452 ncont_sent(iproc)=ncont_sent(iproc)+1
6453 nn=ncont_sent(iproc)
6455 zapas(2,nn,iproc)=jjc
6456 zapas(3,nn,iproc)=facont_hb(j,i)
6457 zapas(4,nn,iproc)=ees0p(j,i)
6458 zapas(5,nn,iproc)=ees0m(j,i)
6459 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6460 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6461 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6462 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6463 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6464 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6465 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6466 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6467 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6468 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6469 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6470 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6471 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6472 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6473 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6474 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6475 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6476 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6477 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6478 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6479 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6486 & "Numbers of contacts to be sent to other processors",
6487 & (ncont_sent(i),i=1,ntask_cont_to)
6488 write (iout,*) "Contacts sent"
6489 do ii=1,ntask_cont_to
6491 iproc=itask_cont_to(ii)
6492 write (iout,*) nn," contacts to processor",iproc,
6493 & " of CONT_TO_COMM group"
6495 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6503 CorrelID1=nfgtasks+fg_rank+1
6505 C Receive the numbers of needed contacts from other processors
6506 do ii=1,ntask_cont_from
6507 iproc=itask_cont_from(ii)
6509 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6510 & FG_COMM,req(ireq),IERR)
6512 c write (iout,*) "IRECV ended"
6514 C Send the number of contacts needed by other processors
6515 do ii=1,ntask_cont_to
6516 iproc=itask_cont_to(ii)
6518 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6519 & FG_COMM,req(ireq),IERR)
6521 c write (iout,*) "ISEND ended"
6522 c write (iout,*) "number of requests (nn)",ireq
6525 & call MPI_Waitall(ireq,req,status_array,ierr)
6527 c & "Numbers of contacts to be received from other processors",
6528 c & (ncont_recv(i),i=1,ntask_cont_from)
6532 do ii=1,ntask_cont_from
6533 iproc=itask_cont_from(ii)
6535 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6536 c & " of CONT_TO_COMM group"
6540 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6541 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6542 c write (iout,*) "ireq,req",ireq,req(ireq)
6545 C Send the contacts to processors that need them
6546 do ii=1,ntask_cont_to
6547 iproc=itask_cont_to(ii)
6549 c write (iout,*) nn," contacts to processor",iproc,
6550 c & " of CONT_TO_COMM group"
6553 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6554 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6555 c write (iout,*) "ireq,req",ireq,req(ireq)
6557 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6561 c write (iout,*) "number of requests (contacts)",ireq
6562 c write (iout,*) "req",(req(i),i=1,4)
6565 & call MPI_Waitall(ireq,req,status_array,ierr)
6566 do iii=1,ntask_cont_from
6567 iproc=itask_cont_from(iii)
6570 write (iout,*) "Received",nn," contacts from processor",iproc,
6571 & " of CONT_FROM_COMM group"
6574 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6579 ii=zapas_recv(1,i,iii)
6580 c Flag the received contacts to prevent double-counting
6581 jj=-zapas_recv(2,i,iii)
6582 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6584 nnn=num_cont_hb(ii)+1
6587 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6588 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6589 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6590 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6591 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6592 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6593 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6594 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6595 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6596 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6597 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6598 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6599 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6600 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6601 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6602 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6603 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6604 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6605 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6606 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6607 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6608 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6609 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6610 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6615 write (iout,'(a)') 'Contact function values after receive:'
6617 write (iout,'(2i3,50(1x,i3,f5.2))')
6618 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6619 & j=1,num_cont_hb(i))
6626 write (iout,'(a)') 'Contact function values:'
6628 write (iout,'(2i3,50(1x,i3,f5.2))')
6629 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6630 & j=1,num_cont_hb(i))
6634 C Remove the loop below after debugging !!!
6641 C Calculate the local-electrostatic correlation terms
6642 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6644 num_conti=num_cont_hb(i)
6645 num_conti1=num_cont_hb(i+1)
6652 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6653 c & ' jj=',jj,' kk=',kk
6654 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6655 & .or. j.lt.0 .and. j1.gt.0) .and.
6656 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6657 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6658 C The system gains extra energy.
6659 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6660 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6661 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6663 else if (j1.eq.j) then
6664 C Contacts I-J and I-(J+1) occur simultaneously.
6665 C The system loses extra energy.
6666 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6671 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6672 c & ' jj=',jj,' kk=',kk
6674 C Contacts I-J and (I+1)-J occur simultaneously.
6675 C The system loses extra energy.
6676 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6683 c------------------------------------------------------------------------------
6684 subroutine add_hb_contact(ii,jj,itask)
6685 implicit real*8 (a-h,o-z)
6686 include "DIMENSIONS"
6687 include "COMMON.IOUNITS"
6690 parameter (max_cont=maxconts)
6691 parameter (max_dim=26)
6692 include "COMMON.CONTACTS"
6693 double precision zapas(max_dim,maxconts,max_fg_procs),
6694 & zapas_recv(max_dim,maxconts,max_fg_procs)
6695 common /przechowalnia/ zapas
6696 integer i,j,ii,jj,iproc,itask(4),nn
6697 c write (iout,*) "itask",itask
6700 if (iproc.gt.0) then
6701 do j=1,num_cont_hb(ii)
6703 c write (iout,*) "i",ii," j",jj," jjc",jjc
6705 ncont_sent(iproc)=ncont_sent(iproc)+1
6706 nn=ncont_sent(iproc)
6707 zapas(1,nn,iproc)=ii
6708 zapas(2,nn,iproc)=jjc
6709 zapas(3,nn,iproc)=facont_hb(j,ii)
6710 zapas(4,nn,iproc)=ees0p(j,ii)
6711 zapas(5,nn,iproc)=ees0m(j,ii)
6712 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6713 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6714 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6715 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6716 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6717 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6718 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6719 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6720 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6721 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6722 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6723 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6724 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6725 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6726 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6727 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6728 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6729 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6730 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6731 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6732 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6740 c------------------------------------------------------------------------------
6741 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6743 C This subroutine calculates multi-body contributions to hydrogen-bonding
6744 implicit real*8 (a-h,o-z)
6745 include 'DIMENSIONS'
6746 include 'COMMON.IOUNITS'
6749 parameter (max_cont=maxconts)
6750 parameter (max_dim=70)
6751 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6752 double precision zapas(max_dim,maxconts,max_fg_procs),
6753 & zapas_recv(max_dim,maxconts,max_fg_procs)
6754 common /przechowalnia/ zapas
6755 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6756 & status_array(MPI_STATUS_SIZE,maxconts*2)
6758 include 'COMMON.SETUP'
6759 include 'COMMON.FFIELD'
6760 include 'COMMON.DERIV'
6761 include 'COMMON.LOCAL'
6762 include 'COMMON.INTERACT'
6763 include 'COMMON.CONTACTS'
6764 include 'COMMON.CHAIN'
6765 include 'COMMON.CONTROL'
6766 double precision gx(3),gx1(3)
6767 integer num_cont_hb_old(maxres)
6769 double precision eello4,eello5,eelo6,eello_turn6
6770 external eello4,eello5,eello6,eello_turn6
6771 C Set lprn=.true. for debugging
6776 num_cont_hb_old(i)=num_cont_hb(i)
6780 if (nfgtasks.le.1) goto 30
6782 write (iout,'(a)') 'Contact function values before RECEIVE:'
6784 write (iout,'(2i3,50(1x,i2,f5.2))')
6785 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6786 & j=1,num_cont_hb(i))
6790 do i=1,ntask_cont_from
6793 do i=1,ntask_cont_to
6796 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6798 C Make the list of contacts to send to send to other procesors
6799 do i=iturn3_start,iturn3_end
6800 c write (iout,*) "make contact list turn3",i," num_cont",
6802 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6804 do i=iturn4_start,iturn4_end
6805 c write (iout,*) "make contact list turn4",i," num_cont",
6807 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6811 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6813 do j=1,num_cont_hb(i)
6816 iproc=iint_sent_local(k,jjc,ii)
6817 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6818 if (iproc.ne.0) then
6819 ncont_sent(iproc)=ncont_sent(iproc)+1
6820 nn=ncont_sent(iproc)
6822 zapas(2,nn,iproc)=jjc
6823 zapas(3,nn,iproc)=d_cont(j,i)
6827 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6832 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6840 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6851 & "Numbers of contacts to be sent to other processors",
6852 & (ncont_sent(i),i=1,ntask_cont_to)
6853 write (iout,*) "Contacts sent"
6854 do ii=1,ntask_cont_to
6856 iproc=itask_cont_to(ii)
6857 write (iout,*) nn," contacts to processor",iproc,
6858 & " of CONT_TO_COMM group"
6860 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6868 CorrelID1=nfgtasks+fg_rank+1
6870 C Receive the numbers of needed contacts from other processors
6871 do ii=1,ntask_cont_from
6872 iproc=itask_cont_from(ii)
6874 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6875 & FG_COMM,req(ireq),IERR)
6877 c write (iout,*) "IRECV ended"
6879 C Send the number of contacts needed by other processors
6880 do ii=1,ntask_cont_to
6881 iproc=itask_cont_to(ii)
6883 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6884 & FG_COMM,req(ireq),IERR)
6886 c write (iout,*) "ISEND ended"
6887 c write (iout,*) "number of requests (nn)",ireq
6890 & call MPI_Waitall(ireq,req,status_array,ierr)
6892 c & "Numbers of contacts to be received from other processors",
6893 c & (ncont_recv(i),i=1,ntask_cont_from)
6897 do ii=1,ntask_cont_from
6898 iproc=itask_cont_from(ii)
6900 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6901 c & " of CONT_TO_COMM group"
6905 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6906 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6907 c write (iout,*) "ireq,req",ireq,req(ireq)
6910 C Send the contacts to processors that need them
6911 do ii=1,ntask_cont_to
6912 iproc=itask_cont_to(ii)
6914 c write (iout,*) nn," contacts to processor",iproc,
6915 c & " of CONT_TO_COMM group"
6918 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6919 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6920 c write (iout,*) "ireq,req",ireq,req(ireq)
6922 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6926 c write (iout,*) "number of requests (contacts)",ireq
6927 c write (iout,*) "req",(req(i),i=1,4)
6930 & call MPI_Waitall(ireq,req,status_array,ierr)
6931 do iii=1,ntask_cont_from
6932 iproc=itask_cont_from(iii)
6935 write (iout,*) "Received",nn," contacts from processor",iproc,
6936 & " of CONT_FROM_COMM group"
6939 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6944 ii=zapas_recv(1,i,iii)
6945 c Flag the received contacts to prevent double-counting
6946 jj=-zapas_recv(2,i,iii)
6947 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6949 nnn=num_cont_hb(ii)+1
6952 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6956 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6961 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6969 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6978 write (iout,'(a)') 'Contact function values after receive:'
6980 write (iout,'(2i3,50(1x,i3,5f6.3))')
6981 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6982 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6989 write (iout,'(a)') 'Contact function values:'
6991 write (iout,'(2i3,50(1x,i2,5f6.3))')
6992 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6993 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6999 C Remove the loop below after debugging !!!
7006 C Calculate the dipole-dipole interaction energies
7007 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7008 do i=iatel_s,iatel_e+1
7009 num_conti=num_cont_hb(i)
7018 C Calculate the local-electrostatic correlation terms
7019 c write (iout,*) "gradcorr5 in eello5 before loop"
7021 c write (iout,'(i5,3f10.5)')
7022 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7024 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7025 c write (iout,*) "corr loop i",i
7027 num_conti=num_cont_hb(i)
7028 num_conti1=num_cont_hb(i+1)
7035 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7036 c & ' jj=',jj,' kk=',kk
7037 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7038 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7039 & .or. j.lt.0 .and. j1.gt.0) .and.
7040 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7041 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7042 C The system gains extra energy.
7044 sqd1=dsqrt(d_cont(jj,i))
7045 sqd2=dsqrt(d_cont(kk,i1))
7046 sred_geom = sqd1*sqd2
7047 IF (sred_geom.lt.cutoff_corr) THEN
7048 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7050 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7051 cd & ' jj=',jj,' kk=',kk
7052 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7053 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7055 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7056 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7059 cd write (iout,*) 'sred_geom=',sred_geom,
7060 cd & ' ekont=',ekont,' fprim=',fprimcont,
7061 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7062 cd write (iout,*) "g_contij",g_contij
7063 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7064 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7065 call calc_eello(i,jp,i+1,jp1,jj,kk)
7066 if (wcorr4.gt.0.0d0)
7067 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7068 if (energy_dec.and.wcorr4.gt.0.0d0)
7069 1 write (iout,'(a6,4i5,0pf7.3)')
7070 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7071 c write (iout,*) "gradcorr5 before eello5"
7073 c write (iout,'(i5,3f10.5)')
7074 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7076 if (wcorr5.gt.0.0d0)
7077 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7078 c write (iout,*) "gradcorr5 after eello5"
7080 c write (iout,'(i5,3f10.5)')
7081 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7083 if (energy_dec.and.wcorr5.gt.0.0d0)
7084 1 write (iout,'(a6,4i5,0pf7.3)')
7085 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7086 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7087 cd write(2,*)'ijkl',i,jp,i+1,jp1
7088 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7089 & .or. wturn6.eq.0.0d0))then
7090 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7091 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7092 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7093 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7094 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7095 cd & 'ecorr6=',ecorr6
7096 cd write (iout,'(4e15.5)') sred_geom,
7097 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7098 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7099 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7100 else if (wturn6.gt.0.0d0
7101 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7102 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7103 eturn6=eturn6+eello_turn6(i,jj,kk)
7104 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7105 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7106 cd write (2,*) 'multibody_eello:eturn6',eturn6
7115 num_cont_hb(i)=num_cont_hb_old(i)
7117 c write (iout,*) "gradcorr5 in eello5"
7119 c write (iout,'(i5,3f10.5)')
7120 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7124 c------------------------------------------------------------------------------
7125 subroutine add_hb_contact_eello(ii,jj,itask)
7126 implicit real*8 (a-h,o-z)
7127 include "DIMENSIONS"
7128 include "COMMON.IOUNITS"
7131 parameter (max_cont=maxconts)
7132 parameter (max_dim=70)
7133 include "COMMON.CONTACTS"
7134 double precision zapas(max_dim,maxconts,max_fg_procs),
7135 & zapas_recv(max_dim,maxconts,max_fg_procs)
7136 common /przechowalnia/ zapas
7137 integer i,j,ii,jj,iproc,itask(4),nn
7138 c write (iout,*) "itask",itask
7141 if (iproc.gt.0) then
7142 do j=1,num_cont_hb(ii)
7144 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7146 ncont_sent(iproc)=ncont_sent(iproc)+1
7147 nn=ncont_sent(iproc)
7148 zapas(1,nn,iproc)=ii
7149 zapas(2,nn,iproc)=jjc
7150 zapas(3,nn,iproc)=d_cont(j,ii)
7154 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7159 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7167 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7179 c------------------------------------------------------------------------------
7180 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7181 implicit real*8 (a-h,o-z)
7182 include 'DIMENSIONS'
7183 include 'COMMON.IOUNITS'
7184 include 'COMMON.DERIV'
7185 include 'COMMON.INTERACT'
7186 include 'COMMON.CONTACTS'
7187 double precision gx(3),gx1(3)
7197 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7198 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7199 C Following 4 lines for diagnostics.
7204 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7205 c & 'Contacts ',i,j,
7206 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7207 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7209 C Calculate the multi-body contribution to energy.
7210 c ecorr=ecorr+ekont*ees
7211 C Calculate multi-body contributions to the gradient.
7212 coeffpees0pij=coeffp*ees0pij
7213 coeffmees0mij=coeffm*ees0mij
7214 coeffpees0pkl=coeffp*ees0pkl
7215 coeffmees0mkl=coeffm*ees0mkl
7217 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7218 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7219 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7220 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7221 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7222 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7223 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7224 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7225 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7226 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7227 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7228 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7229 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7230 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7231 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7232 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7233 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7234 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7235 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7236 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7237 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7238 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7239 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7240 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7241 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7246 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7247 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7248 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7249 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7254 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7255 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7256 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7257 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7260 c write (iout,*) "ehbcorr",ekont*ees
7265 C---------------------------------------------------------------------------
7266 subroutine dipole(i,j,jj)
7267 implicit real*8 (a-h,o-z)
7268 include 'DIMENSIONS'
7269 include 'COMMON.IOUNITS'
7270 include 'COMMON.CHAIN'
7271 include 'COMMON.FFIELD'
7272 include 'COMMON.DERIV'
7273 include 'COMMON.INTERACT'
7274 include 'COMMON.CONTACTS'
7275 include 'COMMON.TORSION'
7276 include 'COMMON.VAR'
7277 include 'COMMON.GEO'
7278 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7280 iti1 = itortyp(itype(i+1))
7281 if (j.lt.nres-1) then
7282 itj1 = itortyp(itype(j+1))
7287 dipi(iii,1)=Ub2(iii,i)
7288 dipderi(iii)=Ub2der(iii,i)
7289 dipi(iii,2)=b1(iii,iti1)
7290 dipj(iii,1)=Ub2(iii,j)
7291 dipderj(iii)=Ub2der(iii,j)
7292 dipj(iii,2)=b1(iii,itj1)
7296 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7299 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7306 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7310 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7315 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7316 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7318 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7320 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7322 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7327 C---------------------------------------------------------------------------
7328 subroutine calc_eello(i,j,k,l,jj,kk)
7330 C This subroutine computes matrices and vectors needed to calculate
7331 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7333 implicit real*8 (a-h,o-z)
7334 include 'DIMENSIONS'
7335 include 'COMMON.IOUNITS'
7336 include 'COMMON.CHAIN'
7337 include 'COMMON.DERIV'
7338 include 'COMMON.INTERACT'
7339 include 'COMMON.CONTACTS'
7340 include 'COMMON.TORSION'
7341 include 'COMMON.VAR'
7342 include 'COMMON.GEO'
7343 include 'COMMON.FFIELD'
7344 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7345 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7348 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7349 cd & ' jj=',jj,' kk=',kk
7350 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7351 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7352 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7355 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7356 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7359 call transpose2(aa1(1,1),aa1t(1,1))
7360 call transpose2(aa2(1,1),aa2t(1,1))
7363 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7364 & aa1tder(1,1,lll,kkk))
7365 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7366 & aa2tder(1,1,lll,kkk))
7370 C parallel orientation of the two CA-CA-CA frames.
7372 iti=itortyp(itype(i))
7376 itk1=itortyp(itype(k+1))
7377 itj=itortyp(itype(j))
7378 if (l.lt.nres-1) then
7379 itl1=itortyp(itype(l+1))
7383 C A1 kernel(j+1) A2T
7385 cd write (iout,'(3f10.5,5x,3f10.5)')
7386 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7388 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7389 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7390 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7391 C Following matrices are needed only for 6-th order cumulants
7392 IF (wcorr6.gt.0.0d0) THEN
7393 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7394 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7395 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7396 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7397 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7398 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7399 & ADtEAderx(1,1,1,1,1,1))
7401 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7402 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7403 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7404 & ADtEA1derx(1,1,1,1,1,1))
7406 C End 6-th order cumulants
7409 cd write (2,*) 'In calc_eello6'
7411 cd write (2,*) 'iii=',iii
7413 cd write (2,*) 'kkk=',kkk
7415 cd write (2,'(3(2f10.5),5x)')
7416 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7421 call transpose2(EUgder(1,1,k),auxmat(1,1))
7422 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7423 call transpose2(EUg(1,1,k),auxmat(1,1))
7424 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7425 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7429 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7430 & EAEAderx(1,1,lll,kkk,iii,1))
7434 C A1T kernel(i+1) A2
7435 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7436 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7437 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7438 C Following matrices are needed only for 6-th order cumulants
7439 IF (wcorr6.gt.0.0d0) THEN
7440 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7441 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7442 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7443 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7444 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7445 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7446 & ADtEAderx(1,1,1,1,1,2))
7447 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7448 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7449 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7450 & ADtEA1derx(1,1,1,1,1,2))
7452 C End 6-th order cumulants
7453 call transpose2(EUgder(1,1,l),auxmat(1,1))
7454 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7455 call transpose2(EUg(1,1,l),auxmat(1,1))
7456 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7457 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7461 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7462 & EAEAderx(1,1,lll,kkk,iii,2))
7467 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7468 C They are needed only when the fifth- or the sixth-order cumulants are
7470 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7471 call transpose2(AEA(1,1,1),auxmat(1,1))
7472 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7473 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7474 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7475 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7476 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7477 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7478 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7479 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7480 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7481 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7482 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7483 call transpose2(AEA(1,1,2),auxmat(1,1))
7484 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7485 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7486 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7487 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7488 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7489 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7490 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7491 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7492 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7493 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7494 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7495 C Calculate the Cartesian derivatives of the vectors.
7499 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7500 call matvec2(auxmat(1,1),b1(1,iti),
7501 & AEAb1derx(1,lll,kkk,iii,1,1))
7502 call matvec2(auxmat(1,1),Ub2(1,i),
7503 & AEAb2derx(1,lll,kkk,iii,1,1))
7504 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7505 & AEAb1derx(1,lll,kkk,iii,2,1))
7506 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7507 & AEAb2derx(1,lll,kkk,iii,2,1))
7508 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7509 call matvec2(auxmat(1,1),b1(1,itj),
7510 & AEAb1derx(1,lll,kkk,iii,1,2))
7511 call matvec2(auxmat(1,1),Ub2(1,j),
7512 & AEAb2derx(1,lll,kkk,iii,1,2))
7513 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7514 & AEAb1derx(1,lll,kkk,iii,2,2))
7515 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7516 & AEAb2derx(1,lll,kkk,iii,2,2))
7523 C Antiparallel orientation of the two CA-CA-CA frames.
7525 iti=itortyp(itype(i))
7529 itk1=itortyp(itype(k+1))
7530 itl=itortyp(itype(l))
7531 itj=itortyp(itype(j))
7532 if (j.lt.nres-1) then
7533 itj1=itortyp(itype(j+1))
7537 C A2 kernel(j-1)T A1T
7538 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7539 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7540 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7541 C Following matrices are needed only for 6-th order cumulants
7542 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7543 & j.eq.i+4 .and. l.eq.i+3)) THEN
7544 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7545 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7546 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7547 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7548 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7549 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7550 & ADtEAderx(1,1,1,1,1,1))
7551 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7552 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7553 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7554 & ADtEA1derx(1,1,1,1,1,1))
7556 C End 6-th order cumulants
7557 call transpose2(EUgder(1,1,k),auxmat(1,1))
7558 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7559 call transpose2(EUg(1,1,k),auxmat(1,1))
7560 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7561 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7565 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7566 & EAEAderx(1,1,lll,kkk,iii,1))
7570 C A2T kernel(i+1)T A1
7571 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7572 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7573 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7574 C Following matrices are needed only for 6-th order cumulants
7575 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7576 & j.eq.i+4 .and. l.eq.i+3)) THEN
7577 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7578 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7579 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7580 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7581 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7582 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7583 & ADtEAderx(1,1,1,1,1,2))
7584 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7585 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7586 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7587 & ADtEA1derx(1,1,1,1,1,2))
7589 C End 6-th order cumulants
7590 call transpose2(EUgder(1,1,j),auxmat(1,1))
7591 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7592 call transpose2(EUg(1,1,j),auxmat(1,1))
7593 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7594 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7598 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7599 & EAEAderx(1,1,lll,kkk,iii,2))
7604 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7605 C They are needed only when the fifth- or the sixth-order cumulants are
7607 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7608 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7609 call transpose2(AEA(1,1,1),auxmat(1,1))
7610 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7611 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7612 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7613 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7614 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7615 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7616 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7617 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7618 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7619 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7620 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7621 call transpose2(AEA(1,1,2),auxmat(1,1))
7622 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7623 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7624 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7625 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7626 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7627 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7628 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7629 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7630 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7631 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7632 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7633 C Calculate the Cartesian derivatives of the vectors.
7637 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7638 call matvec2(auxmat(1,1),b1(1,iti),
7639 & AEAb1derx(1,lll,kkk,iii,1,1))
7640 call matvec2(auxmat(1,1),Ub2(1,i),
7641 & AEAb2derx(1,lll,kkk,iii,1,1))
7642 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7643 & AEAb1derx(1,lll,kkk,iii,2,1))
7644 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7645 & AEAb2derx(1,lll,kkk,iii,2,1))
7646 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7647 call matvec2(auxmat(1,1),b1(1,itl),
7648 & AEAb1derx(1,lll,kkk,iii,1,2))
7649 call matvec2(auxmat(1,1),Ub2(1,l),
7650 & AEAb2derx(1,lll,kkk,iii,1,2))
7651 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7652 & AEAb1derx(1,lll,kkk,iii,2,2))
7653 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7654 & AEAb2derx(1,lll,kkk,iii,2,2))
7663 C---------------------------------------------------------------------------
7664 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7665 & KK,KKderg,AKA,AKAderg,AKAderx)
7669 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7670 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7671 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7676 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7678 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7681 cd if (lprn) write (2,*) 'In kernel'
7683 cd if (lprn) write (2,*) 'kkk=',kkk
7685 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7686 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7688 cd write (2,*) 'lll=',lll
7689 cd write (2,*) 'iii=1'
7691 cd write (2,'(3(2f10.5),5x)')
7692 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7695 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7696 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7698 cd write (2,*) 'lll=',lll
7699 cd write (2,*) 'iii=2'
7701 cd write (2,'(3(2f10.5),5x)')
7702 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7709 C---------------------------------------------------------------------------
7710 double precision function eello4(i,j,k,l,jj,kk)
7711 implicit real*8 (a-h,o-z)
7712 include 'DIMENSIONS'
7713 include 'COMMON.IOUNITS'
7714 include 'COMMON.CHAIN'
7715 include 'COMMON.DERIV'
7716 include 'COMMON.INTERACT'
7717 include 'COMMON.CONTACTS'
7718 include 'COMMON.TORSION'
7719 include 'COMMON.VAR'
7720 include 'COMMON.GEO'
7721 double precision pizda(2,2),ggg1(3),ggg2(3)
7722 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7726 cd print *,'eello4:',i,j,k,l,jj,kk
7727 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7728 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7729 cold eij=facont_hb(jj,i)
7730 cold ekl=facont_hb(kk,k)
7732 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7733 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7734 gcorr_loc(k-1)=gcorr_loc(k-1)
7735 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7737 gcorr_loc(l-1)=gcorr_loc(l-1)
7738 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7740 gcorr_loc(j-1)=gcorr_loc(j-1)
7741 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7746 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7747 & -EAEAderx(2,2,lll,kkk,iii,1)
7748 cd derx(lll,kkk,iii)=0.0d0
7752 cd gcorr_loc(l-1)=0.0d0
7753 cd gcorr_loc(j-1)=0.0d0
7754 cd gcorr_loc(k-1)=0.0d0
7756 cd write (iout,*)'Contacts have occurred for peptide groups',
7757 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7758 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7759 if (j.lt.nres-1) then
7766 if (l.lt.nres-1) then
7774 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7775 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7776 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7777 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7778 cgrad ghalf=0.5d0*ggg1(ll)
7779 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7780 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7781 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7782 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7783 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7784 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7785 cgrad ghalf=0.5d0*ggg2(ll)
7786 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7787 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7788 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7789 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7790 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7791 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7795 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7800 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7805 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7810 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7814 cd write (2,*) iii,gcorr_loc(iii)
7817 cd write (2,*) 'ekont',ekont
7818 cd write (iout,*) 'eello4',ekont*eel4
7821 C---------------------------------------------------------------------------
7822 double precision function eello5(i,j,k,l,jj,kk)
7823 implicit real*8 (a-h,o-z)
7824 include 'DIMENSIONS'
7825 include 'COMMON.IOUNITS'
7826 include 'COMMON.CHAIN'
7827 include 'COMMON.DERIV'
7828 include 'COMMON.INTERACT'
7829 include 'COMMON.CONTACTS'
7830 include 'COMMON.TORSION'
7831 include 'COMMON.VAR'
7832 include 'COMMON.GEO'
7833 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7834 double precision ggg1(3),ggg2(3)
7835 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7840 C /l\ / \ \ / \ / \ / C
7841 C / \ / \ \ / \ / \ / C
7842 C j| o |l1 | o | o| o | | o |o C
7843 C \ |/k\| |/ \| / |/ \| |/ \| C
7844 C \i/ \ / \ / / \ / \ C
7846 C (I) (II) (III) (IV) C
7848 C eello5_1 eello5_2 eello5_3 eello5_4 C
7850 C Antiparallel chains C
7853 C /j\ / \ \ / \ / \ / C
7854 C / \ / \ \ / \ / \ / C
7855 C j1| o |l | o | o| o | | o |o C
7856 C \ |/k\| |/ \| / |/ \| |/ \| C
7857 C \i/ \ / \ / / \ / \ C
7859 C (I) (II) (III) (IV) C
7861 C eello5_1 eello5_2 eello5_3 eello5_4 C
7863 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7865 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7866 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7871 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7873 itk=itortyp(itype(k))
7874 itl=itortyp(itype(l))
7875 itj=itortyp(itype(j))
7880 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7881 cd & eel5_3_num,eel5_4_num)
7885 derx(lll,kkk,iii)=0.0d0
7889 cd eij=facont_hb(jj,i)
7890 cd ekl=facont_hb(kk,k)
7892 cd write (iout,*)'Contacts have occurred for peptide groups',
7893 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7895 C Contribution from the graph I.
7896 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7897 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7898 call transpose2(EUg(1,1,k),auxmat(1,1))
7899 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7900 vv(1)=pizda(1,1)-pizda(2,2)
7901 vv(2)=pizda(1,2)+pizda(2,1)
7902 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7903 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7904 C Explicit gradient in virtual-dihedral angles.
7905 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7906 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7907 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7908 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7909 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7910 vv(1)=pizda(1,1)-pizda(2,2)
7911 vv(2)=pizda(1,2)+pizda(2,1)
7912 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7913 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7914 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7915 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7916 vv(1)=pizda(1,1)-pizda(2,2)
7917 vv(2)=pizda(1,2)+pizda(2,1)
7919 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7920 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7921 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7923 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7924 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7925 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7927 C Cartesian gradient
7931 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7933 vv(1)=pizda(1,1)-pizda(2,2)
7934 vv(2)=pizda(1,2)+pizda(2,1)
7935 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7936 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7937 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7943 C Contribution from graph II
7944 call transpose2(EE(1,1,itk),auxmat(1,1))
7945 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7946 vv(1)=pizda(1,1)+pizda(2,2)
7947 vv(2)=pizda(2,1)-pizda(1,2)
7948 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7949 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7950 C Explicit gradient in virtual-dihedral angles.
7951 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7952 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7953 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7954 vv(1)=pizda(1,1)+pizda(2,2)
7955 vv(2)=pizda(2,1)-pizda(1,2)
7957 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7958 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7959 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7961 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7962 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7963 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7965 C Cartesian gradient
7969 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7971 vv(1)=pizda(1,1)+pizda(2,2)
7972 vv(2)=pizda(2,1)-pizda(1,2)
7973 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7974 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7975 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7983 C Parallel orientation
7984 C Contribution from graph III
7985 call transpose2(EUg(1,1,l),auxmat(1,1))
7986 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7987 vv(1)=pizda(1,1)-pizda(2,2)
7988 vv(2)=pizda(1,2)+pizda(2,1)
7989 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7990 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7991 C Explicit gradient in virtual-dihedral angles.
7992 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7993 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7994 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7995 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7996 vv(1)=pizda(1,1)-pizda(2,2)
7997 vv(2)=pizda(1,2)+pizda(2,1)
7998 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7999 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8000 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8001 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8002 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8003 vv(1)=pizda(1,1)-pizda(2,2)
8004 vv(2)=pizda(1,2)+pizda(2,1)
8005 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8006 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8007 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8008 C Cartesian gradient
8012 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8014 vv(1)=pizda(1,1)-pizda(2,2)
8015 vv(2)=pizda(1,2)+pizda(2,1)
8016 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8017 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8018 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8023 C Contribution from graph IV
8025 call transpose2(EE(1,1,itl),auxmat(1,1))
8026 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8027 vv(1)=pizda(1,1)+pizda(2,2)
8028 vv(2)=pizda(2,1)-pizda(1,2)
8029 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
8030 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8031 C Explicit gradient in virtual-dihedral angles.
8032 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8033 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8034 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8035 vv(1)=pizda(1,1)+pizda(2,2)
8036 vv(2)=pizda(2,1)-pizda(1,2)
8037 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8038 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
8039 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8040 C Cartesian gradient
8044 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8046 vv(1)=pizda(1,1)+pizda(2,2)
8047 vv(2)=pizda(2,1)-pizda(1,2)
8048 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8049 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
8050 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8055 C Antiparallel orientation
8056 C Contribution from graph III
8058 call transpose2(EUg(1,1,j),auxmat(1,1))
8059 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8060 vv(1)=pizda(1,1)-pizda(2,2)
8061 vv(2)=pizda(1,2)+pizda(2,1)
8062 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8063 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8064 C Explicit gradient in virtual-dihedral angles.
8065 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8066 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8067 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8068 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8069 vv(1)=pizda(1,1)-pizda(2,2)
8070 vv(2)=pizda(1,2)+pizda(2,1)
8071 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8072 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8073 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8074 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8075 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8076 vv(1)=pizda(1,1)-pizda(2,2)
8077 vv(2)=pizda(1,2)+pizda(2,1)
8078 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8079 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8080 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8081 C Cartesian gradient
8085 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8087 vv(1)=pizda(1,1)-pizda(2,2)
8088 vv(2)=pizda(1,2)+pizda(2,1)
8089 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8090 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8091 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8096 C Contribution from graph IV
8098 call transpose2(EE(1,1,itj),auxmat(1,1))
8099 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8100 vv(1)=pizda(1,1)+pizda(2,2)
8101 vv(2)=pizda(2,1)-pizda(1,2)
8102 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8103 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8104 C Explicit gradient in virtual-dihedral angles.
8105 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8106 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8107 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8108 vv(1)=pizda(1,1)+pizda(2,2)
8109 vv(2)=pizda(2,1)-pizda(1,2)
8110 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8111 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8112 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8113 C Cartesian gradient
8117 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8119 vv(1)=pizda(1,1)+pizda(2,2)
8120 vv(2)=pizda(2,1)-pizda(1,2)
8121 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8122 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8123 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8129 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8130 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8131 cd write (2,*) 'ijkl',i,j,k,l
8132 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8133 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8135 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8136 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8137 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8138 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8139 if (j.lt.nres-1) then
8146 if (l.lt.nres-1) then
8156 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8157 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8158 C summed up outside the subrouine as for the other subroutines
8159 C handling long-range interactions. The old code is commented out
8160 C with "cgrad" to keep track of changes.
8162 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8163 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8164 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8165 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8166 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8167 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8168 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8169 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8170 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8171 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8173 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8174 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8175 cgrad ghalf=0.5d0*ggg1(ll)
8177 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8178 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8179 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8180 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8181 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8182 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8183 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8184 cgrad ghalf=0.5d0*ggg2(ll)
8186 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8187 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8188 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8189 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8190 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8191 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8196 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8197 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8202 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8203 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8209 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8214 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8218 cd write (2,*) iii,g_corr5_loc(iii)
8221 cd write (2,*) 'ekont',ekont
8222 cd write (iout,*) 'eello5',ekont*eel5
8225 c--------------------------------------------------------------------------
8226 double precision function eello6(i,j,k,l,jj,kk)
8227 implicit real*8 (a-h,o-z)
8228 include 'DIMENSIONS'
8229 include 'COMMON.IOUNITS'
8230 include 'COMMON.CHAIN'
8231 include 'COMMON.DERIV'
8232 include 'COMMON.INTERACT'
8233 include 'COMMON.CONTACTS'
8234 include 'COMMON.TORSION'
8235 include 'COMMON.VAR'
8236 include 'COMMON.GEO'
8237 include 'COMMON.FFIELD'
8238 double precision ggg1(3),ggg2(3)
8239 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8244 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8252 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8253 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8257 derx(lll,kkk,iii)=0.0d0
8261 cd eij=facont_hb(jj,i)
8262 cd ekl=facont_hb(kk,k)
8268 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8269 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8270 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8271 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8272 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8273 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8275 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8276 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8277 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8278 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8279 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8280 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8284 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8286 C If turn contributions are considered, they will be handled separately.
8287 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8288 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8289 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8290 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8291 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8292 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8293 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8295 if (j.lt.nres-1) then
8302 if (l.lt.nres-1) then
8310 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8311 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8312 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8313 cgrad ghalf=0.5d0*ggg1(ll)
8315 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8316 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8317 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8318 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8319 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8320 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8321 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8322 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8323 cgrad ghalf=0.5d0*ggg2(ll)
8324 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8326 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8327 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8328 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8329 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8330 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8331 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8336 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8337 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8342 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8343 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8349 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8354 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8358 cd write (2,*) iii,g_corr6_loc(iii)
8361 cd write (2,*) 'ekont',ekont
8362 cd write (iout,*) 'eello6',ekont*eel6
8365 c--------------------------------------------------------------------------
8366 double precision function eello6_graph1(i,j,k,l,imat,swap)
8367 implicit real*8 (a-h,o-z)
8368 include 'DIMENSIONS'
8369 include 'COMMON.IOUNITS'
8370 include 'COMMON.CHAIN'
8371 include 'COMMON.DERIV'
8372 include 'COMMON.INTERACT'
8373 include 'COMMON.CONTACTS'
8374 include 'COMMON.TORSION'
8375 include 'COMMON.VAR'
8376 include 'COMMON.GEO'
8377 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8381 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8383 C Parallel Antiparallel
8389 C \ j|/k\| / \ |/k\|l /
8394 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8395 itk=itortyp(itype(k))
8396 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8397 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8398 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8399 call transpose2(EUgC(1,1,k),auxmat(1,1))
8400 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8401 vv1(1)=pizda1(1,1)-pizda1(2,2)
8402 vv1(2)=pizda1(1,2)+pizda1(2,1)
8403 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8404 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8405 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8406 s5=scalar2(vv(1),Dtobr2(1,i))
8407 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8408 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8409 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8410 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8411 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8412 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8413 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8414 & +scalar2(vv(1),Dtobr2der(1,i)))
8415 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8416 vv1(1)=pizda1(1,1)-pizda1(2,2)
8417 vv1(2)=pizda1(1,2)+pizda1(2,1)
8418 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8419 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8421 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8422 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8423 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8424 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8425 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8427 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8428 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8429 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8430 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8431 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8433 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8434 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8435 vv1(1)=pizda1(1,1)-pizda1(2,2)
8436 vv1(2)=pizda1(1,2)+pizda1(2,1)
8437 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8438 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8439 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8440 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8449 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8450 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8451 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8452 call transpose2(EUgC(1,1,k),auxmat(1,1))
8453 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8455 vv1(1)=pizda1(1,1)-pizda1(2,2)
8456 vv1(2)=pizda1(1,2)+pizda1(2,1)
8457 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8458 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8459 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8460 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8461 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8462 s5=scalar2(vv(1),Dtobr2(1,i))
8463 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8469 c----------------------------------------------------------------------------
8470 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8471 implicit real*8 (a-h,o-z)
8472 include 'DIMENSIONS'
8473 include 'COMMON.IOUNITS'
8474 include 'COMMON.CHAIN'
8475 include 'COMMON.DERIV'
8476 include 'COMMON.INTERACT'
8477 include 'COMMON.CONTACTS'
8478 include 'COMMON.TORSION'
8479 include 'COMMON.VAR'
8480 include 'COMMON.GEO'
8482 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8483 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8486 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8488 C Parallel Antiparallel C
8494 C \ j|/k\| \ |/k\|l C
8499 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8500 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8501 C AL 7/4/01 s1 would occur in the sixth-order moment,
8502 C but not in a cluster cumulant
8504 s1=dip(1,jj,i)*dip(1,kk,k)
8506 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8507 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8508 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8509 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8510 call transpose2(EUg(1,1,k),auxmat(1,1))
8511 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8512 vv(1)=pizda(1,1)-pizda(2,2)
8513 vv(2)=pizda(1,2)+pizda(2,1)
8514 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8515 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8517 eello6_graph2=-(s1+s2+s3+s4)
8519 eello6_graph2=-(s2+s3+s4)
8522 C Derivatives in gamma(i-1)
8525 s1=dipderg(1,jj,i)*dip(1,kk,k)
8527 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8528 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8529 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8530 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8532 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8534 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8536 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8538 C Derivatives in gamma(k-1)
8540 s1=dip(1,jj,i)*dipderg(1,kk,k)
8542 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8543 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8544 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8545 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8546 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8547 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8548 vv(1)=pizda(1,1)-pizda(2,2)
8549 vv(2)=pizda(1,2)+pizda(2,1)
8550 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8552 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8554 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8556 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8557 C Derivatives in gamma(j-1) or gamma(l-1)
8560 s1=dipderg(3,jj,i)*dip(1,kk,k)
8562 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8563 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8564 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8565 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8566 vv(1)=pizda(1,1)-pizda(2,2)
8567 vv(2)=pizda(1,2)+pizda(2,1)
8568 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8571 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8573 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8576 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8577 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8579 C Derivatives in gamma(l-1) or gamma(j-1)
8582 s1=dip(1,jj,i)*dipderg(3,kk,k)
8584 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8585 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8586 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8587 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8588 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8589 vv(1)=pizda(1,1)-pizda(2,2)
8590 vv(2)=pizda(1,2)+pizda(2,1)
8591 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8594 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8596 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8599 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8600 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8602 C Cartesian derivatives.
8604 write (2,*) 'In eello6_graph2'
8606 write (2,*) 'iii=',iii
8608 write (2,*) 'kkk=',kkk
8610 write (2,'(3(2f10.5),5x)')
8611 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8621 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8623 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8626 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8628 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8629 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8631 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8632 call transpose2(EUg(1,1,k),auxmat(1,1))
8633 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8635 vv(1)=pizda(1,1)-pizda(2,2)
8636 vv(2)=pizda(1,2)+pizda(2,1)
8637 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8638 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8640 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8642 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8645 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8647 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8654 c----------------------------------------------------------------------------
8655 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8656 implicit real*8 (a-h,o-z)
8657 include 'DIMENSIONS'
8658 include 'COMMON.IOUNITS'
8659 include 'COMMON.CHAIN'
8660 include 'COMMON.DERIV'
8661 include 'COMMON.INTERACT'
8662 include 'COMMON.CONTACTS'
8663 include 'COMMON.TORSION'
8664 include 'COMMON.VAR'
8665 include 'COMMON.GEO'
8666 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8668 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8670 C Parallel Antiparallel C
8676 C j|/k\| / |/k\|l / C
8681 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8683 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8684 C energy moment and not to the cluster cumulant.
8685 iti=itortyp(itype(i))
8686 if (j.lt.nres-1) then
8687 itj1=itortyp(itype(j+1))
8691 itk=itortyp(itype(k))
8692 itk1=itortyp(itype(k+1))
8693 if (l.lt.nres-1) then
8694 itl1=itortyp(itype(l+1))
8699 s1=dip(4,jj,i)*dip(4,kk,k)
8701 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8702 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8703 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8704 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8705 call transpose2(EE(1,1,itk),auxmat(1,1))
8706 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8707 vv(1)=pizda(1,1)+pizda(2,2)
8708 vv(2)=pizda(2,1)-pizda(1,2)
8709 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8710 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8711 cd & "sum",-(s2+s3+s4)
8713 eello6_graph3=-(s1+s2+s3+s4)
8715 eello6_graph3=-(s2+s3+s4)
8718 C Derivatives in gamma(k-1)
8719 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8720 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8721 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8722 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8723 C Derivatives in gamma(l-1)
8724 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8725 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8726 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8727 vv(1)=pizda(1,1)+pizda(2,2)
8728 vv(2)=pizda(2,1)-pizda(1,2)
8729 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8730 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8731 C Cartesian derivatives.
8737 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8739 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8742 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8744 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8745 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8747 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8748 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8750 vv(1)=pizda(1,1)+pizda(2,2)
8751 vv(2)=pizda(2,1)-pizda(1,2)
8752 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8754 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8756 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8759 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8761 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8763 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8769 c----------------------------------------------------------------------------
8770 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8771 implicit real*8 (a-h,o-z)
8772 include 'DIMENSIONS'
8773 include 'COMMON.IOUNITS'
8774 include 'COMMON.CHAIN'
8775 include 'COMMON.DERIV'
8776 include 'COMMON.INTERACT'
8777 include 'COMMON.CONTACTS'
8778 include 'COMMON.TORSION'
8779 include 'COMMON.VAR'
8780 include 'COMMON.GEO'
8781 include 'COMMON.FFIELD'
8782 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8783 & auxvec1(2),auxmat1(2,2)
8785 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8787 C Parallel Antiparallel C
8793 C \ j|/k\| \ |/k\|l C
8798 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8800 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8801 C energy moment and not to the cluster cumulant.
8802 cd write (2,*) 'eello_graph4: wturn6',wturn6
8803 iti=itortyp(itype(i))
8804 itj=itortyp(itype(j))
8805 if (j.lt.nres-1) then
8806 itj1=itortyp(itype(j+1))
8810 itk=itortyp(itype(k))
8811 if (k.lt.nres-1) then
8812 itk1=itortyp(itype(k+1))
8816 itl=itortyp(itype(l))
8817 if (l.lt.nres-1) then
8818 itl1=itortyp(itype(l+1))
8822 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8823 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8824 cd & ' itl',itl,' itl1',itl1
8827 s1=dip(3,jj,i)*dip(3,kk,k)
8829 s1=dip(2,jj,j)*dip(2,kk,l)
8832 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8833 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8835 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8836 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8838 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8839 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8841 call transpose2(EUg(1,1,k),auxmat(1,1))
8842 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8843 vv(1)=pizda(1,1)-pizda(2,2)
8844 vv(2)=pizda(2,1)+pizda(1,2)
8845 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8846 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8848 eello6_graph4=-(s1+s2+s3+s4)
8850 eello6_graph4=-(s2+s3+s4)
8852 C Derivatives in gamma(i-1)
8856 s1=dipderg(2,jj,i)*dip(3,kk,k)
8858 s1=dipderg(4,jj,j)*dip(2,kk,l)
8861 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8863 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8864 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8866 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8867 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8869 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8870 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8871 cd write (2,*) 'turn6 derivatives'
8873 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8875 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8879 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8881 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8885 C Derivatives in gamma(k-1)
8888 s1=dip(3,jj,i)*dipderg(2,kk,k)
8890 s1=dip(2,jj,j)*dipderg(4,kk,l)
8893 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8894 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8896 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8897 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8899 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8900 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8902 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8903 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8904 vv(1)=pizda(1,1)-pizda(2,2)
8905 vv(2)=pizda(2,1)+pizda(1,2)
8906 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8907 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8909 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8911 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8915 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8917 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8920 C Derivatives in gamma(j-1) or gamma(l-1)
8921 if (l.eq.j+1 .and. l.gt.1) then
8922 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8923 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8924 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8925 vv(1)=pizda(1,1)-pizda(2,2)
8926 vv(2)=pizda(2,1)+pizda(1,2)
8927 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8928 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8929 else if (j.gt.1) then
8930 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8931 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8932 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8933 vv(1)=pizda(1,1)-pizda(2,2)
8934 vv(2)=pizda(2,1)+pizda(1,2)
8935 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8936 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8937 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8939 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8942 C Cartesian derivatives.
8949 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8951 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8955 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8957 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8961 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8963 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8965 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8966 & b1(1,itj1),auxvec(1))
8967 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8969 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8970 & b1(1,itl1),auxvec(1))
8971 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8973 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8975 vv(1)=pizda(1,1)-pizda(2,2)
8976 vv(2)=pizda(2,1)+pizda(1,2)
8977 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8979 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8981 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8984 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8987 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8990 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8992 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8994 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8998 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9000 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9003 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9005 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9013 c----------------------------------------------------------------------------
9014 double precision function eello_turn6(i,jj,kk)
9015 implicit real*8 (a-h,o-z)
9016 include 'DIMENSIONS'
9017 include 'COMMON.IOUNITS'
9018 include 'COMMON.CHAIN'
9019 include 'COMMON.DERIV'
9020 include 'COMMON.INTERACT'
9021 include 'COMMON.CONTACTS'
9022 include 'COMMON.TORSION'
9023 include 'COMMON.VAR'
9024 include 'COMMON.GEO'
9025 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9026 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9028 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9029 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9030 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9031 C the respective energy moment and not to the cluster cumulant.
9040 iti=itortyp(itype(i))
9041 itk=itortyp(itype(k))
9042 itk1=itortyp(itype(k+1))
9043 itl=itortyp(itype(l))
9044 itj=itortyp(itype(j))
9045 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9046 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9047 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9052 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9054 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9058 derx_turn(lll,kkk,iii)=0.0d0
9065 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9067 cd write (2,*) 'eello6_5',eello6_5
9069 call transpose2(AEA(1,1,1),auxmat(1,1))
9070 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9071 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9072 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9074 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9075 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9076 s2 = scalar2(b1(1,itk),vtemp1(1))
9078 call transpose2(AEA(1,1,2),atemp(1,1))
9079 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9080 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9081 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9083 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9084 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9085 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9087 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9088 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9089 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9090 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9091 ss13 = scalar2(b1(1,itk),vtemp4(1))
9092 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9094 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9100 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9101 C Derivatives in gamma(i+2)
9105 call transpose2(AEA(1,1,1),auxmatd(1,1))
9106 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9107 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9108 call transpose2(AEAderg(1,1,2),atempd(1,1))
9109 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9110 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9112 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9113 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9114 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9120 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9121 C Derivatives in gamma(i+3)
9123 call transpose2(AEA(1,1,1),auxmatd(1,1))
9124 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9125 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9126 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9128 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9129 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9130 s2d = scalar2(b1(1,itk),vtemp1d(1))
9132 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9133 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9135 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9137 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9138 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9139 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9147 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9148 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9150 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9151 & -0.5d0*ekont*(s2d+s12d)
9153 C Derivatives in gamma(i+4)
9154 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9155 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9156 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9158 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9159 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9160 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9168 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9170 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9172 C Derivatives in gamma(i+5)
9174 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9175 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9176 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9178 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9179 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9180 s2d = scalar2(b1(1,itk),vtemp1d(1))
9182 call transpose2(AEA(1,1,2),atempd(1,1))
9183 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9184 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9186 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9187 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9189 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9190 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9191 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9199 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9200 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9202 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9203 & -0.5d0*ekont*(s2d+s12d)
9205 C Cartesian derivatives
9210 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9211 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9212 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9214 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9215 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9217 s2d = scalar2(b1(1,itk),vtemp1d(1))
9219 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9220 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9221 s8d = -(atempd(1,1)+atempd(2,2))*
9222 & scalar2(cc(1,1,itl),vtemp2(1))
9224 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9226 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9227 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9234 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9237 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9241 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9242 & - 0.5d0*(s8d+s12d)
9244 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9253 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9255 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9256 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9257 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9258 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9259 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9261 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9262 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9263 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9267 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9268 cd & 16*eel_turn6_num
9270 if (j.lt.nres-1) then
9277 if (l.lt.nres-1) then
9285 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9286 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9287 cgrad ghalf=0.5d0*ggg1(ll)
9289 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9290 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9291 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9292 & +ekont*derx_turn(ll,2,1)
9293 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9294 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9295 & +ekont*derx_turn(ll,4,1)
9296 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9297 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9298 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9299 cgrad ghalf=0.5d0*ggg2(ll)
9301 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9302 & +ekont*derx_turn(ll,2,2)
9303 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9304 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9305 & +ekont*derx_turn(ll,4,2)
9306 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9307 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9308 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9313 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9318 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9324 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9329 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9333 cd write (2,*) iii,g_corr6_loc(iii)
9335 eello_turn6=ekont*eel_turn6
9336 cd write (2,*) 'ekont',ekont
9337 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9341 C-----------------------------------------------------------------------------
9342 double precision function scalar(u,v)
9343 !DIR$ INLINEALWAYS scalar
9345 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9348 double precision u(3),v(3)
9349 cd double precision sc
9357 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9360 crc-------------------------------------------------
9361 SUBROUTINE MATVEC2(A1,V1,V2)
9362 !DIR$ INLINEALWAYS MATVEC2
9364 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9366 implicit real*8 (a-h,o-z)
9367 include 'DIMENSIONS'
9368 DIMENSION A1(2,2),V1(2),V2(2)
9372 c 3 VI=VI+A1(I,K)*V1(K)
9376 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9377 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9382 C---------------------------------------
9383 SUBROUTINE MATMAT2(A1,A2,A3)
9385 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9387 implicit real*8 (a-h,o-z)
9388 include 'DIMENSIONS'
9389 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9390 c DIMENSION AI3(2,2)
9394 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9400 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9401 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9402 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9403 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9411 c-------------------------------------------------------------------------
9412 double precision function scalar2(u,v)
9413 !DIR$ INLINEALWAYS scalar2
9415 double precision u(2),v(2)
9418 scalar2=u(1)*v(1)+u(2)*v(2)
9422 C-----------------------------------------------------------------------------
9424 subroutine transpose2(a,at)
9425 !DIR$ INLINEALWAYS transpose2
9427 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9430 double precision a(2,2),at(2,2)
9437 c--------------------------------------------------------------------------
9438 subroutine transpose(n,a,at)
9441 double precision a(n,n),at(n,n)
9449 C---------------------------------------------------------------------------
9450 subroutine prodmat3(a1,a2,kk,transp,prod)
9451 !DIR$ INLINEALWAYS prodmat3
9453 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9457 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9459 crc double precision auxmat(2,2),prod_(2,2)
9462 crc call transpose2(kk(1,1),auxmat(1,1))
9463 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9464 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9466 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9467 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9468 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9469 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9470 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9471 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9472 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9473 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9476 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9477 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9479 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9480 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9481 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9482 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9483 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9484 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9485 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9486 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9489 c call transpose2(a2(1,1),a2t(1,1))
9492 crc print *,((prod_(i,j),i=1,2),j=1,2)
9493 crc print *,((prod(i,j),i=1,2),j=1,2)