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)
260 print *,'iset=',iset,'me=',me,ehomology_constr,
261 & 'Processor',fg_rank,' CG group',kolor,
262 & ' absolute rank',MyRank
264 ehomology_constr=0.0d0
268 c write(iout,*) ehomology_constr
269 c print *,"Processor",myrank," computed Utor"
271 C 6/23/01 Calculate double-torsional energy
273 if (wtor_d.gt.0) then
278 c print *,"Processor",myrank," computed Utord"
280 C 21/5/07 Calculate local sicdechain correlation energy
282 if (wsccor.gt.0.0d0) then
283 call eback_sc_corr(esccor)
287 c print *,"Processor",myrank," computed Usccorr"
289 C 12/1/95 Multi-body terms
293 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
294 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
295 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
296 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
297 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
304 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
305 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
306 cd write (iout,*) "multibody_hb ecorr",ecorr
308 c print *,"Processor",myrank," computed Ucorr"
310 C If performing constraint dynamics, call the constraint energy
311 C after the equilibration time
312 if(usampl.and.totT.gt.eq_time) then
321 time_enecalc=time_enecalc+MPI_Wtime()-time00
323 time_enecalc=time_enecalc+tcpu()-time00
326 c print *,"Processor",myrank," computed Uconstr"
339 energia(2)=evdw2-evdw2_14
356 energia(8)=eello_turn3
357 energia(9)=eello_turn4
364 energia(19)=edihcnstr
366 energia(20)=Uconst+Uconst_back
370 energia(24)=ehomology_constr
375 c print *," Processor",myrank," calls SUM_ENERGY"
376 call sum_energy(energia,.true.)
377 if (dyn_ss) call dyn_set_nss
378 c print *," Processor",myrank," left SUM_ENERGY"
381 time_sumene=time_sumene+MPI_Wtime()-time00
383 time_sumene=time_sumene+tcpu()-time00
388 c-------------------------------------------------------------------------------
389 subroutine sum_energy(energia,reduce)
390 implicit real*8 (a-h,o-z)
395 cMS$ATTRIBUTES C :: proc_proc
401 include 'COMMON.SETUP'
402 include 'COMMON.IOUNITS'
403 double precision energia(0:n_ene),enebuff(0:n_ene+1)
404 include 'COMMON.FFIELD'
405 include 'COMMON.DERIV'
406 include 'COMMON.INTERACT'
407 include 'COMMON.SBRIDGE'
408 include 'COMMON.CHAIN'
410 include 'COMMON.CONTROL'
411 include 'COMMON.TIME1'
414 if (nfgtasks.gt.1 .and. reduce) then
416 write (iout,*) "energies before REDUCE"
417 call enerprint(energia)
421 enebuff(i)=energia(i)
424 call MPI_Barrier(FG_COMM,IERR)
425 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
427 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
428 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
430 write (iout,*) "energies after REDUCE"
431 call enerprint(energia)
434 time_Reduce=time_Reduce+MPI_Wtime()-time00
436 if (fg_rank.eq.0) then
439 evdw=energia(22)+wsct*energia(23)
444 evdw2=energia(2)+energia(18)
460 eello_turn3=energia(8)
461 eello_turn4=energia(9)
468 edihcnstr=energia(19)
472 ehomology_constr=energia(24)
478 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
479 & +wang*ebe+wtor*etors+wscloc*escloc
480 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
481 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
482 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
483 & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
484 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
487 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
488 & +wang*ebe+wtor*etors+wscloc*escloc
489 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
490 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
491 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
492 & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
493 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
500 if (isnan(etot).ne.0) energia(0)=1.0d+99
502 if (isnan(etot)) energia(0)=1.0d+99
507 idumm=proc_proc(etot,i)
509 call proc_proc(etot,i)
511 if(i.eq.1)energia(0)=1.0d+99
518 c-------------------------------------------------------------------------------
519 subroutine sum_gradient
520 implicit real*8 (a-h,o-z)
525 cMS$ATTRIBUTES C :: proc_proc
531 double precision gradbufc(3,maxres),gradbufx(3,maxres),
532 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
533 include 'COMMON.SETUP'
534 include 'COMMON.IOUNITS'
535 include 'COMMON.FFIELD'
536 include 'COMMON.DERIV'
537 include 'COMMON.INTERACT'
538 include 'COMMON.SBRIDGE'
539 include 'COMMON.CHAIN'
541 include 'COMMON.CONTROL'
542 include 'COMMON.TIME1'
543 include 'COMMON.MAXGRAD'
544 include 'COMMON.SCCOR'
553 write (iout,*) "sum_gradient gvdwc, gvdwx"
555 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
556 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
557 & (gvdwcT(j,i),j=1,3)
562 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
563 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
564 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
567 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
568 C in virtual-bond-vector coordinates
571 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
573 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
574 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
576 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
578 c write (iout,'(i5,3f10.5,2x,f10.5)')
579 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
581 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
583 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
584 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
593 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
594 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
595 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
596 & wel_loc*gel_loc_long(j,i)+
597 & wcorr*gradcorr_long(j,i)+
598 & wcorr5*gradcorr5_long(j,i)+
599 & wcorr6*gradcorr6_long(j,i)+
600 & wturn6*gcorr6_turn_long(j,i)+
601 & wstrain*ghpbc(j,i)+
602 & wdfa_dist*gdfad(j,i)+
603 & wdfa_tor*gdfat(j,i)+
604 & wdfa_nei*gdfan(j,i)+
605 & wdfa_beta*gdfab(j,i)
611 gradbufc(j,i)=wsc*gvdwc(j,i)+
612 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
613 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
614 & wel_loc*gel_loc_long(j,i)+
615 & wcorr*gradcorr_long(j,i)+
616 & wcorr5*gradcorr5_long(j,i)+
617 & wcorr6*gradcorr6_long(j,i)+
618 & wturn6*gcorr6_turn_long(j,i)+
619 & wstrain*ghpbc(j,i)+
620 & wdfa_dist*gdfad(j,i)+
621 & wdfa_tor*gdfat(j,i)+
622 & wdfa_nei*gdfan(j,i)+
623 & wdfa_beta*gdfab(j,i)
630 gradbufc(j,i)=wsc*gvdwc(j,i)+
631 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
632 & welec*gelc_long(j,i)+
634 & wel_loc*gel_loc_long(j,i)+
635 & wcorr*gradcorr_long(j,i)+
636 & wcorr5*gradcorr5_long(j,i)+
637 & wcorr6*gradcorr6_long(j,i)+
638 & wturn6*gcorr6_turn_long(j,i)+
639 & wstrain*ghpbc(j,i)+
640 & wdfa_dist*gdfad(j,i)+
641 & wdfa_tor*gdfat(j,i)+
642 & wdfa_nei*gdfan(j,i)+
643 & wdfa_beta*gdfab(j,i)
648 if (nfgtasks.gt.1) then
651 write (iout,*) "gradbufc before allreduce"
653 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
659 gradbufc_sum(j,i)=gradbufc(j,i)
662 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
663 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
664 c time_reduce=time_reduce+MPI_Wtime()-time00
666 c write (iout,*) "gradbufc_sum after allreduce"
668 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
673 c time_allreduce=time_allreduce+MPI_Wtime()-time00
681 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
682 write (iout,*) (i," jgrad_start",jgrad_start(i),
683 & " jgrad_end ",jgrad_end(i),
684 & i=igrad_start,igrad_end)
687 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
688 c do not parallelize this part.
690 c do i=igrad_start,igrad_end
691 c do j=jgrad_start(i),jgrad_end(i)
693 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
698 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
702 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
706 write (iout,*) "gradbufc after summing"
708 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
715 write (iout,*) "gradbufc"
717 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
723 gradbufc_sum(j,i)=gradbufc(j,i)
728 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
732 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
737 c gradbufc(k,i)=0.0d0
741 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
746 write (iout,*) "gradbufc after summing"
748 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
756 gradbufc(k,nres)=0.0d0
761 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
762 & wel_loc*gel_loc(j,i)+
763 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
764 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
765 & wel_loc*gel_loc_long(j,i)+
766 & wcorr*gradcorr_long(j,i)+
767 & wcorr5*gradcorr5_long(j,i)+
768 & wcorr6*gradcorr6_long(j,i)+
769 & wturn6*gcorr6_turn_long(j,i))+
771 & wcorr*gradcorr(j,i)+
772 & wturn3*gcorr3_turn(j,i)+
773 & wturn4*gcorr4_turn(j,i)+
774 & wcorr5*gradcorr5(j,i)+
775 & wcorr6*gradcorr6(j,i)+
776 & wturn6*gcorr6_turn(j,i)+
777 & wsccor*gsccorc(j,i)
778 & +wscloc*gscloc(j,i)
780 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
781 & wel_loc*gel_loc(j,i)+
782 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
783 & welec*gelc_long(j,i)+
784 & wel_loc*gel_loc_long(j,i)+
785 & wcorr*gcorr_long(j,i)+
786 & wcorr5*gradcorr5_long(j,i)+
787 & wcorr6*gradcorr6_long(j,i)+
788 & wturn6*gcorr6_turn_long(j,i))+
790 & wcorr*gradcorr(j,i)+
791 & wturn3*gcorr3_turn(j,i)+
792 & wturn4*gcorr4_turn(j,i)+
793 & wcorr5*gradcorr5(j,i)+
794 & wcorr6*gradcorr6(j,i)+
795 & wturn6*gcorr6_turn(j,i)+
796 & wsccor*gsccorc(j,i)
797 & +wscloc*gscloc(j,i)
800 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
801 & wscp*gradx_scp(j,i)+
803 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
804 & wsccor*gsccorx(j,i)
805 & +wscloc*gsclocx(j,i)
807 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
809 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
810 & wsccor*gsccorx(j,i)
811 & +wscloc*gsclocx(j,i)
816 write (iout,*) "gloc before adding corr"
818 write (iout,*) i,gloc(i,icg)
822 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
823 & +wcorr5*g_corr5_loc(i)
824 & +wcorr6*g_corr6_loc(i)
825 & +wturn4*gel_loc_turn4(i)
826 & +wturn3*gel_loc_turn3(i)
827 & +wturn6*gel_loc_turn6(i)
828 & +wel_loc*gel_loc_loc(i)
831 write (iout,*) "gloc after adding corr"
833 write (iout,*) i,gloc(i,icg)
837 if (nfgtasks.gt.1) then
840 gradbufc(j,i)=gradc(j,i,icg)
841 gradbufx(j,i)=gradx(j,i,icg)
845 glocbuf(i)=gloc(i,icg)
848 write (iout,*) "gloc_sc before reduce"
851 write (iout,*) i,j,gloc_sc(j,i,icg)
857 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
861 call MPI_Barrier(FG_COMM,IERR)
862 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
864 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
865 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
866 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
867 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
868 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
869 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
870 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
871 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
872 time_reduce=time_reduce+MPI_Wtime()-time00
874 write (iout,*) "gloc_sc after reduce"
877 write (iout,*) i,j,gloc_sc(j,i,icg)
882 write (iout,*) "gloc after reduce"
884 write (iout,*) i,gloc(i,icg)
889 if (gnorm_check) then
891 c Compute the maximum elements of the gradient
901 gcorr3_turn_max=0.0d0
902 gcorr4_turn_max=0.0d0
905 gcorr6_turn_max=0.0d0
915 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
916 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
918 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
919 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
921 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
922 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
923 & gvdwc_scp_max=gvdwc_scp_norm
924 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
925 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
926 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
927 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
928 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
929 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
930 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
931 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
932 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
933 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
934 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
935 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
936 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
938 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
939 & gcorr3_turn_max=gcorr3_turn_norm
940 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
942 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
943 & gcorr4_turn_max=gcorr4_turn_norm
944 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
945 if (gradcorr5_norm.gt.gradcorr5_max)
946 & gradcorr5_max=gradcorr5_norm
947 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
948 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
949 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
951 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
952 & gcorr6_turn_max=gcorr6_turn_norm
953 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
954 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
955 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
956 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
957 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
958 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
960 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
961 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
963 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
964 if (gradx_scp_norm.gt.gradx_scp_max)
965 & gradx_scp_max=gradx_scp_norm
966 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
967 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
968 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
969 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
970 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
971 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
972 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
973 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
977 open(istat,file=statname,position="append")
979 open(istat,file=statname,access="append")
981 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
982 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
983 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
984 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
985 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
986 & gsccorx_max,gsclocx_max
988 if (gvdwc_max.gt.1.0d4) then
989 write (iout,*) "gvdwc gvdwx gradb gradbx"
991 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
992 & gradb(j,i),gradbx(j,i),j=1,3)
994 call pdbout(0.0d0,'cipiszcze',iout)
1000 write (iout,*) "gradc gradx gloc"
1002 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
1003 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
1008 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
1010 time_sumgradient=time_sumgradient+tcpu()-time01
1015 c-------------------------------------------------------------------------------
1016 subroutine rescale_weights(t_bath)
1017 implicit real*8 (a-h,o-z)
1018 include 'DIMENSIONS'
1019 include 'COMMON.IOUNITS'
1020 include 'COMMON.FFIELD'
1021 include 'COMMON.SBRIDGE'
1022 double precision kfac /2.4d0/
1023 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
1025 c facT=2*temp0/(t_bath+temp0)
1026 if (rescale_mode.eq.0) then
1032 else if (rescale_mode.eq.1) then
1033 facT=kfac/(kfac-1.0d0+t_bath/temp0)
1034 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1035 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1036 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1037 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1038 else if (rescale_mode.eq.2) then
1044 facT=licznik/dlog(dexp(x)+dexp(-x))
1045 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
1046 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
1047 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
1048 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
1050 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1051 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1053 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1057 welec=weights(3)*fact
1058 wcorr=weights(4)*fact3
1059 wcorr5=weights(5)*fact4
1060 wcorr6=weights(6)*fact5
1061 wel_loc=weights(7)*fact2
1062 wturn3=weights(8)*fact2
1063 wturn4=weights(9)*fact3
1064 wturn6=weights(10)*fact5
1065 wtor=weights(13)*fact
1066 wtor_d=weights(14)*fact2
1067 wsccor=weights(21)*fact
1070 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1074 C------------------------------------------------------------------------
1075 subroutine enerprint(energia)
1076 implicit real*8 (a-h,o-z)
1077 include 'DIMENSIONS'
1078 include 'COMMON.IOUNITS'
1079 include 'COMMON.FFIELD'
1080 include 'COMMON.SBRIDGE'
1082 double precision energia(0:n_ene)
1085 evdw=energia(22)+wsct*energia(23)
1091 evdw2=energia(2)+energia(18)
1103 eello_turn3=energia(8)
1104 eello_turn4=energia(9)
1105 eello_turn6=energia(10)
1111 edihcnstr=energia(19)
1115 ehomology_constr=energia(24)
1117 edfadis = energia(25)
1118 edfator = energia(26)
1119 edfanei = energia(27)
1120 edfabet = energia(28)
1123 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1124 & estr,wbond,ebe,wang,
1125 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1127 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1128 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1129 & edihcnstr,ehomology_constr, ebr*nss,
1130 & Uconst,edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
1131 & edfabet,wdfa_beta,etot
1132 10 format (/'Virtual-chain energies:'//
1133 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
1134 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
1135 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
1136 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
1137 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
1138 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
1139 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
1140 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
1141 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
1142 & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6,
1143 & ' (SS bridges & dist. cnstr.)'/
1144 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1145 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1146 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1147 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
1148 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
1149 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
1150 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
1151 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
1152 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1153 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1154 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1155 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1156 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
1157 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
1158 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
1159 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
1160 & 'ETOT= ',1pE16.6,' (total)')
1162 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1163 & estr,wbond,ebe,wang,
1164 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1166 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1167 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1168 & ehomology_constr,ebr*nss,Uconst,edfadis,wdfa_dist,edfator,
1169 & wdfa_tor,edfanei,wdfa_nei,edfabet,wdfa_beta,
1171 10 format (/'Virtual-chain energies:'//
1172 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1173 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1174 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1175 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1176 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1177 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1178 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1179 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1180 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1181 & ' (SS bridges & dist. cnstr.)'/
1182 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1183 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1184 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1185 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1186 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1187 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1188 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1189 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1190 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1191 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1192 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1193 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1194 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
1195 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
1196 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
1197 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
1198 & 'ETOT= ',1pE16.6,' (total)')
1202 C-----------------------------------------------------------------------
1203 subroutine elj(evdw,evdw_p,evdw_m)
1205 C This subroutine calculates the interaction energy of nonbonded side chains
1206 C assuming the LJ potential of interaction.
1208 implicit real*8 (a-h,o-z)
1209 include 'DIMENSIONS'
1210 parameter (accur=1.0d-10)
1211 include 'COMMON.GEO'
1212 include 'COMMON.VAR'
1213 include 'COMMON.LOCAL'
1214 include 'COMMON.CHAIN'
1215 include 'COMMON.DERIV'
1216 include 'COMMON.INTERACT'
1217 include 'COMMON.TORSION'
1218 include 'COMMON.SBRIDGE'
1219 include 'COMMON.NAMES'
1220 include 'COMMON.IOUNITS'
1221 include 'COMMON.CONTACTS'
1223 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1225 do i=iatsc_s,iatsc_e
1234 C Calculate SC interaction energy.
1236 do iint=1,nint_gr(i)
1237 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1238 cd & 'iend=',iend(i,iint)
1239 do j=istart(i,iint),iend(i,iint)
1244 C Change 12/1/95 to calculate four-body interactions
1245 rij=xj*xj+yj*yj+zj*zj
1247 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1248 eps0ij=eps(itypi,itypj)
1250 e1=fac*fac*aa(itypi,itypj)
1251 e2=fac*bb(itypi,itypj)
1253 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1254 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1255 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1256 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1257 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1258 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1260 if (bb(itypi,itypj).gt.0) then
1261 evdw_p=evdw_p+evdwij
1263 evdw_m=evdw_m+evdwij
1269 C Calculate the components of the gradient in DC and X
1271 fac=-rrij*(e1+evdwij)
1276 if (bb(itypi,itypj).gt.0.0d0) then
1278 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1279 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1280 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1281 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1285 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1286 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1287 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1288 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1293 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1294 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1295 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1296 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1301 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1305 C 12/1/95, revised on 5/20/97
1307 C Calculate the contact function. The ith column of the array JCONT will
1308 C contain the numbers of atoms that make contacts with the atom I (of numbers
1309 C greater than I). The arrays FACONT and GACONT will contain the values of
1310 C the contact function and its derivative.
1312 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1313 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1314 C Uncomment next line, if the correlation interactions are contact function only
1315 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1317 sigij=sigma(itypi,itypj)
1318 r0ij=rs0(itypi,itypj)
1320 C Check whether the SC's are not too far to make a contact.
1323 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1324 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1326 if (fcont.gt.0.0D0) then
1327 C If the SC-SC distance if close to sigma, apply spline.
1328 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1329 cAdam & fcont1,fprimcont1)
1330 cAdam fcont1=1.0d0-fcont1
1331 cAdam if (fcont1.gt.0.0d0) then
1332 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1333 cAdam fcont=fcont*fcont1
1335 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1336 cga eps0ij=1.0d0/dsqrt(eps0ij)
1338 cga gg(k)=gg(k)*eps0ij
1340 cga eps0ij=-evdwij*eps0ij
1341 C Uncomment for AL's type of SC correlation interactions.
1342 cadam eps0ij=-evdwij
1343 num_conti=num_conti+1
1344 jcont(num_conti,i)=j
1345 facont(num_conti,i)=fcont*eps0ij
1346 fprimcont=eps0ij*fprimcont/rij
1348 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1349 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1350 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1351 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1352 gacont(1,num_conti,i)=-fprimcont*xj
1353 gacont(2,num_conti,i)=-fprimcont*yj
1354 gacont(3,num_conti,i)=-fprimcont*zj
1355 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1356 cd write (iout,'(2i3,3f10.5)')
1357 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1363 num_cont(i)=num_conti
1367 gvdwc(j,i)=expon*gvdwc(j,i)
1368 gvdwx(j,i)=expon*gvdwx(j,i)
1371 C******************************************************************************
1375 C To save time, the factor of EXPON has been extracted from ALL components
1376 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1379 C******************************************************************************
1382 C-----------------------------------------------------------------------------
1383 subroutine eljk(evdw,evdw_p,evdw_m)
1385 C This subroutine calculates the interaction energy of nonbonded side chains
1386 C assuming the LJK potential of interaction.
1388 implicit real*8 (a-h,o-z)
1389 include 'DIMENSIONS'
1390 include 'COMMON.GEO'
1391 include 'COMMON.VAR'
1392 include 'COMMON.LOCAL'
1393 include 'COMMON.CHAIN'
1394 include 'COMMON.DERIV'
1395 include 'COMMON.INTERACT'
1396 include 'COMMON.IOUNITS'
1397 include 'COMMON.NAMES'
1400 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1402 do i=iatsc_s,iatsc_e
1409 C Calculate SC interaction energy.
1411 do iint=1,nint_gr(i)
1412 do j=istart(i,iint),iend(i,iint)
1417 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1418 fac_augm=rrij**expon
1419 e_augm=augm(itypi,itypj)*fac_augm
1420 r_inv_ij=dsqrt(rrij)
1422 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1423 fac=r_shift_inv**expon
1424 e1=fac*fac*aa(itypi,itypj)
1425 e2=fac*bb(itypi,itypj)
1427 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1428 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1429 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1430 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1431 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1432 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1433 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1435 if (bb(itypi,itypj).gt.0) then
1436 evdw_p=evdw_p+evdwij
1438 evdw_m=evdw_m+evdwij
1444 C Calculate the components of the gradient in DC and X
1446 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1451 if (bb(itypi,itypj).gt.0.0d0) then
1453 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1454 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1455 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1456 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1460 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1461 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1462 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1463 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1468 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1469 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1470 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1471 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1476 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1484 gvdwc(j,i)=expon*gvdwc(j,i)
1485 gvdwx(j,i)=expon*gvdwx(j,i)
1490 C-----------------------------------------------------------------------------
1491 subroutine ebp(evdw,evdw_p,evdw_m)
1493 C This subroutine calculates the interaction energy of nonbonded side chains
1494 C assuming the Berne-Pechukas potential of interaction.
1496 implicit real*8 (a-h,o-z)
1497 include 'DIMENSIONS'
1498 include 'COMMON.GEO'
1499 include 'COMMON.VAR'
1500 include 'COMMON.LOCAL'
1501 include 'COMMON.CHAIN'
1502 include 'COMMON.DERIV'
1503 include 'COMMON.NAMES'
1504 include 'COMMON.INTERACT'
1505 include 'COMMON.IOUNITS'
1506 include 'COMMON.CALC'
1507 common /srutu/ icall
1508 c double precision rrsave(maxdim)
1511 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1513 c if (icall.eq.0) then
1519 do i=iatsc_s,iatsc_e
1525 dxi=dc_norm(1,nres+i)
1526 dyi=dc_norm(2,nres+i)
1527 dzi=dc_norm(3,nres+i)
1528 c dsci_inv=dsc_inv(itypi)
1529 dsci_inv=vbld_inv(i+nres)
1531 C Calculate SC interaction energy.
1533 do iint=1,nint_gr(i)
1534 do j=istart(i,iint),iend(i,iint)
1537 c dscj_inv=dsc_inv(itypj)
1538 dscj_inv=vbld_inv(j+nres)
1539 chi1=chi(itypi,itypj)
1540 chi2=chi(itypj,itypi)
1547 alf12=0.5D0*(alf1+alf2)
1548 C For diagnostics only!!!
1561 dxj=dc_norm(1,nres+j)
1562 dyj=dc_norm(2,nres+j)
1563 dzj=dc_norm(3,nres+j)
1564 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1565 cd if (icall.eq.0) then
1571 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1573 C Calculate whole angle-dependent part of epsilon and contributions
1574 C to its derivatives
1575 fac=(rrij*sigsq)**expon2
1576 e1=fac*fac*aa(itypi,itypj)
1577 e2=fac*bb(itypi,itypj)
1578 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1579 eps2der=evdwij*eps3rt
1580 eps3der=evdwij*eps2rt
1581 evdwij=evdwij*eps2rt*eps3rt
1583 if (bb(itypi,itypj).gt.0) then
1584 evdw_p=evdw_p+evdwij
1586 evdw_m=evdw_m+evdwij
1592 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1593 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1594 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1595 cd & restyp(itypi),i,restyp(itypj),j,
1596 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1597 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1598 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1601 C Calculate gradient components.
1602 e1=e1*eps1*eps2rt**2*eps3rt**2
1603 fac=-expon*(e1+evdwij)
1606 C Calculate radial part of the gradient
1610 C Calculate the angular part of the gradient and sum add the contributions
1611 C to the appropriate components of the Cartesian gradient.
1613 if (bb(itypi,itypj).gt.0) then
1627 C-----------------------------------------------------------------------------
1628 subroutine egb(evdw,evdw_p,evdw_m)
1630 C This subroutine calculates the interaction energy of nonbonded side chains
1631 C assuming the Gay-Berne potential of interaction.
1633 implicit real*8 (a-h,o-z)
1634 include 'DIMENSIONS'
1635 include 'COMMON.GEO'
1636 include 'COMMON.VAR'
1637 include 'COMMON.LOCAL'
1638 include 'COMMON.CHAIN'
1639 include 'COMMON.DERIV'
1640 include 'COMMON.NAMES'
1641 include 'COMMON.INTERACT'
1642 include 'COMMON.IOUNITS'
1643 include 'COMMON.CALC'
1644 include 'COMMON.CONTROL'
1645 include 'COMMON.SBRIDGE'
1648 ccccc energy_dec=.false.
1649 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1654 c if (icall.eq.0) lprn=.false.
1656 do i=iatsc_s,iatsc_e
1662 dxi=dc_norm(1,nres+i)
1663 dyi=dc_norm(2,nres+i)
1664 dzi=dc_norm(3,nres+i)
1665 c dsci_inv=dsc_inv(itypi)
1666 dsci_inv=vbld_inv(i+nres)
1667 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1668 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1670 C Calculate SC interaction energy.
1672 do iint=1,nint_gr(i)
1673 do j=istart(i,iint),iend(i,iint)
1674 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1675 call dyn_ssbond_ene(i,j,evdwij)
1677 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1678 & 'evdw',i,j,evdwij,' ss'
1682 c dscj_inv=dsc_inv(itypj)
1683 dscj_inv=vbld_inv(j+nres)
1684 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1685 c & 1.0d0/vbld(j+nres)
1686 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1687 sig0ij=sigma(itypi,itypj)
1688 chi1=chi(itypi,itypj)
1689 chi2=chi(itypj,itypi)
1696 alf12=0.5D0*(alf1+alf2)
1697 C For diagnostics only!!!
1710 dxj=dc_norm(1,nres+j)
1711 dyj=dc_norm(2,nres+j)
1712 dzj=dc_norm(3,nres+j)
1713 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1714 c write (iout,*) "j",j," dc_norm",
1715 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1716 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1718 C Calculate angle-dependent terms of energy and contributions to their
1722 sig=sig0ij*dsqrt(sigsq)
1723 rij_shift=1.0D0/rij-sig+sig0ij
1724 c for diagnostics; uncomment
1725 c rij_shift=1.2*sig0ij
1726 C I hate to put IF's in the loops, but here don't have another choice!!!!
1727 if (rij_shift.le.0.0D0) then
1729 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1730 cd & restyp(itypi),i,restyp(itypj),j,
1731 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1735 c---------------------------------------------------------------
1736 rij_shift=1.0D0/rij_shift
1737 fac=rij_shift**expon
1738 e1=fac*fac*aa(itypi,itypj)
1739 e2=fac*bb(itypi,itypj)
1740 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1741 eps2der=evdwij*eps3rt
1742 eps3der=evdwij*eps2rt
1743 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1744 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1745 evdwij=evdwij*eps2rt*eps3rt
1747 if (bb(itypi,itypj).gt.0) then
1748 evdw_p=evdw_p+evdwij
1750 evdw_m=evdw_m+evdwij
1756 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1757 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1758 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1759 & restyp(itypi),i,restyp(itypj),j,
1760 & epsi,sigm,chi1,chi2,chip1,chip2,
1761 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1762 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1766 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1769 C Calculate gradient components.
1770 e1=e1*eps1*eps2rt**2*eps3rt**2
1771 fac=-expon*(e1+evdwij)*rij_shift
1775 C Calculate the radial part of the gradient
1779 C Calculate angular part of the gradient.
1781 if (bb(itypi,itypj).gt.0) then
1793 c write (iout,*) "Number of loop steps in EGB:",ind
1794 cccc energy_dec=.false.
1797 C-----------------------------------------------------------------------------
1798 subroutine egbv(evdw,evdw_p,evdw_m)
1800 C This subroutine calculates the interaction energy of nonbonded side chains
1801 C assuming the Gay-Berne-Vorobjev potential of interaction.
1803 implicit real*8 (a-h,o-z)
1804 include 'DIMENSIONS'
1805 include 'COMMON.GEO'
1806 include 'COMMON.VAR'
1807 include 'COMMON.LOCAL'
1808 include 'COMMON.CHAIN'
1809 include 'COMMON.DERIV'
1810 include 'COMMON.NAMES'
1811 include 'COMMON.INTERACT'
1812 include 'COMMON.IOUNITS'
1813 include 'COMMON.CALC'
1814 common /srutu/ icall
1817 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1820 c if (icall.eq.0) lprn=.true.
1822 do i=iatsc_s,iatsc_e
1828 dxi=dc_norm(1,nres+i)
1829 dyi=dc_norm(2,nres+i)
1830 dzi=dc_norm(3,nres+i)
1831 c dsci_inv=dsc_inv(itypi)
1832 dsci_inv=vbld_inv(i+nres)
1834 C Calculate SC interaction energy.
1836 do iint=1,nint_gr(i)
1837 do j=istart(i,iint),iend(i,iint)
1840 c dscj_inv=dsc_inv(itypj)
1841 dscj_inv=vbld_inv(j+nres)
1842 sig0ij=sigma(itypi,itypj)
1843 r0ij=r0(itypi,itypj)
1844 chi1=chi(itypi,itypj)
1845 chi2=chi(itypj,itypi)
1852 alf12=0.5D0*(alf1+alf2)
1853 C For diagnostics only!!!
1866 dxj=dc_norm(1,nres+j)
1867 dyj=dc_norm(2,nres+j)
1868 dzj=dc_norm(3,nres+j)
1869 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1871 C Calculate angle-dependent terms of energy and contributions to their
1875 sig=sig0ij*dsqrt(sigsq)
1876 rij_shift=1.0D0/rij-sig+r0ij
1877 C I hate to put IF's in the loops, but here don't have another choice!!!!
1878 if (rij_shift.le.0.0D0) then
1883 c---------------------------------------------------------------
1884 rij_shift=1.0D0/rij_shift
1885 fac=rij_shift**expon
1886 e1=fac*fac*aa(itypi,itypj)
1887 e2=fac*bb(itypi,itypj)
1888 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1889 eps2der=evdwij*eps3rt
1890 eps3der=evdwij*eps2rt
1891 fac_augm=rrij**expon
1892 e_augm=augm(itypi,itypj)*fac_augm
1893 evdwij=evdwij*eps2rt*eps3rt
1895 if (bb(itypi,itypj).gt.0) then
1896 evdw_p=evdw_p+evdwij+e_augm
1898 evdw_m=evdw_m+evdwij+e_augm
1901 evdw=evdw+evdwij+e_augm
1904 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1905 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1906 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1907 & restyp(itypi),i,restyp(itypj),j,
1908 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1909 & chi1,chi2,chip1,chip2,
1910 & eps1,eps2rt**2,eps3rt**2,
1911 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1914 C Calculate gradient components.
1915 e1=e1*eps1*eps2rt**2*eps3rt**2
1916 fac=-expon*(e1+evdwij)*rij_shift
1918 fac=rij*fac-2*expon*rrij*e_augm
1919 C Calculate the radial part of the gradient
1923 C Calculate angular part of the gradient.
1925 if (bb(itypi,itypj).gt.0) then
1937 C-----------------------------------------------------------------------------
1938 subroutine sc_angular
1939 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1940 C om12. Called by ebp, egb, and egbv.
1942 include 'COMMON.CALC'
1943 include 'COMMON.IOUNITS'
1947 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1948 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1949 om12=dxi*dxj+dyi*dyj+dzi*dzj
1951 C Calculate eps1(om12) and its derivative in om12
1952 faceps1=1.0D0-om12*chiom12
1953 faceps1_inv=1.0D0/faceps1
1954 eps1=dsqrt(faceps1_inv)
1955 C Following variable is eps1*deps1/dom12
1956 eps1_om12=faceps1_inv*chiom12
1961 c write (iout,*) "om12",om12," eps1",eps1
1962 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1967 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1968 sigsq=1.0D0-facsig*faceps1_inv
1969 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1970 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1971 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1977 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1978 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1980 C Calculate eps2 and its derivatives in om1, om2, and om12.
1983 chipom12=chip12*om12
1984 facp=1.0D0-om12*chipom12
1986 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1987 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1988 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1989 C Following variable is the square root of eps2
1990 eps2rt=1.0D0-facp1*facp_inv
1991 C Following three variables are the derivatives of the square root of eps
1992 C in om1, om2, and om12.
1993 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1994 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1995 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1996 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1997 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1998 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1999 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2000 c & " eps2rt_om12",eps2rt_om12
2001 C Calculate whole angle-dependent part of epsilon and contributions
2002 C to its derivatives
2006 C----------------------------------------------------------------------------
2007 subroutine sc_grad_T
2008 implicit real*8 (a-h,o-z)
2009 include 'DIMENSIONS'
2010 include 'COMMON.CHAIN'
2011 include 'COMMON.DERIV'
2012 include 'COMMON.CALC'
2013 include 'COMMON.IOUNITS'
2014 double precision dcosom1(3),dcosom2(3)
2015 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2016 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2017 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2018 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2022 c eom12=evdwij*eps1_om12
2024 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2025 c & " sigder",sigder
2026 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2027 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2029 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2030 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2033 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2035 c write (iout,*) "gg",(gg(k),k=1,3)
2037 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
2038 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2039 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2040 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
2041 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2042 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2043 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2044 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2045 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2046 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2049 C Calculate the components of the gradient in DC and X
2053 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2057 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
2058 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
2063 C----------------------------------------------------------------------------
2065 implicit real*8 (a-h,o-z)
2066 include 'DIMENSIONS'
2067 include 'COMMON.CHAIN'
2068 include 'COMMON.DERIV'
2069 include 'COMMON.CALC'
2070 include 'COMMON.IOUNITS'
2071 double precision dcosom1(3),dcosom2(3)
2072 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2073 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2074 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2075 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2079 c eom12=evdwij*eps1_om12
2081 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2082 c & " sigder",sigder
2083 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2084 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2086 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2087 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2090 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2092 c write (iout,*) "gg",(gg(k),k=1,3)
2094 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2095 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2096 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2097 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2098 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2099 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2100 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2101 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2102 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2103 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2106 C Calculate the components of the gradient in DC and X
2110 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2114 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2115 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2119 C-----------------------------------------------------------------------
2120 subroutine e_softsphere(evdw)
2122 C This subroutine calculates the interaction energy of nonbonded side chains
2123 C assuming the LJ potential of interaction.
2125 implicit real*8 (a-h,o-z)
2126 include 'DIMENSIONS'
2127 parameter (accur=1.0d-10)
2128 include 'COMMON.GEO'
2129 include 'COMMON.VAR'
2130 include 'COMMON.LOCAL'
2131 include 'COMMON.CHAIN'
2132 include 'COMMON.DERIV'
2133 include 'COMMON.INTERACT'
2134 include 'COMMON.TORSION'
2135 include 'COMMON.SBRIDGE'
2136 include 'COMMON.NAMES'
2137 include 'COMMON.IOUNITS'
2138 include 'COMMON.CONTACTS'
2140 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2142 do i=iatsc_s,iatsc_e
2149 C Calculate SC interaction energy.
2151 do iint=1,nint_gr(i)
2152 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2153 cd & 'iend=',iend(i,iint)
2154 do j=istart(i,iint),iend(i,iint)
2159 rij=xj*xj+yj*yj+zj*zj
2160 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2161 r0ij=r0(itypi,itypj)
2163 c print *,i,j,r0ij,dsqrt(rij)
2164 if (rij.lt.r0ijsq) then
2165 evdwij=0.25d0*(rij-r0ijsq)**2
2173 C Calculate the components of the gradient in DC and X
2179 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2180 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2181 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2182 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2186 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2194 C--------------------------------------------------------------------------
2195 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2198 C Soft-sphere potential of p-p interaction
2200 implicit real*8 (a-h,o-z)
2201 include 'DIMENSIONS'
2202 include 'COMMON.CONTROL'
2203 include 'COMMON.IOUNITS'
2204 include 'COMMON.GEO'
2205 include 'COMMON.VAR'
2206 include 'COMMON.LOCAL'
2207 include 'COMMON.CHAIN'
2208 include 'COMMON.DERIV'
2209 include 'COMMON.INTERACT'
2210 include 'COMMON.CONTACTS'
2211 include 'COMMON.TORSION'
2212 include 'COMMON.VECTORS'
2213 include 'COMMON.FFIELD'
2215 cd write(iout,*) 'In EELEC_soft_sphere'
2222 do i=iatel_s,iatel_e
2226 xmedi=c(1,i)+0.5d0*dxi
2227 ymedi=c(2,i)+0.5d0*dyi
2228 zmedi=c(3,i)+0.5d0*dzi
2230 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2231 do j=ielstart(i),ielend(i)
2235 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2236 r0ij=rpp(iteli,itelj)
2241 xj=c(1,j)+0.5D0*dxj-xmedi
2242 yj=c(2,j)+0.5D0*dyj-ymedi
2243 zj=c(3,j)+0.5D0*dzj-zmedi
2244 rij=xj*xj+yj*yj+zj*zj
2245 if (rij.lt.r0ijsq) then
2246 evdw1ij=0.25d0*(rij-r0ijsq)**2
2254 C Calculate contributions to the Cartesian gradient.
2260 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2261 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2264 * Loop over residues i+1 thru j-1.
2268 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2273 cgrad do i=nnt,nct-1
2275 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2277 cgrad do j=i+1,nct-1
2279 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2285 c------------------------------------------------------------------------------
2286 subroutine vec_and_deriv
2287 implicit real*8 (a-h,o-z)
2288 include 'DIMENSIONS'
2292 include 'COMMON.IOUNITS'
2293 include 'COMMON.GEO'
2294 include 'COMMON.VAR'
2295 include 'COMMON.LOCAL'
2296 include 'COMMON.CHAIN'
2297 include 'COMMON.VECTORS'
2298 include 'COMMON.SETUP'
2299 include 'COMMON.TIME1'
2300 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2301 C Compute the local reference systems. For reference system (i), the
2302 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2303 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2305 do i=ivec_start,ivec_end
2309 if (i.eq.nres-1) then
2310 C Case of the last full residue
2311 C Compute the Z-axis
2312 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2313 costh=dcos(pi-theta(nres))
2314 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2318 C Compute the derivatives of uz
2320 uzder(2,1,1)=-dc_norm(3,i-1)
2321 uzder(3,1,1)= dc_norm(2,i-1)
2322 uzder(1,2,1)= dc_norm(3,i-1)
2324 uzder(3,2,1)=-dc_norm(1,i-1)
2325 uzder(1,3,1)=-dc_norm(2,i-1)
2326 uzder(2,3,1)= dc_norm(1,i-1)
2329 uzder(2,1,2)= dc_norm(3,i)
2330 uzder(3,1,2)=-dc_norm(2,i)
2331 uzder(1,2,2)=-dc_norm(3,i)
2333 uzder(3,2,2)= dc_norm(1,i)
2334 uzder(1,3,2)= dc_norm(2,i)
2335 uzder(2,3,2)=-dc_norm(1,i)
2337 C Compute the Y-axis
2340 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2342 C Compute the derivatives of uy
2345 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2346 & -dc_norm(k,i)*dc_norm(j,i-1)
2347 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2349 uyder(j,j,1)=uyder(j,j,1)-costh
2350 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2355 uygrad(l,k,j,i)=uyder(l,k,j)
2356 uzgrad(l,k,j,i)=uzder(l,k,j)
2360 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2361 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2362 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2363 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2366 C Compute the Z-axis
2367 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2368 costh=dcos(pi-theta(i+2))
2369 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2373 C Compute the derivatives of uz
2375 uzder(2,1,1)=-dc_norm(3,i+1)
2376 uzder(3,1,1)= dc_norm(2,i+1)
2377 uzder(1,2,1)= dc_norm(3,i+1)
2379 uzder(3,2,1)=-dc_norm(1,i+1)
2380 uzder(1,3,1)=-dc_norm(2,i+1)
2381 uzder(2,3,1)= dc_norm(1,i+1)
2384 uzder(2,1,2)= dc_norm(3,i)
2385 uzder(3,1,2)=-dc_norm(2,i)
2386 uzder(1,2,2)=-dc_norm(3,i)
2388 uzder(3,2,2)= dc_norm(1,i)
2389 uzder(1,3,2)= dc_norm(2,i)
2390 uzder(2,3,2)=-dc_norm(1,i)
2392 C Compute the Y-axis
2395 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2397 C Compute the derivatives of uy
2400 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2401 & -dc_norm(k,i)*dc_norm(j,i+1)
2402 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2404 uyder(j,j,1)=uyder(j,j,1)-costh
2405 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2410 uygrad(l,k,j,i)=uyder(l,k,j)
2411 uzgrad(l,k,j,i)=uzder(l,k,j)
2415 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2416 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2417 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2418 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2422 vbld_inv_temp(1)=vbld_inv(i+1)
2423 if (i.lt.nres-1) then
2424 vbld_inv_temp(2)=vbld_inv(i+2)
2426 vbld_inv_temp(2)=vbld_inv(i)
2431 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2432 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2437 #if defined(PARVEC) && defined(MPI)
2438 if (nfgtasks1.gt.1) then
2440 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2441 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2442 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2443 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2444 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2446 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2447 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2449 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2450 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2451 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2452 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2453 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2454 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2455 time_gather=time_gather+MPI_Wtime()-time00
2457 c if (fg_rank.eq.0) then
2458 c write (iout,*) "Arrays UY and UZ"
2460 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2467 C-----------------------------------------------------------------------------
2468 subroutine check_vecgrad
2469 implicit real*8 (a-h,o-z)
2470 include 'DIMENSIONS'
2471 include 'COMMON.IOUNITS'
2472 include 'COMMON.GEO'
2473 include 'COMMON.VAR'
2474 include 'COMMON.LOCAL'
2475 include 'COMMON.CHAIN'
2476 include 'COMMON.VECTORS'
2477 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2478 dimension uyt(3,maxres),uzt(3,maxres)
2479 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2480 double precision delta /1.0d-7/
2483 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2484 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2485 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2486 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2487 cd & (dc_norm(if90,i),if90=1,3)
2488 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2489 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2490 cd write(iout,'(a)')
2496 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2497 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2510 cd write (iout,*) 'i=',i
2512 erij(k)=dc_norm(k,i)
2516 dc_norm(k,i)=erij(k)
2518 dc_norm(j,i)=dc_norm(j,i)+delta
2519 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2521 c dc_norm(k,i)=dc_norm(k,i)/fac
2523 c write (iout,*) (dc_norm(k,i),k=1,3)
2524 c write (iout,*) (erij(k),k=1,3)
2527 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2528 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2529 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2530 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2532 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2533 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2534 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2537 dc_norm(k,i)=erij(k)
2540 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2541 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2542 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2543 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2544 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2545 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2546 cd write (iout,'(a)')
2551 C--------------------------------------------------------------------------
2552 subroutine set_matrices
2553 implicit real*8 (a-h,o-z)
2554 include 'DIMENSIONS'
2557 include "COMMON.SETUP"
2559 integer status(MPI_STATUS_SIZE)
2561 include 'COMMON.IOUNITS'
2562 include 'COMMON.GEO'
2563 include 'COMMON.VAR'
2564 include 'COMMON.LOCAL'
2565 include 'COMMON.CHAIN'
2566 include 'COMMON.DERIV'
2567 include 'COMMON.INTERACT'
2568 include 'COMMON.CONTACTS'
2569 include 'COMMON.TORSION'
2570 include 'COMMON.VECTORS'
2571 include 'COMMON.FFIELD'
2572 double precision auxvec(2),auxmat(2,2)
2574 C Compute the virtual-bond-torsional-angle dependent quantities needed
2575 C to calculate the el-loc multibody terms of various order.
2578 do i=ivec_start+2,ivec_end+2
2582 if (i .lt. nres+1) then
2619 if (i .gt. 3 .and. i .lt. nres+1) then
2620 obrot_der(1,i-2)=-sin1
2621 obrot_der(2,i-2)= cos1
2622 Ugder(1,1,i-2)= sin1
2623 Ugder(1,2,i-2)=-cos1
2624 Ugder(2,1,i-2)=-cos1
2625 Ugder(2,2,i-2)=-sin1
2628 obrot2_der(1,i-2)=-dwasin2
2629 obrot2_der(2,i-2)= dwacos2
2630 Ug2der(1,1,i-2)= dwasin2
2631 Ug2der(1,2,i-2)=-dwacos2
2632 Ug2der(2,1,i-2)=-dwacos2
2633 Ug2der(2,2,i-2)=-dwasin2
2635 obrot_der(1,i-2)=0.0d0
2636 obrot_der(2,i-2)=0.0d0
2637 Ugder(1,1,i-2)=0.0d0
2638 Ugder(1,2,i-2)=0.0d0
2639 Ugder(2,1,i-2)=0.0d0
2640 Ugder(2,2,i-2)=0.0d0
2641 obrot2_der(1,i-2)=0.0d0
2642 obrot2_der(2,i-2)=0.0d0
2643 Ug2der(1,1,i-2)=0.0d0
2644 Ug2der(1,2,i-2)=0.0d0
2645 Ug2der(2,1,i-2)=0.0d0
2646 Ug2der(2,2,i-2)=0.0d0
2648 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2649 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2650 iti = itortyp(itype(i-2))
2654 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2655 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2656 iti1 = itortyp(itype(i-1))
2660 cd write (iout,*) '*******i',i,' iti1',iti
2661 cd write (iout,*) 'b1',b1(:,iti)
2662 cd write (iout,*) 'b2',b2(:,iti)
2663 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2664 c if (i .gt. iatel_s+2) then
2665 if (i .gt. nnt+2) then
2666 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2667 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2668 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2670 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2671 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2672 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2673 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2674 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2685 DtUg2(l,k,i-2)=0.0d0
2689 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2690 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2692 muder(k,i-2)=Ub2der(k,i-2)
2694 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2695 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2696 iti1 = itortyp(itype(i-1))
2701 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2703 cd write (iout,*) 'mu ',mu(:,i-2)
2704 cd write (iout,*) 'mu1',mu1(:,i-2)
2705 cd write (iout,*) 'mu2',mu2(:,i-2)
2706 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2708 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2709 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2710 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2711 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2712 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2713 C Vectors and matrices dependent on a single virtual-bond dihedral.
2714 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2715 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2716 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2717 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2718 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2719 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2720 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2721 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2722 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2725 C Matrices dependent on two consecutive virtual-bond dihedrals.
2726 C The order of matrices is from left to right.
2727 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2729 c do i=max0(ivec_start,2),ivec_end
2731 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2732 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2733 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2734 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2735 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2736 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2737 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2738 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2741 #if defined(MPI) && defined(PARMAT)
2743 c if (fg_rank.eq.0) then
2744 write (iout,*) "Arrays UG and UGDER before GATHER"
2746 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2747 & ((ug(l,k,i),l=1,2),k=1,2),
2748 & ((ugder(l,k,i),l=1,2),k=1,2)
2750 write (iout,*) "Arrays UG2 and UG2DER"
2752 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2753 & ((ug2(l,k,i),l=1,2),k=1,2),
2754 & ((ug2der(l,k,i),l=1,2),k=1,2)
2756 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2758 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2759 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2760 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2762 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2764 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2765 & costab(i),sintab(i),costab2(i),sintab2(i)
2767 write (iout,*) "Array MUDER"
2769 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2773 if (nfgtasks.gt.1) then
2775 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2776 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2777 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2779 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2780 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2782 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2783 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2785 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2786 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2788 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2789 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2791 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2792 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2794 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2795 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2797 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2798 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2799 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2800 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2801 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2802 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2803 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2804 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2805 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2806 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2807 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2808 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2809 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2811 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2812 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2814 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2815 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2817 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2818 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2820 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2821 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2823 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2824 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2826 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2827 & ivec_count(fg_rank1),
2828 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2830 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2831 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2833 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2834 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2836 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2837 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2839 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2840 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2842 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2843 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2845 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2846 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2848 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2849 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2851 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2852 & ivec_count(fg_rank1),
2853 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2855 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2856 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2858 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2859 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2861 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2862 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2864 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2865 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2867 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2868 & ivec_count(fg_rank1),
2869 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2871 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2872 & ivec_count(fg_rank1),
2873 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2875 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2876 & ivec_count(fg_rank1),
2877 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2878 & MPI_MAT2,FG_COMM1,IERR)
2879 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2880 & ivec_count(fg_rank1),
2881 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2882 & MPI_MAT2,FG_COMM1,IERR)
2885 c Passes matrix info through the ring
2888 if (irecv.lt.0) irecv=nfgtasks1-1
2891 if (inext.ge.nfgtasks1) inext=0
2893 c write (iout,*) "isend",isend," irecv",irecv
2895 lensend=lentyp(isend)
2896 lenrecv=lentyp(irecv)
2897 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2898 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2899 c & MPI_ROTAT1(lensend),inext,2200+isend,
2900 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2901 c & iprev,2200+irecv,FG_COMM,status,IERR)
2902 c write (iout,*) "Gather ROTAT1"
2904 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2905 c & MPI_ROTAT2(lensend),inext,3300+isend,
2906 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2907 c & iprev,3300+irecv,FG_COMM,status,IERR)
2908 c write (iout,*) "Gather ROTAT2"
2910 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2911 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2912 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2913 & iprev,4400+irecv,FG_COMM,status,IERR)
2914 c write (iout,*) "Gather ROTAT_OLD"
2916 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2917 & MPI_PRECOMP11(lensend),inext,5500+isend,
2918 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2919 & iprev,5500+irecv,FG_COMM,status,IERR)
2920 c write (iout,*) "Gather PRECOMP11"
2922 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2923 & MPI_PRECOMP12(lensend),inext,6600+isend,
2924 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2925 & iprev,6600+irecv,FG_COMM,status,IERR)
2926 c write (iout,*) "Gather PRECOMP12"
2928 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2930 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2931 & MPI_ROTAT2(lensend),inext,7700+isend,
2932 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2933 & iprev,7700+irecv,FG_COMM,status,IERR)
2934 c write (iout,*) "Gather PRECOMP21"
2936 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2937 & MPI_PRECOMP22(lensend),inext,8800+isend,
2938 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2939 & iprev,8800+irecv,FG_COMM,status,IERR)
2940 c write (iout,*) "Gather PRECOMP22"
2942 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2943 & MPI_PRECOMP23(lensend),inext,9900+isend,
2944 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2945 & MPI_PRECOMP23(lenrecv),
2946 & iprev,9900+irecv,FG_COMM,status,IERR)
2947 c write (iout,*) "Gather PRECOMP23"
2952 if (irecv.lt.0) irecv=nfgtasks1-1
2955 time_gather=time_gather+MPI_Wtime()-time00
2958 c if (fg_rank.eq.0) then
2959 write (iout,*) "Arrays UG and UGDER"
2961 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2962 & ((ug(l,k,i),l=1,2),k=1,2),
2963 & ((ugder(l,k,i),l=1,2),k=1,2)
2965 write (iout,*) "Arrays UG2 and UG2DER"
2967 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2968 & ((ug2(l,k,i),l=1,2),k=1,2),
2969 & ((ug2der(l,k,i),l=1,2),k=1,2)
2971 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2973 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2974 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2975 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2977 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2979 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2980 & costab(i),sintab(i),costab2(i),sintab2(i)
2982 write (iout,*) "Array MUDER"
2984 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2990 cd iti = itortyp(itype(i))
2993 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2994 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2999 C--------------------------------------------------------------------------
3000 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3002 C This subroutine calculates the average interaction energy and its gradient
3003 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3004 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3005 C The potential depends both on the distance of peptide-group centers and on
3006 C the orientation of the CA-CA virtual bonds.
3008 implicit real*8 (a-h,o-z)
3012 include 'DIMENSIONS'
3013 include 'COMMON.CONTROL'
3014 include 'COMMON.SETUP'
3015 include 'COMMON.IOUNITS'
3016 include 'COMMON.GEO'
3017 include 'COMMON.VAR'
3018 include 'COMMON.LOCAL'
3019 include 'COMMON.CHAIN'
3020 include 'COMMON.DERIV'
3021 include 'COMMON.INTERACT'
3022 include 'COMMON.CONTACTS'
3023 include 'COMMON.TORSION'
3024 include 'COMMON.VECTORS'
3025 include 'COMMON.FFIELD'
3026 include 'COMMON.TIME1'
3027 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3028 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3029 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3030 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3031 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3032 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3034 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3036 double precision scal_el /1.0d0/
3038 double precision scal_el /0.5d0/
3041 C 13-go grudnia roku pamietnego...
3042 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3043 & 0.0d0,1.0d0,0.0d0,
3044 & 0.0d0,0.0d0,1.0d0/
3045 cd write(iout,*) 'In EELEC'
3047 cd write(iout,*) 'Type',i
3048 cd write(iout,*) 'B1',B1(:,i)
3049 cd write(iout,*) 'B2',B2(:,i)
3050 cd write(iout,*) 'CC',CC(:,:,i)
3051 cd write(iout,*) 'DD',DD(:,:,i)
3052 cd write(iout,*) 'EE',EE(:,:,i)
3054 cd call check_vecgrad
3056 if (icheckgrad.eq.1) then
3058 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3060 dc_norm(k,i)=dc(k,i)*fac
3062 c write (iout,*) 'i',i,' fac',fac
3065 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3066 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3067 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3068 c call vec_and_deriv
3074 time_mat=time_mat+MPI_Wtime()-time01
3078 cd write (iout,*) 'i=',i
3080 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3083 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3084 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3097 cd print '(a)','Enter EELEC'
3098 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3100 gel_loc_loc(i)=0.0d0
3105 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3107 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3109 do i=iturn3_start,iturn3_end
3113 dx_normi=dc_norm(1,i)
3114 dy_normi=dc_norm(2,i)
3115 dz_normi=dc_norm(3,i)
3116 xmedi=c(1,i)+0.5d0*dxi
3117 ymedi=c(2,i)+0.5d0*dyi
3118 zmedi=c(3,i)+0.5d0*dzi
3120 call eelecij(i,i+2,ees,evdw1,eel_loc)
3121 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3122 num_cont_hb(i)=num_conti
3124 do i=iturn4_start,iturn4_end
3128 dx_normi=dc_norm(1,i)
3129 dy_normi=dc_norm(2,i)
3130 dz_normi=dc_norm(3,i)
3131 xmedi=c(1,i)+0.5d0*dxi
3132 ymedi=c(2,i)+0.5d0*dyi
3133 zmedi=c(3,i)+0.5d0*dzi
3134 num_conti=num_cont_hb(i)
3135 call eelecij(i,i+3,ees,evdw1,eel_loc)
3136 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3137 num_cont_hb(i)=num_conti
3140 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3142 do i=iatel_s,iatel_e
3146 dx_normi=dc_norm(1,i)
3147 dy_normi=dc_norm(2,i)
3148 dz_normi=dc_norm(3,i)
3149 xmedi=c(1,i)+0.5d0*dxi
3150 ymedi=c(2,i)+0.5d0*dyi
3151 zmedi=c(3,i)+0.5d0*dzi
3152 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3153 num_conti=num_cont_hb(i)
3154 do j=ielstart(i),ielend(i)
3155 call eelecij(i,j,ees,evdw1,eel_loc)
3157 num_cont_hb(i)=num_conti
3159 c write (iout,*) "Number of loop steps in EELEC:",ind
3161 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3162 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3164 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3165 ccc eel_loc=eel_loc+eello_turn3
3166 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3169 C-------------------------------------------------------------------------------
3170 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3171 implicit real*8 (a-h,o-z)
3172 include 'DIMENSIONS'
3176 include 'COMMON.CONTROL'
3177 include 'COMMON.IOUNITS'
3178 include 'COMMON.GEO'
3179 include 'COMMON.VAR'
3180 include 'COMMON.LOCAL'
3181 include 'COMMON.CHAIN'
3182 include 'COMMON.DERIV'
3183 include 'COMMON.INTERACT'
3184 include 'COMMON.CONTACTS'
3185 include 'COMMON.TORSION'
3186 include 'COMMON.VECTORS'
3187 include 'COMMON.FFIELD'
3188 include 'COMMON.TIME1'
3189 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3190 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3191 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3192 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3193 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3194 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3196 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3198 double precision scal_el /1.0d0/
3200 double precision scal_el /0.5d0/
3203 C 13-go grudnia roku pamietnego...
3204 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3205 & 0.0d0,1.0d0,0.0d0,
3206 & 0.0d0,0.0d0,1.0d0/
3207 c time00=MPI_Wtime()
3208 cd write (iout,*) "eelecij",i,j
3212 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3213 aaa=app(iteli,itelj)
3214 bbb=bpp(iteli,itelj)
3215 ael6i=ael6(iteli,itelj)
3216 ael3i=ael3(iteli,itelj)
3220 dx_normj=dc_norm(1,j)
3221 dy_normj=dc_norm(2,j)
3222 dz_normj=dc_norm(3,j)
3223 xj=c(1,j)+0.5D0*dxj-xmedi
3224 yj=c(2,j)+0.5D0*dyj-ymedi
3225 zj=c(3,j)+0.5D0*dzj-zmedi
3226 rij=xj*xj+yj*yj+zj*zj
3232 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3233 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3234 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3235 fac=cosa-3.0D0*cosb*cosg
3237 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3238 if (j.eq.i+2) ev1=scal_el*ev1
3243 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3246 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3247 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3250 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3251 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3252 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3253 cd & xmedi,ymedi,zmedi,xj,yj,zj
3255 if (energy_dec) then
3256 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3257 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3261 C Calculate contributions to the Cartesian gradient.
3264 facvdw=-6*rrmij*(ev1+evdwij)
3265 facel=-3*rrmij*(el1+eesij)
3271 * Radial derivatives. First process both termini of the fragment (i,j)
3277 c ghalf=0.5D0*ggg(k)
3278 c gelc(k,i)=gelc(k,i)+ghalf
3279 c gelc(k,j)=gelc(k,j)+ghalf
3281 c 9/28/08 AL Gradient compotents will be summed only at the end
3283 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3284 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3287 * Loop over residues i+1 thru j-1.
3291 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3298 c ghalf=0.5D0*ggg(k)
3299 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3300 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3302 c 9/28/08 AL Gradient compotents will be summed only at the end
3304 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3305 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3308 * Loop over residues i+1 thru j-1.
3312 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3319 fac=-3*rrmij*(facvdw+facvdw+facel)
3324 * Radial derivatives. First process both termini of the fragment (i,j)
3330 c ghalf=0.5D0*ggg(k)
3331 c gelc(k,i)=gelc(k,i)+ghalf
3332 c gelc(k,j)=gelc(k,j)+ghalf
3334 c 9/28/08 AL Gradient compotents will be summed only at the end
3336 gelc_long(k,j)=gelc(k,j)+ggg(k)
3337 gelc_long(k,i)=gelc(k,i)-ggg(k)
3340 * Loop over residues i+1 thru j-1.
3344 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3347 c 9/28/08 AL Gradient compotents will be summed only at the end
3352 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3353 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3359 ecosa=2.0D0*fac3*fac1+fac4
3362 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3363 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3365 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3366 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3368 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3369 cd & (dcosg(k),k=1,3)
3371 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3374 c ghalf=0.5D0*ggg(k)
3375 c gelc(k,i)=gelc(k,i)+ghalf
3376 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3377 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3378 c gelc(k,j)=gelc(k,j)+ghalf
3379 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3380 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3384 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3389 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3390 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3392 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3393 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3394 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3395 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3397 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3398 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3399 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3401 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3402 C energy of a peptide unit is assumed in the form of a second-order
3403 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3404 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3405 C are computed for EVERY pair of non-contiguous peptide groups.
3407 if (j.lt.nres-1) then
3418 muij(kkk)=mu(k,i)*mu(l,j)
3421 cd write (iout,*) 'EELEC: i',i,' j',j
3422 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3423 cd write(iout,*) 'muij',muij
3424 ury=scalar(uy(1,i),erij)
3425 urz=scalar(uz(1,i),erij)
3426 vry=scalar(uy(1,j),erij)
3427 vrz=scalar(uz(1,j),erij)
3428 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3429 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3430 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3431 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3432 fac=dsqrt(-ael6i)*r3ij
3437 cd write (iout,'(4i5,4f10.5)')
3438 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3439 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3440 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3441 cd & uy(:,j),uz(:,j)
3442 cd write (iout,'(4f10.5)')
3443 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3444 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3445 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3446 cd write (iout,'(9f10.5/)')
3447 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3448 C Derivatives of the elements of A in virtual-bond vectors
3449 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3451 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3452 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3453 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3454 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3455 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3456 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3457 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3458 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3459 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3460 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3461 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3462 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3464 C Compute radial contributions to the gradient
3482 C Add the contributions coming from er
3485 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3486 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3487 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3488 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3491 C Derivatives in DC(i)
3492 cgrad ghalf1=0.5d0*agg(k,1)
3493 cgrad ghalf2=0.5d0*agg(k,2)
3494 cgrad ghalf3=0.5d0*agg(k,3)
3495 cgrad ghalf4=0.5d0*agg(k,4)
3496 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3497 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3498 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3499 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3500 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3501 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3502 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3503 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3504 C Derivatives in DC(i+1)
3505 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3506 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3507 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3508 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3509 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3510 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3511 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3512 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3513 C Derivatives in DC(j)
3514 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3515 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3516 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3517 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3518 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3519 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3520 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3521 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3522 C Derivatives in DC(j+1) or DC(nres-1)
3523 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3524 & -3.0d0*vryg(k,3)*ury)
3525 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3526 & -3.0d0*vrzg(k,3)*ury)
3527 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3528 & -3.0d0*vryg(k,3)*urz)
3529 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3530 & -3.0d0*vrzg(k,3)*urz)
3531 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3533 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3546 aggi(k,l)=-aggi(k,l)
3547 aggi1(k,l)=-aggi1(k,l)
3548 aggj(k,l)=-aggj(k,l)
3549 aggj1(k,l)=-aggj1(k,l)
3552 if (j.lt.nres-1) then
3558 aggi(k,l)=-aggi(k,l)
3559 aggi1(k,l)=-aggi1(k,l)
3560 aggj(k,l)=-aggj(k,l)
3561 aggj1(k,l)=-aggj1(k,l)
3572 aggi(k,l)=-aggi(k,l)
3573 aggi1(k,l)=-aggi1(k,l)
3574 aggj(k,l)=-aggj(k,l)
3575 aggj1(k,l)=-aggj1(k,l)
3580 IF (wel_loc.gt.0.0d0) THEN
3581 C Contribution to the local-electrostatic energy coming from the i-j pair
3582 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3584 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3586 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3587 & 'eelloc',i,j,eel_loc_ij
3589 eel_loc=eel_loc+eel_loc_ij
3590 C Partial derivatives in virtual-bond dihedral angles gamma
3592 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3593 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3594 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3595 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3596 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3597 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3598 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3600 ggg(l)=agg(l,1)*muij(1)+
3601 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3602 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3603 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3604 cgrad ghalf=0.5d0*ggg(l)
3605 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3606 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3610 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3613 C Remaining derivatives of eello
3615 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3616 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3617 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3618 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3619 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3620 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3621 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3622 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3625 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3626 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3627 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3628 & .and. num_conti.le.maxconts) then
3629 c write (iout,*) i,j," entered corr"
3631 C Calculate the contact function. The ith column of the array JCONT will
3632 C contain the numbers of atoms that make contacts with the atom I (of numbers
3633 C greater than I). The arrays FACONT and GACONT will contain the values of
3634 C the contact function and its derivative.
3635 c r0ij=1.02D0*rpp(iteli,itelj)
3636 c r0ij=1.11D0*rpp(iteli,itelj)
3637 r0ij=2.20D0*rpp(iteli,itelj)
3638 c r0ij=1.55D0*rpp(iteli,itelj)
3639 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3640 if (fcont.gt.0.0D0) then
3641 num_conti=num_conti+1
3642 if (num_conti.gt.maxconts) then
3643 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3644 & ' will skip next contacts for this conf.'
3646 jcont_hb(num_conti,i)=j
3647 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3648 cd & " jcont_hb",jcont_hb(num_conti,i)
3649 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3650 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3651 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3653 d_cont(num_conti,i)=rij
3654 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3655 C --- Electrostatic-interaction matrix ---
3656 a_chuj(1,1,num_conti,i)=a22
3657 a_chuj(1,2,num_conti,i)=a23
3658 a_chuj(2,1,num_conti,i)=a32
3659 a_chuj(2,2,num_conti,i)=a33
3660 C --- Gradient of rij
3662 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3669 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3670 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3671 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3672 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3673 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3678 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3679 C Calculate contact energies
3681 wij=cosa-3.0D0*cosb*cosg
3684 c fac3=dsqrt(-ael6i)/r0ij**3
3685 fac3=dsqrt(-ael6i)*r3ij
3686 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3687 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3688 if (ees0tmp.gt.0) then
3689 ees0pij=dsqrt(ees0tmp)
3693 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3694 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3695 if (ees0tmp.gt.0) then
3696 ees0mij=dsqrt(ees0tmp)
3701 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3702 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3703 C Diagnostics. Comment out or remove after debugging!
3704 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3705 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3706 c ees0m(num_conti,i)=0.0D0
3708 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3709 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3710 C Angular derivatives of the contact function
3711 ees0pij1=fac3/ees0pij
3712 ees0mij1=fac3/ees0mij
3713 fac3p=-3.0D0*fac3*rrmij
3714 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3715 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3717 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3718 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3719 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3720 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3721 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3722 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3723 ecosap=ecosa1+ecosa2
3724 ecosbp=ecosb1+ecosb2
3725 ecosgp=ecosg1+ecosg2
3726 ecosam=ecosa1-ecosa2
3727 ecosbm=ecosb1-ecosb2
3728 ecosgm=ecosg1-ecosg2
3737 facont_hb(num_conti,i)=fcont
3738 fprimcont=fprimcont/rij
3739 cd facont_hb(num_conti,i)=1.0D0
3740 C Following line is for diagnostics.
3743 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3744 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3747 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3748 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3750 gggp(1)=gggp(1)+ees0pijp*xj
3751 gggp(2)=gggp(2)+ees0pijp*yj
3752 gggp(3)=gggp(3)+ees0pijp*zj
3753 gggm(1)=gggm(1)+ees0mijp*xj
3754 gggm(2)=gggm(2)+ees0mijp*yj
3755 gggm(3)=gggm(3)+ees0mijp*zj
3756 C Derivatives due to the contact function
3757 gacont_hbr(1,num_conti,i)=fprimcont*xj
3758 gacont_hbr(2,num_conti,i)=fprimcont*yj
3759 gacont_hbr(3,num_conti,i)=fprimcont*zj
3762 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3763 c following the change of gradient-summation algorithm.
3765 cgrad ghalfp=0.5D0*gggp(k)
3766 cgrad ghalfm=0.5D0*gggm(k)
3767 gacontp_hb1(k,num_conti,i)=!ghalfp
3768 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3769 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3770 gacontp_hb2(k,num_conti,i)=!ghalfp
3771 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3772 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3773 gacontp_hb3(k,num_conti,i)=gggp(k)
3774 gacontm_hb1(k,num_conti,i)=!ghalfm
3775 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3776 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3777 gacontm_hb2(k,num_conti,i)=!ghalfm
3778 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3779 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3780 gacontm_hb3(k,num_conti,i)=gggm(k)
3782 C Diagnostics. Comment out or remove after debugging!
3784 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3785 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3786 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3787 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3788 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3789 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3792 endif ! num_conti.le.maxconts
3795 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3798 ghalf=0.5d0*agg(l,k)
3799 aggi(l,k)=aggi(l,k)+ghalf
3800 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3801 aggj(l,k)=aggj(l,k)+ghalf
3804 if (j.eq.nres-1 .and. i.lt.j-2) then
3807 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3812 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3815 C-----------------------------------------------------------------------------
3816 subroutine eturn3(i,eello_turn3)
3817 C Third- and fourth-order contributions from turns
3818 implicit real*8 (a-h,o-z)
3819 include 'DIMENSIONS'
3820 include 'COMMON.IOUNITS'
3821 include 'COMMON.GEO'
3822 include 'COMMON.VAR'
3823 include 'COMMON.LOCAL'
3824 include 'COMMON.CHAIN'
3825 include 'COMMON.DERIV'
3826 include 'COMMON.INTERACT'
3827 include 'COMMON.CONTACTS'
3828 include 'COMMON.TORSION'
3829 include 'COMMON.VECTORS'
3830 include 'COMMON.FFIELD'
3831 include 'COMMON.CONTROL'
3833 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3834 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3835 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3836 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3837 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3838 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3839 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3842 c write (iout,*) "eturn3",i,j,j1,j2
3847 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3849 C Third-order contributions
3856 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3857 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3858 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3859 call transpose2(auxmat(1,1),auxmat1(1,1))
3860 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3861 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3862 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3863 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3864 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3865 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3866 cd & ' eello_turn3_num',4*eello_turn3_num
3867 C Derivatives in gamma(i)
3868 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3869 call transpose2(auxmat2(1,1),auxmat3(1,1))
3870 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3871 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3872 C Derivatives in gamma(i+1)
3873 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3874 call transpose2(auxmat2(1,1),auxmat3(1,1))
3875 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3876 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3877 & +0.5d0*(pizda(1,1)+pizda(2,2))
3878 C Cartesian derivatives
3880 c ghalf1=0.5d0*agg(l,1)
3881 c ghalf2=0.5d0*agg(l,2)
3882 c ghalf3=0.5d0*agg(l,3)
3883 c ghalf4=0.5d0*agg(l,4)
3884 a_temp(1,1)=aggi(l,1)!+ghalf1
3885 a_temp(1,2)=aggi(l,2)!+ghalf2
3886 a_temp(2,1)=aggi(l,3)!+ghalf3
3887 a_temp(2,2)=aggi(l,4)!+ghalf4
3888 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3889 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3890 & +0.5d0*(pizda(1,1)+pizda(2,2))
3891 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3892 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3893 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3894 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3895 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3896 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3897 & +0.5d0*(pizda(1,1)+pizda(2,2))
3898 a_temp(1,1)=aggj(l,1)!+ghalf1
3899 a_temp(1,2)=aggj(l,2)!+ghalf2
3900 a_temp(2,1)=aggj(l,3)!+ghalf3
3901 a_temp(2,2)=aggj(l,4)!+ghalf4
3902 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3903 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3904 & +0.5d0*(pizda(1,1)+pizda(2,2))
3905 a_temp(1,1)=aggj1(l,1)
3906 a_temp(1,2)=aggj1(l,2)
3907 a_temp(2,1)=aggj1(l,3)
3908 a_temp(2,2)=aggj1(l,4)
3909 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3910 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3911 & +0.5d0*(pizda(1,1)+pizda(2,2))
3915 C-------------------------------------------------------------------------------
3916 subroutine eturn4(i,eello_turn4)
3917 C Third- and fourth-order contributions from turns
3918 implicit real*8 (a-h,o-z)
3919 include 'DIMENSIONS'
3920 include 'COMMON.IOUNITS'
3921 include 'COMMON.GEO'
3922 include 'COMMON.VAR'
3923 include 'COMMON.LOCAL'
3924 include 'COMMON.CHAIN'
3925 include 'COMMON.DERIV'
3926 include 'COMMON.INTERACT'
3927 include 'COMMON.CONTACTS'
3928 include 'COMMON.TORSION'
3929 include 'COMMON.VECTORS'
3930 include 'COMMON.FFIELD'
3931 include 'COMMON.CONTROL'
3933 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3934 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3935 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3936 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3937 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3938 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3939 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3942 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3944 C Fourth-order contributions
3952 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3953 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3954 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3959 iti1=itortyp(itype(i+1))
3960 iti2=itortyp(itype(i+2))
3961 iti3=itortyp(itype(i+3))
3962 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3963 call transpose2(EUg(1,1,i+1),e1t(1,1))
3964 call transpose2(Eug(1,1,i+2),e2t(1,1))
3965 call transpose2(Eug(1,1,i+3),e3t(1,1))
3966 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3967 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3968 s1=scalar2(b1(1,iti2),auxvec(1))
3969 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3970 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3971 s2=scalar2(b1(1,iti1),auxvec(1))
3972 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3973 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3974 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3975 eello_turn4=eello_turn4-(s1+s2+s3)
3976 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3977 & 'eturn4',i,j,-(s1+s2+s3)
3978 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3979 cd & ' eello_turn4_num',8*eello_turn4_num
3980 C Derivatives in gamma(i)
3981 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3982 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3983 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3984 s1=scalar2(b1(1,iti2),auxvec(1))
3985 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3986 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3987 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3988 C Derivatives in gamma(i+1)
3989 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3990 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3991 s2=scalar2(b1(1,iti1),auxvec(1))
3992 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3993 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3994 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3995 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3996 C Derivatives in gamma(i+2)
3997 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3998 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3999 s1=scalar2(b1(1,iti2),auxvec(1))
4000 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4001 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4002 s2=scalar2(b1(1,iti1),auxvec(1))
4003 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4004 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4005 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4006 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4007 C Cartesian derivatives
4008 C Derivatives of this turn contributions in DC(i+2)
4009 if (j.lt.nres-1) then
4011 a_temp(1,1)=agg(l,1)
4012 a_temp(1,2)=agg(l,2)
4013 a_temp(2,1)=agg(l,3)
4014 a_temp(2,2)=agg(l,4)
4015 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4016 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4017 s1=scalar2(b1(1,iti2),auxvec(1))
4018 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4019 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4020 s2=scalar2(b1(1,iti1),auxvec(1))
4021 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4022 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4023 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4025 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4028 C Remaining derivatives of this turn contribution
4030 a_temp(1,1)=aggi(l,1)
4031 a_temp(1,2)=aggi(l,2)
4032 a_temp(2,1)=aggi(l,3)
4033 a_temp(2,2)=aggi(l,4)
4034 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4035 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4036 s1=scalar2(b1(1,iti2),auxvec(1))
4037 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4038 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4039 s2=scalar2(b1(1,iti1),auxvec(1))
4040 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4041 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4042 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4043 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4044 a_temp(1,1)=aggi1(l,1)
4045 a_temp(1,2)=aggi1(l,2)
4046 a_temp(2,1)=aggi1(l,3)
4047 a_temp(2,2)=aggi1(l,4)
4048 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4049 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4050 s1=scalar2(b1(1,iti2),auxvec(1))
4051 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4052 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4053 s2=scalar2(b1(1,iti1),auxvec(1))
4054 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4055 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4056 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4057 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4058 a_temp(1,1)=aggj(l,1)
4059 a_temp(1,2)=aggj(l,2)
4060 a_temp(2,1)=aggj(l,3)
4061 a_temp(2,2)=aggj(l,4)
4062 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4063 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4064 s1=scalar2(b1(1,iti2),auxvec(1))
4065 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4066 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4067 s2=scalar2(b1(1,iti1),auxvec(1))
4068 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4069 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4070 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4071 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4072 a_temp(1,1)=aggj1(l,1)
4073 a_temp(1,2)=aggj1(l,2)
4074 a_temp(2,1)=aggj1(l,3)
4075 a_temp(2,2)=aggj1(l,4)
4076 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4077 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4078 s1=scalar2(b1(1,iti2),auxvec(1))
4079 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4080 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4081 s2=scalar2(b1(1,iti1),auxvec(1))
4082 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4083 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4084 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4085 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4086 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4090 C-----------------------------------------------------------------------------
4091 subroutine vecpr(u,v,w)
4092 implicit real*8(a-h,o-z)
4093 dimension u(3),v(3),w(3)
4094 w(1)=u(2)*v(3)-u(3)*v(2)
4095 w(2)=-u(1)*v(3)+u(3)*v(1)
4096 w(3)=u(1)*v(2)-u(2)*v(1)
4099 C-----------------------------------------------------------------------------
4100 subroutine unormderiv(u,ugrad,unorm,ungrad)
4101 C This subroutine computes the derivatives of a normalized vector u, given
4102 C the derivatives computed without normalization conditions, ugrad. Returns
4105 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4106 double precision vec(3)
4107 double precision scalar
4109 c write (2,*) 'ugrad',ugrad
4112 vec(i)=scalar(ugrad(1,i),u(1))
4114 c write (2,*) 'vec',vec
4117 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4120 c write (2,*) 'ungrad',ungrad
4123 C-----------------------------------------------------------------------------
4124 subroutine escp_soft_sphere(evdw2,evdw2_14)
4126 C This subroutine calculates the excluded-volume interaction energy between
4127 C peptide-group centers and side chains and its gradient in virtual-bond and
4128 C side-chain vectors.
4130 implicit real*8 (a-h,o-z)
4131 include 'DIMENSIONS'
4132 include 'COMMON.GEO'
4133 include 'COMMON.VAR'
4134 include 'COMMON.LOCAL'
4135 include 'COMMON.CHAIN'
4136 include 'COMMON.DERIV'
4137 include 'COMMON.INTERACT'
4138 include 'COMMON.FFIELD'
4139 include 'COMMON.IOUNITS'
4140 include 'COMMON.CONTROL'
4145 cd print '(a)','Enter ESCP'
4146 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4147 do i=iatscp_s,iatscp_e
4149 xi=0.5D0*(c(1,i)+c(1,i+1))
4150 yi=0.5D0*(c(2,i)+c(2,i+1))
4151 zi=0.5D0*(c(3,i)+c(3,i+1))
4153 do iint=1,nscp_gr(i)
4155 do j=iscpstart(i,iint),iscpend(i,iint)
4157 C Uncomment following three lines for SC-p interactions
4161 C Uncomment following three lines for Ca-p interactions
4165 rij=xj*xj+yj*yj+zj*zj
4168 if (rij.lt.r0ijsq) then
4169 evdwij=0.25d0*(rij-r0ijsq)**2
4177 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4182 cgrad if (j.lt.i) then
4183 cd write (iout,*) 'j<i'
4184 C Uncomment following three lines for SC-p interactions
4186 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4189 cd write (iout,*) 'j>i'
4191 cgrad ggg(k)=-ggg(k)
4192 C Uncomment following line for SC-p interactions
4193 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4197 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4199 cgrad kstart=min0(i+1,j)
4200 cgrad kend=max0(i-1,j-1)
4201 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4202 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4203 cgrad do k=kstart,kend
4205 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4209 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4210 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4218 C-----------------------------------------------------------------------------
4219 subroutine escp(evdw2,evdw2_14)
4221 C This subroutine calculates the excluded-volume interaction energy between
4222 C peptide-group centers and side chains and its gradient in virtual-bond and
4223 C side-chain vectors.
4225 implicit real*8 (a-h,o-z)
4226 include 'DIMENSIONS'
4227 include 'COMMON.GEO'
4228 include 'COMMON.VAR'
4229 include 'COMMON.LOCAL'
4230 include 'COMMON.CHAIN'
4231 include 'COMMON.DERIV'
4232 include 'COMMON.INTERACT'
4233 include 'COMMON.FFIELD'
4234 include 'COMMON.IOUNITS'
4235 include 'COMMON.CONTROL'
4239 cd print '(a)','Enter ESCP'
4240 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4241 do i=iatscp_s,iatscp_e
4243 xi=0.5D0*(c(1,i)+c(1,i+1))
4244 yi=0.5D0*(c(2,i)+c(2,i+1))
4245 zi=0.5D0*(c(3,i)+c(3,i+1))
4247 do iint=1,nscp_gr(i)
4249 do j=iscpstart(i,iint),iscpend(i,iint)
4251 C Uncomment following three lines for SC-p interactions
4255 C Uncomment following three lines for Ca-p interactions
4259 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4261 e1=fac*fac*aad(itypj,iteli)
4262 e2=fac*bad(itypj,iteli)
4263 if (iabs(j-i) .le. 2) then
4266 evdw2_14=evdw2_14+e1+e2
4270 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4271 & 'evdw2',i,j,evdwij
4273 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4275 fac=-(evdwij+e1)*rrij
4279 cgrad if (j.lt.i) then
4280 cd write (iout,*) 'j<i'
4281 C Uncomment following three lines for SC-p interactions
4283 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4286 cd write (iout,*) 'j>i'
4288 cgrad ggg(k)=-ggg(k)
4289 C Uncomment following line for SC-p interactions
4290 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4291 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4295 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4297 cgrad kstart=min0(i+1,j)
4298 cgrad kend=max0(i-1,j-1)
4299 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4300 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4301 cgrad do k=kstart,kend
4303 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4307 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4308 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4316 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4317 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4318 gradx_scp(j,i)=expon*gradx_scp(j,i)
4321 C******************************************************************************
4325 C To save time the factor EXPON has been extracted from ALL components
4326 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4329 C******************************************************************************
4332 C--------------------------------------------------------------------------
4333 subroutine edis(ehpb)
4335 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4337 implicit real*8 (a-h,o-z)
4338 include 'DIMENSIONS'
4339 include 'COMMON.SBRIDGE'
4340 include 'COMMON.CHAIN'
4341 include 'COMMON.DERIV'
4342 include 'COMMON.VAR'
4343 include 'COMMON.INTERACT'
4344 include 'COMMON.IOUNITS'
4347 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4348 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4349 if (link_end.eq.0) return
4350 do i=link_start,link_end
4351 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4352 C CA-CA distance used in regularization of structure.
4355 C iii and jjj point to the residues for which the distance is assigned.
4356 if (ii.gt.nres) then
4363 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4364 c & dhpb(i),dhpb1(i),forcon(i)
4365 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4366 C distance and angle dependent SS bond potential.
4367 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4368 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4369 if (.not.dyn_ss .and. i.le.nss) then
4370 C 15/02/13 CC dynamic SSbond - additional check
4372 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4373 call ssbond_ene(iii,jjj,eij)
4376 cd write (iout,*) "eij",eij
4377 else if (ii.gt.nres .and. jj.gt.nres) then
4378 c Restraints from contact prediction
4380 if (dhpb1(i).gt.0.0d0) then
4381 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4382 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4383 c write (iout,*) "beta nmr",
4384 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4388 C Get the force constant corresponding to this distance.
4390 C Calculate the contribution to energy.
4391 ehpb=ehpb+waga*rdis*rdis
4392 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4394 C Evaluate gradient.
4399 ggg(j)=fac*(c(j,jj)-c(j,ii))
4402 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4403 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4406 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4407 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4410 C Calculate the distance between the two points and its difference from the
4413 if (dhpb1(i).gt.0.0d0) then
4414 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4415 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4416 c write (iout,*) "alph nmr",
4417 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4420 C Get the force constant corresponding to this distance.
4422 C Calculate the contribution to energy.
4423 ehpb=ehpb+waga*rdis*rdis
4424 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4426 C Evaluate gradient.
4430 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4431 cd & ' waga=',waga,' fac=',fac
4433 ggg(j)=fac*(c(j,jj)-c(j,ii))
4435 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4436 C If this is a SC-SC distance, we need to calculate the contributions to the
4437 C Cartesian gradient in the SC vectors (ghpbx).
4440 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4441 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4444 cgrad do j=iii,jjj-1
4446 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4450 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4451 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4458 C--------------------------------------------------------------------------
4459 subroutine ssbond_ene(i,j,eij)
4461 C Calculate the distance and angle dependent SS-bond potential energy
4462 C using a free-energy function derived based on RHF/6-31G** ab initio
4463 C calculations of diethyl disulfide.
4465 C A. Liwo and U. Kozlowska, 11/24/03
4467 implicit real*8 (a-h,o-z)
4468 include 'DIMENSIONS'
4469 include 'COMMON.SBRIDGE'
4470 include 'COMMON.CHAIN'
4471 include 'COMMON.DERIV'
4472 include 'COMMON.LOCAL'
4473 include 'COMMON.INTERACT'
4474 include 'COMMON.VAR'
4475 include 'COMMON.IOUNITS'
4476 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4481 dxi=dc_norm(1,nres+i)
4482 dyi=dc_norm(2,nres+i)
4483 dzi=dc_norm(3,nres+i)
4484 c dsci_inv=dsc_inv(itypi)
4485 dsci_inv=vbld_inv(nres+i)
4487 c dscj_inv=dsc_inv(itypj)
4488 dscj_inv=vbld_inv(nres+j)
4492 dxj=dc_norm(1,nres+j)
4493 dyj=dc_norm(2,nres+j)
4494 dzj=dc_norm(3,nres+j)
4495 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4500 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4501 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4502 om12=dxi*dxj+dyi*dyj+dzi*dzj
4504 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4505 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4511 deltat12=om2-om1+2.0d0
4513 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4514 & +akct*deltad*deltat12+ebr
4515 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4516 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4517 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4518 c & " deltat12",deltat12," eij",eij
4519 ed=2*akcm*deltad+akct*deltat12
4521 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4522 eom1=-2*akth*deltat1-pom1-om2*pom2
4523 eom2= 2*akth*deltat2+pom1-om1*pom2
4526 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4527 ghpbx(k,i)=ghpbx(k,i)-ggk
4528 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4529 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4530 ghpbx(k,j)=ghpbx(k,j)+ggk
4531 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4532 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4533 ghpbc(k,i)=ghpbc(k,i)-ggk
4534 ghpbc(k,j)=ghpbc(k,j)+ggk
4537 C Calculate the components of the gradient in DC and X
4541 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4546 C--------------------------------------------------------------------------
4547 subroutine ebond(estr)
4549 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4551 implicit real*8 (a-h,o-z)
4552 include 'DIMENSIONS'
4553 include 'COMMON.LOCAL'
4554 include 'COMMON.GEO'
4555 include 'COMMON.INTERACT'
4556 include 'COMMON.DERIV'
4557 include 'COMMON.VAR'
4558 include 'COMMON.CHAIN'
4559 include 'COMMON.IOUNITS'
4560 include 'COMMON.NAMES'
4561 include 'COMMON.FFIELD'
4562 include 'COMMON.CONTROL'
4563 include 'COMMON.SETUP'
4564 double precision u(3),ud(3)
4566 do i=ibondp_start,ibondp_end
4567 diff = vbld(i)-vbldp0
4568 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4571 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4573 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4577 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4579 do i=ibond_start,ibond_end
4584 diff=vbld(i+nres)-vbldsc0(1,iti)
4585 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4586 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4587 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4589 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4593 diff=vbld(i+nres)-vbldsc0(j,iti)
4594 ud(j)=aksc(j,iti)*diff
4595 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4609 uprod2=uprod2*u(k)*u(k)
4613 usumsqder=usumsqder+ud(j)*uprod2
4615 estr=estr+uprod/usum
4617 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4625 C--------------------------------------------------------------------------
4626 subroutine ebend(etheta)
4628 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4629 C angles gamma and its derivatives in consecutive thetas and gammas.
4631 implicit real*8 (a-h,o-z)
4632 include 'DIMENSIONS'
4633 include 'COMMON.LOCAL'
4634 include 'COMMON.GEO'
4635 include 'COMMON.INTERACT'
4636 include 'COMMON.DERIV'
4637 include 'COMMON.VAR'
4638 include 'COMMON.CHAIN'
4639 include 'COMMON.IOUNITS'
4640 include 'COMMON.NAMES'
4641 include 'COMMON.FFIELD'
4642 include 'COMMON.CONTROL'
4643 common /calcthet/ term1,term2,termm,diffak,ratak,
4644 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4645 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4646 double precision y(2),z(2)
4648 c time11=dexp(-2*time)
4651 c write (*,'(a,i2)') 'EBEND ICG=',icg
4652 do i=ithet_start,ithet_end
4653 C Zero the energy function and its derivative at 0 or pi.
4654 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4659 if (phii.ne.phii) phii=150.0
4672 if (phii1.ne.phii1) phii1=150.0
4684 C Calculate the "mean" value of theta from the part of the distribution
4685 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4686 C In following comments this theta will be referred to as t_c.
4687 thet_pred_mean=0.0d0
4691 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4693 dthett=thet_pred_mean*ssd
4694 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4695 C Derivatives of the "mean" values in gamma1 and gamma2.
4696 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4697 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4698 if (theta(i).gt.pi-delta) then
4699 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4701 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4702 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4703 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4705 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4707 else if (theta(i).lt.delta) then
4708 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4709 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4710 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4712 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4713 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4716 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4719 etheta=etheta+ethetai
4720 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4722 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4723 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4724 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4726 C Ufff.... We've done all this!!!
4729 C---------------------------------------------------------------------------
4730 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4732 implicit real*8 (a-h,o-z)
4733 include 'DIMENSIONS'
4734 include 'COMMON.LOCAL'
4735 include 'COMMON.IOUNITS'
4736 common /calcthet/ term1,term2,termm,diffak,ratak,
4737 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4738 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4739 C Calculate the contributions to both Gaussian lobes.
4740 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4741 C The "polynomial part" of the "standard deviation" of this part of
4745 sig=sig*thet_pred_mean+polthet(j,it)
4747 C Derivative of the "interior part" of the "standard deviation of the"
4748 C gamma-dependent Gaussian lobe in t_c.
4749 sigtc=3*polthet(3,it)
4751 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4754 C Set the parameters of both Gaussian lobes of the distribution.
4755 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4756 fac=sig*sig+sigc0(it)
4759 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4760 sigsqtc=-4.0D0*sigcsq*sigtc
4761 c print *,i,sig,sigtc,sigsqtc
4762 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4763 sigtc=-sigtc/(fac*fac)
4764 C Following variable is sigma(t_c)**(-2)
4765 sigcsq=sigcsq*sigcsq
4767 sig0inv=1.0D0/sig0i**2
4768 delthec=thetai-thet_pred_mean
4769 delthe0=thetai-theta0i
4770 term1=-0.5D0*sigcsq*delthec*delthec
4771 term2=-0.5D0*sig0inv*delthe0*delthe0
4772 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4773 C NaNs in taking the logarithm. We extract the largest exponent which is added
4774 C to the energy (this being the log of the distribution) at the end of energy
4775 C term evaluation for this virtual-bond angle.
4776 if (term1.gt.term2) then
4778 term2=dexp(term2-termm)
4782 term1=dexp(term1-termm)
4785 C The ratio between the gamma-independent and gamma-dependent lobes of
4786 C the distribution is a Gaussian function of thet_pred_mean too.
4787 diffak=gthet(2,it)-thet_pred_mean
4788 ratak=diffak/gthet(3,it)**2
4789 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4790 C Let's differentiate it in thet_pred_mean NOW.
4792 C Now put together the distribution terms to make complete distribution.
4793 termexp=term1+ak*term2
4794 termpre=sigc+ak*sig0i
4795 C Contribution of the bending energy from this theta is just the -log of
4796 C the sum of the contributions from the two lobes and the pre-exponential
4797 C factor. Simple enough, isn't it?
4798 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4799 C NOW the derivatives!!!
4800 C 6/6/97 Take into account the deformation.
4801 E_theta=(delthec*sigcsq*term1
4802 & +ak*delthe0*sig0inv*term2)/termexp
4803 E_tc=((sigtc+aktc*sig0i)/termpre
4804 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4805 & aktc*term2)/termexp)
4808 c-----------------------------------------------------------------------------
4809 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4810 implicit real*8 (a-h,o-z)
4811 include 'DIMENSIONS'
4812 include 'COMMON.LOCAL'
4813 include 'COMMON.IOUNITS'
4814 common /calcthet/ term1,term2,termm,diffak,ratak,
4815 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4816 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4817 delthec=thetai-thet_pred_mean
4818 delthe0=thetai-theta0i
4819 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4820 t3 = thetai-thet_pred_mean
4824 t14 = t12+t6*sigsqtc
4826 t21 = thetai-theta0i
4832 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4833 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4834 & *(-t12*t9-ak*sig0inv*t27)
4838 C--------------------------------------------------------------------------
4839 subroutine ebend(etheta)
4841 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4842 C angles gamma and its derivatives in consecutive thetas and gammas.
4843 C ab initio-derived potentials from
4844 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4846 implicit real*8 (a-h,o-z)
4847 include 'DIMENSIONS'
4848 include 'COMMON.LOCAL'
4849 include 'COMMON.GEO'
4850 include 'COMMON.INTERACT'
4851 include 'COMMON.DERIV'
4852 include 'COMMON.VAR'
4853 include 'COMMON.CHAIN'
4854 include 'COMMON.IOUNITS'
4855 include 'COMMON.NAMES'
4856 include 'COMMON.FFIELD'
4857 include 'COMMON.CONTROL'
4858 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4859 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4860 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4861 & sinph1ph2(maxdouble,maxdouble)
4862 logical lprn /.false./, lprn1 /.false./
4864 do i=ithet_start,ithet_end
4868 theti2=0.5d0*theta(i)
4869 ityp2=ithetyp(itype(i-1))
4871 coskt(k)=dcos(k*theti2)
4872 sinkt(k)=dsin(k*theti2)
4877 if (phii.ne.phii) phii=150.0
4881 ityp1=ithetyp(itype(i-2))
4883 cosph1(k)=dcos(k*phii)
4884 sinph1(k)=dsin(k*phii)
4897 if (phii1.ne.phii1) phii1=150.0
4902 ityp3=ithetyp(itype(i))
4904 cosph2(k)=dcos(k*phii1)
4905 sinph2(k)=dsin(k*phii1)
4915 ethetai=aa0thet(ityp1,ityp2,ityp3)
4918 ccl=cosph1(l)*cosph2(k-l)
4919 ssl=sinph1(l)*sinph2(k-l)
4920 scl=sinph1(l)*cosph2(k-l)
4921 csl=cosph1(l)*sinph2(k-l)
4922 cosph1ph2(l,k)=ccl-ssl
4923 cosph1ph2(k,l)=ccl+ssl
4924 sinph1ph2(l,k)=scl+csl
4925 sinph1ph2(k,l)=scl-csl
4929 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4930 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4931 write (iout,*) "coskt and sinkt"
4933 write (iout,*) k,coskt(k),sinkt(k)
4937 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4938 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4941 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4942 & " ethetai",ethetai
4945 write (iout,*) "cosph and sinph"
4947 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4949 write (iout,*) "cosph1ph2 and sinph2ph2"
4952 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4953 & sinph1ph2(l,k),sinph1ph2(k,l)
4956 write(iout,*) "ethetai",ethetai
4960 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4961 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4962 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4963 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4964 ethetai=ethetai+sinkt(m)*aux
4965 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4966 dephii=dephii+k*sinkt(m)*(
4967 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4968 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4969 dephii1=dephii1+k*sinkt(m)*(
4970 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4971 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4973 & write (iout,*) "m",m," k",k," bbthet",
4974 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4975 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4976 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4977 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4981 & write(iout,*) "ethetai",ethetai
4985 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4986 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4987 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4988 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4989 ethetai=ethetai+sinkt(m)*aux
4990 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4991 dephii=dephii+l*sinkt(m)*(
4992 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4993 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4994 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4995 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4996 dephii1=dephii1+(k-l)*sinkt(m)*(
4997 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4998 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4999 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
5000 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5002 write (iout,*) "m",m," k",k," l",l," ffthet",
5003 & ffthet(l,k,m,ityp1,ityp2,ityp3),
5004 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
5005 & ggthet(l,k,m,ityp1,ityp2,ityp3),
5006 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5007 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5008 & cosph1ph2(k,l)*sinkt(m),
5009 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5016 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
5017 & 'ebe', i,theta(i)*rad2deg,phii*rad2deg,
5018 & phii1*rad2deg,ethetai
5020 etheta=etheta+ethetai
5021 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5022 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5023 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5029 c-----------------------------------------------------------------------------
5030 subroutine esc(escloc)
5031 C Calculate the local energy of a side chain and its derivatives in the
5032 C corresponding virtual-bond valence angles THETA and the spherical angles
5034 implicit real*8 (a-h,o-z)
5035 include 'DIMENSIONS'
5036 include 'COMMON.GEO'
5037 include 'COMMON.LOCAL'
5038 include 'COMMON.VAR'
5039 include 'COMMON.INTERACT'
5040 include 'COMMON.DERIV'
5041 include 'COMMON.CHAIN'
5042 include 'COMMON.IOUNITS'
5043 include 'COMMON.NAMES'
5044 include 'COMMON.FFIELD'
5045 include 'COMMON.CONTROL'
5046 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5047 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5048 common /sccalc/ time11,time12,time112,theti,it,nlobit
5051 c write (iout,'(a)') 'ESC'
5052 do i=loc_start,loc_end
5054 if (it.eq.10) goto 1
5056 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5057 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5058 theti=theta(i+1)-pipol
5063 if (x(2).gt.pi-delta) then
5067 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5069 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5070 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5072 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5073 & ddersc0(1),dersc(1))
5074 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5075 & ddersc0(3),dersc(3))
5077 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5079 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5080 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5081 & dersc0(2),esclocbi,dersc02)
5082 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5084 call splinthet(x(2),0.5d0*delta,ss,ssd)
5089 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5091 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5092 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5094 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5096 c write (iout,*) escloci
5097 else if (x(2).lt.delta) then
5101 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5103 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5104 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5106 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5107 & ddersc0(1),dersc(1))
5108 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5109 & ddersc0(3),dersc(3))
5111 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5113 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5114 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5115 & dersc0(2),esclocbi,dersc02)
5116 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5121 call splinthet(x(2),0.5d0*delta,ss,ssd)
5123 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5125 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5126 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5128 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5129 c write (iout,*) escloci
5131 call enesc(x,escloci,dersc,ddummy,.false.)
5134 escloc=escloc+escloci
5135 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5136 & 'escloc',i,escloci
5137 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5139 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5141 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5142 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5147 C---------------------------------------------------------------------------
5148 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5149 implicit real*8 (a-h,o-z)
5150 include 'DIMENSIONS'
5151 include 'COMMON.GEO'
5152 include 'COMMON.LOCAL'
5153 include 'COMMON.IOUNITS'
5154 common /sccalc/ time11,time12,time112,theti,it,nlobit
5155 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5156 double precision contr(maxlob,-1:1)
5158 c write (iout,*) 'it=',it,' nlobit=',nlobit
5162 if (mixed) ddersc(j)=0.0d0
5166 C Because of periodicity of the dependence of the SC energy in omega we have
5167 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5168 C To avoid underflows, first compute & store the exponents.
5176 z(k)=x(k)-censc(k,j,it)
5181 Axk=Axk+gaussc(l,k,j,it)*z(l)
5187 expfac=expfac+Ax(k,j,iii)*z(k)
5195 C As in the case of ebend, we want to avoid underflows in exponentiation and
5196 C subsequent NaNs and INFs in energy calculation.
5197 C Find the largest exponent
5201 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5205 cd print *,'it=',it,' emin=',emin
5207 C Compute the contribution to SC energy and derivatives
5212 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5213 if(adexp.ne.adexp) adexp=1.0
5216 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5218 cd print *,'j=',j,' expfac=',expfac
5219 escloc_i=escloc_i+expfac
5221 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5225 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5226 & +gaussc(k,2,j,it))*expfac
5233 dersc(1)=dersc(1)/cos(theti)**2
5234 ddersc(1)=ddersc(1)/cos(theti)**2
5237 escloci=-(dlog(escloc_i)-emin)
5239 dersc(j)=dersc(j)/escloc_i
5243 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5248 C------------------------------------------------------------------------------
5249 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5250 implicit real*8 (a-h,o-z)
5251 include 'DIMENSIONS'
5252 include 'COMMON.GEO'
5253 include 'COMMON.LOCAL'
5254 include 'COMMON.IOUNITS'
5255 common /sccalc/ time11,time12,time112,theti,it,nlobit
5256 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5257 double precision contr(maxlob)
5268 z(k)=x(k)-censc(k,j,it)
5274 Axk=Axk+gaussc(l,k,j,it)*z(l)
5280 expfac=expfac+Ax(k,j)*z(k)
5285 C As in the case of ebend, we want to avoid underflows in exponentiation and
5286 C subsequent NaNs and INFs in energy calculation.
5287 C Find the largest exponent
5290 if (emin.gt.contr(j)) emin=contr(j)
5294 C Compute the contribution to SC energy and derivatives
5298 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5299 escloc_i=escloc_i+expfac
5301 dersc(k)=dersc(k)+Ax(k,j)*expfac
5303 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5304 & +gaussc(1,2,j,it))*expfac
5308 dersc(1)=dersc(1)/cos(theti)**2
5309 dersc12=dersc12/cos(theti)**2
5310 escloci=-(dlog(escloc_i)-emin)
5312 dersc(j)=dersc(j)/escloc_i
5314 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5318 c----------------------------------------------------------------------------------
5319 subroutine esc(escloc)
5320 C Calculate the local energy of a side chain and its derivatives in the
5321 C corresponding virtual-bond valence angles THETA and the spherical angles
5322 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5323 C added by Urszula Kozlowska. 07/11/2007
5325 implicit real*8 (a-h,o-z)
5326 include 'DIMENSIONS'
5327 include 'COMMON.GEO'
5328 include 'COMMON.LOCAL'
5329 include 'COMMON.VAR'
5330 include 'COMMON.SCROT'
5331 include 'COMMON.INTERACT'
5332 include 'COMMON.DERIV'
5333 include 'COMMON.CHAIN'
5334 include 'COMMON.IOUNITS'
5335 include 'COMMON.NAMES'
5336 include 'COMMON.FFIELD'
5337 include 'COMMON.CONTROL'
5338 include 'COMMON.VECTORS'
5339 double precision x_prime(3),y_prime(3),z_prime(3)
5340 & , sumene,dsc_i,dp2_i,x(65),
5341 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5342 & de_dxx,de_dyy,de_dzz,de_dt
5343 double precision s1_t,s1_6_t,s2_t,s2_6_t
5345 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5346 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5347 & dt_dCi(3),dt_dCi1(3)
5348 common /sccalc/ time11,time12,time112,theti,it,nlobit
5351 do i=loc_start,loc_end
5352 costtab(i+1) =dcos(theta(i+1))
5353 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5354 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5355 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5356 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5357 cosfac=dsqrt(cosfac2)
5358 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5359 sinfac=dsqrt(sinfac2)
5361 if (it.eq.10) goto 1
5363 C Compute the axes of tghe local cartesian coordinates system; store in
5364 c x_prime, y_prime and z_prime
5371 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5372 C & dc_norm(3,i+nres)
5374 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5375 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5378 z_prime(j) = -uz(j,i-1)
5381 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5382 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5383 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5384 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5385 c & " xy",scalar(x_prime(1),y_prime(1)),
5386 c & " xz",scalar(x_prime(1),z_prime(1)),
5387 c & " yy",scalar(y_prime(1),y_prime(1)),
5388 c & " yz",scalar(y_prime(1),z_prime(1)),
5389 c & " zz",scalar(z_prime(1),z_prime(1))
5391 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5392 C to local coordinate system. Store in xx, yy, zz.
5398 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5399 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5400 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5407 C Compute the energy of the ith side cbain
5409 c write (2,*) "xx",xx," yy",yy," zz",zz
5412 x(j) = sc_parmin(j,it)
5415 Cc diagnostics - remove later
5417 yy1 = dsin(alph(2))*dcos(omeg(2))
5418 zz1 = -dsin(alph(2))*dsin(omeg(2))
5419 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5420 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5422 C," --- ", xx_w,yy_w,zz_w
5425 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5426 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5428 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5429 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5431 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5432 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5433 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5434 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5435 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5437 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5438 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5439 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5440 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5441 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5443 dsc_i = 0.743d0+x(61)
5445 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5446 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5447 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5448 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5449 s1=(1+x(63))/(0.1d0 + dscp1)
5450 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5451 s2=(1+x(65))/(0.1d0 + dscp2)
5452 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5453 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5454 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5455 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5457 c & dscp1,dscp2,sumene
5458 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5459 escloc = escloc + sumene
5460 c write (2,*) "i",i," escloc",sumene,escloc
5463 C This section to check the numerical derivatives of the energy of ith side
5464 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5465 C #define DEBUG in the code to turn it on.
5467 write (2,*) "sumene =",sumene
5471 write (2,*) xx,yy,zz
5472 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5473 de_dxx_num=(sumenep-sumene)/aincr
5475 write (2,*) "xx+ sumene from enesc=",sumenep
5478 write (2,*) xx,yy,zz
5479 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5480 de_dyy_num=(sumenep-sumene)/aincr
5482 write (2,*) "yy+ sumene from enesc=",sumenep
5485 write (2,*) xx,yy,zz
5486 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5487 de_dzz_num=(sumenep-sumene)/aincr
5489 write (2,*) "zz+ sumene from enesc=",sumenep
5490 costsave=cost2tab(i+1)
5491 sintsave=sint2tab(i+1)
5492 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5493 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5494 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5495 de_dt_num=(sumenep-sumene)/aincr
5496 write (2,*) " t+ sumene from enesc=",sumenep
5497 cost2tab(i+1)=costsave
5498 sint2tab(i+1)=sintsave
5499 C End of diagnostics section.
5502 C Compute the gradient of esc
5504 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5505 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5506 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5507 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5508 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5509 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5510 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5511 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5512 pom1=(sumene3*sint2tab(i+1)+sumene1)
5513 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5514 pom2=(sumene4*cost2tab(i+1)+sumene2)
5515 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5516 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5517 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5518 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5520 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5521 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5522 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5524 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5525 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5526 & +(pom1+pom2)*pom_dx
5528 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5531 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5532 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5533 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5535 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5536 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5537 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5538 & +x(59)*zz**2 +x(60)*xx*zz
5539 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5540 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5541 & +(pom1-pom2)*pom_dy
5543 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5546 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5547 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5548 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5549 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5550 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5551 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5552 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5553 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5555 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5558 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5559 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5560 & +pom1*pom_dt1+pom2*pom_dt2
5562 write(2,*), "de_dt = ", de_dt,de_dt_num
5566 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5567 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5568 cosfac2xx=cosfac2*xx
5569 sinfac2yy=sinfac2*yy
5571 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5573 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5575 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5576 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5577 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5578 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5579 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5580 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5581 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5582 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5583 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5584 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5588 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5589 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5592 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5593 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5594 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5596 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5597 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5601 dXX_Ctab(k,i)=dXX_Ci(k)
5602 dXX_C1tab(k,i)=dXX_Ci1(k)
5603 dYY_Ctab(k,i)=dYY_Ci(k)
5604 dYY_C1tab(k,i)=dYY_Ci1(k)
5605 dZZ_Ctab(k,i)=dZZ_Ci(k)
5606 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5607 dXX_XYZtab(k,i)=dXX_XYZ(k)
5608 dYY_XYZtab(k,i)=dYY_XYZ(k)
5609 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5613 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5614 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5615 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5616 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5617 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5619 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5620 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5621 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5622 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5623 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5624 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5625 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5626 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5628 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5629 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5631 C to check gradient call subroutine check_grad
5637 c------------------------------------------------------------------------------
5638 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5640 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5641 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5642 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5643 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5645 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5646 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5648 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5649 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5650 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5651 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5652 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5654 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5655 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5656 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5657 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5658 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5660 dsc_i = 0.743d0+x(61)
5662 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5663 & *(xx*cost2+yy*sint2))
5664 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5665 & *(xx*cost2-yy*sint2))
5666 s1=(1+x(63))/(0.1d0 + dscp1)
5667 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5668 s2=(1+x(65))/(0.1d0 + dscp2)
5669 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5670 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5671 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5676 c------------------------------------------------------------------------------
5677 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5679 C This procedure calculates two-body contact function g(rij) and its derivative:
5682 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5685 C where x=(rij-r0ij)/delta
5687 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5690 double precision rij,r0ij,eps0ij,fcont,fprimcont
5691 double precision x,x2,x4,delta
5695 if (x.lt.-1.0D0) then
5698 else if (x.le.1.0D0) then
5701 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5702 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5709 c------------------------------------------------------------------------------
5710 subroutine splinthet(theti,delta,ss,ssder)
5711 implicit real*8 (a-h,o-z)
5712 include 'DIMENSIONS'
5713 include 'COMMON.VAR'
5714 include 'COMMON.GEO'
5717 if (theti.gt.pipol) then
5718 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5720 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5725 c------------------------------------------------------------------------------
5726 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5728 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5729 double precision ksi,ksi2,ksi3,a1,a2,a3
5730 a1=fprim0*delta/(f1-f0)
5736 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5737 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5740 c------------------------------------------------------------------------------
5741 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5743 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5744 double precision ksi,ksi2,ksi3,a1,a2,a3
5749 a2=3*(f1x-f0x)-2*fprim0x*delta
5750 a3=fprim0x*delta-2*(f1x-f0x)
5751 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5754 C-----------------------------------------------------------------------------
5756 C-----------------------------------------------------------------------------
5757 subroutine etor(etors,edihcnstr)
5758 implicit real*8 (a-h,o-z)
5759 include 'DIMENSIONS'
5760 include 'COMMON.VAR'
5761 include 'COMMON.GEO'
5762 include 'COMMON.LOCAL'
5763 include 'COMMON.TORSION'
5764 include 'COMMON.INTERACT'
5765 include 'COMMON.DERIV'
5766 include 'COMMON.CHAIN'
5767 include 'COMMON.NAMES'
5768 include 'COMMON.IOUNITS'
5769 include 'COMMON.FFIELD'
5770 include 'COMMON.TORCNSTR'
5771 include 'COMMON.CONTROL'
5773 C Set lprn=.true. for debugging
5777 do i=iphi_start,iphi_end
5779 itori=itortyp(itype(i-2))
5780 itori1=itortyp(itype(i-1))
5783 C Proline-Proline pair is a special case...
5784 if (itori.eq.3 .and. itori1.eq.3) then
5785 if (phii.gt.-dwapi3) then
5787 fac=1.0D0/(1.0D0-cosphi)
5788 etorsi=v1(1,3,3)*fac
5789 etorsi=etorsi+etorsi
5790 etors=etors+etorsi-v1(1,3,3)
5791 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5792 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5795 v1ij=v1(j+1,itori,itori1)
5796 v2ij=v2(j+1,itori,itori1)
5799 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5800 if (energy_dec) etors_ii=etors_ii+
5801 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5802 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5806 v1ij=v1(j,itori,itori1)
5807 v2ij=v2(j,itori,itori1)
5810 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5811 if (energy_dec) etors_ii=etors_ii+
5812 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5813 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5816 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5819 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5820 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5821 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5822 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5823 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5825 ! 6/20/98 - dihedral angle constraints
5828 itori=idih_constr(i)
5831 if (difi.gt.drange(i)) then
5833 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5834 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5835 else if (difi.lt.-drange(i)) then
5837 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5838 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5840 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5841 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5843 ! write (iout,*) 'edihcnstr',edihcnstr
5846 c------------------------------------------------------------------------------
5847 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
5848 subroutine e_modeller(ehomology_constr)
5849 ehomology_constr=0.0
5850 write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
5853 C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
5855 c------------------------------------------------------------------------------
5856 subroutine etor_d(etors_d)
5860 c----------------------------------------------------------------------------
5862 subroutine etor(etors,edihcnstr)
5863 implicit real*8 (a-h,o-z)
5864 include 'DIMENSIONS'
5865 include 'COMMON.VAR'
5866 include 'COMMON.GEO'
5867 include 'COMMON.LOCAL'
5868 include 'COMMON.TORSION'
5869 include 'COMMON.INTERACT'
5870 include 'COMMON.DERIV'
5871 include 'COMMON.CHAIN'
5872 include 'COMMON.NAMES'
5873 include 'COMMON.IOUNITS'
5874 include 'COMMON.FFIELD'
5875 include 'COMMON.TORCNSTR'
5876 include 'COMMON.CONTROL'
5878 C Set lprn=.true. for debugging
5882 do i=iphi_start,iphi_end
5884 itori=itortyp(itype(i-2))
5885 itori1=itortyp(itype(i-1))
5888 C Regular cosine and sine terms
5889 do j=1,nterm(itori,itori1)
5890 v1ij=v1(j,itori,itori1)
5891 v2ij=v2(j,itori,itori1)
5894 etors=etors+v1ij*cosphi+v2ij*sinphi
5895 if (energy_dec) etors_ii=etors_ii+
5896 & v1ij*cosphi+v2ij*sinphi
5897 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5901 C E = SUM ----------------------------------- - v1
5902 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5904 cosphi=dcos(0.5d0*phii)
5905 sinphi=dsin(0.5d0*phii)
5906 do j=1,nlor(itori,itori1)
5907 vl1ij=vlor1(j,itori,itori1)
5908 vl2ij=vlor2(j,itori,itori1)
5909 vl3ij=vlor3(j,itori,itori1)
5910 pom=vl2ij*cosphi+vl3ij*sinphi
5911 pom1=1.0d0/(pom*pom+1.0d0)
5912 etors=etors+vl1ij*pom1
5913 if (energy_dec) etors_ii=etors_ii+
5916 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5918 C Subtract the constant term
5919 etors=etors-v0(itori,itori1)
5920 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5921 & 'etor',i,etors_ii-v0(itori,itori1)
5923 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5924 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5925 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5926 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5927 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5929 ! 6/20/98 - dihedral angle constraints
5931 c do i=1,ndih_constr
5932 do i=idihconstr_start,idihconstr_end
5933 itori=idih_constr(i)
5935 difi=pinorm(phii-phi0(i))
5936 if (difi.gt.drange(i)) then
5938 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5939 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5940 else if (difi.lt.-drange(i)) then
5942 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5943 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5947 c write (iout,*) "gloci", gloc(i-3,icg)
5948 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5949 cd & rad2deg*phi0(i), rad2deg*drange(i),
5950 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5952 cd write (iout,*) 'edihcnstr',edihcnstr
5955 c----------------------------------------------------------------------------
5956 c MODELLER restraint function
5957 subroutine e_modeller(ehomology_constr)
5958 implicit real*8 (a-h,o-z)
5959 include 'DIMENSIONS'
5961 integer nnn, i, j, k, ki, irec, l
5962 integer katy, odleglosci, test7
5963 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
5964 real*8 distance(max_template),distancek(max_template),
5965 & min_odl,godl(max_template),dih_diff(max_template)
5967 include 'COMMON.SBRIDGE'
5968 include 'COMMON.CHAIN'
5969 include 'COMMON.GEO'
5970 include 'COMMON.DERIV'
5971 include 'COMMON.LOCAL'
5972 include 'COMMON.INTERACT'
5973 include 'COMMON.VAR'
5974 include 'COMMON.IOUNITS'
5976 include 'COMMON.CONTROL'
5980 distancek(i)=9999999.9
5986 c Pseudo-energy and gradient from homology restraints (MODELLER-like
5988 C AL 5/2/14 - Introduce list of restraints
5989 do ii = link_start_homo,link_end_homo
5993 do k=1,constr_homology
5994 distance(k)=odl(k,ii)-dij
5996 & 0.5d0*waga_dist(iset)*distance(k)**2*sigma_odl(k,ii)
5999 min_odl=minval(distancek)
6001 write (iout,*) "ij dij",i,j,dij
6002 write (iout,*) "distance",(distance(k),k=1,constr_homology)
6003 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
6004 write (iout,* )"min_odl",min_odl
6007 do k=1,constr_homology
6008 c Nie wiem po co to liczycie jeszcze raz!
6009 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
6010 c & (2*(sigma_odl(i,j,k))**2))
6011 godl(k)=dexp(-distancek(k)+min_odl)
6012 odleg2=odleg2+godl(k)
6014 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
6015 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
6016 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
6017 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
6021 write (iout,*) "godl",(godl(k),k=1,constr_homology)
6022 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2
6024 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
6028 do k=1,constr_homology
6029 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6030 c & *waga_dist(iset))+min_odl
6031 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist(iset)
6032 sum_sgodl=sum_sgodl+sgodl
6034 c sgodl2=sgodl2+sgodl
6035 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
6036 c write(iout,*) "constr_homology=",constr_homology
6037 c write(iout,*) i, j, k, "TEST K"
6040 grad_odl3=sum_sgodl/(sum_godl*dij)
6043 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
6044 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
6045 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6047 ccc write(iout,*) godl, sgodl, grad_odl3
6049 c grad_odl=grad_odl+grad_odl3
6052 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
6053 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
6054 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
6055 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6056 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
6057 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
6058 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
6059 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6062 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
6063 ccc & dLOG(odleg2),"-odleg=", -odleg
6066 c Pseudo-energy and gradient from dihedral-angle restraints from
6067 c homology templates
6068 c write (iout,*) "End of distance loop"
6071 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
6072 do i=idihconstr_start_homo,idihconstr_end_homo
6074 c betai=beta(i,i+1,i+2,i+3)
6076 do k=1,constr_homology
6077 dih_diff(k)=pinorm(dih(k,i)-betai)
6078 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
6079 c & -(6.28318-dih_diff(i,k))
6080 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
6081 c & 6.28318+dih_diff(i,k)
6083 kat3=-0.5d0*waga_angle(iset)*dih_diff(k)**2*sigma_dih(k,i)
6086 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
6090 write (iout,*) "i",i," betai",betai," kat2",kat2
6091 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
6093 if (kat2.le.1.0d-14) cycle
6094 kat=kat-dLOG(kat2/constr_homology)
6096 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
6097 ccc & dLOG(kat2), "-kat=", -kat
6099 c ----------------------------------------------------------------------
6101 c ----------------------------------------------------------------------
6105 do k=1,constr_homology
6106 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle(iset)
6107 sum_sgdih=sum_sgdih+sgdih
6109 grad_dih3=sum_sgdih/sum_gdih
6111 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
6112 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
6113 ccc & gloc(nphi+i-3,icg)
6114 gloc(i,icg)=gloc(i,icg)+grad_dih3
6115 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
6116 ccc & gloc(nphi+i-3,icg)
6121 c Total energy from homology restraints
6123 write (iout,*) "odleg",odleg," kat",kat
6125 ehomology_constr=odleg+kat
6128 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
6129 747 format(a12,i4,i4,i4,f8.3,f8.3)
6130 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
6131 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
6132 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
6133 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
6136 c------------------------------------------------------------------------------
6137 subroutine etor_d(etors_d)
6138 C 6/23/01 Compute double torsional energy
6139 implicit real*8 (a-h,o-z)
6140 include 'DIMENSIONS'
6141 include 'COMMON.VAR'
6142 include 'COMMON.GEO'
6143 include 'COMMON.LOCAL'
6144 include 'COMMON.TORSION'
6145 include 'COMMON.INTERACT'
6146 include 'COMMON.DERIV'
6147 include 'COMMON.CHAIN'
6148 include 'COMMON.NAMES'
6149 include 'COMMON.IOUNITS'
6150 include 'COMMON.FFIELD'
6151 include 'COMMON.TORCNSTR'
6153 C Set lprn=.true. for debugging
6157 do i=iphid_start,iphid_end
6158 itori=itortyp(itype(i-2))
6159 itori1=itortyp(itype(i-1))
6160 itori2=itortyp(itype(i))
6165 do j=1,ntermd_1(itori,itori1,itori2)
6166 v1cij=v1c(1,j,itori,itori1,itori2)
6167 v1sij=v1s(1,j,itori,itori1,itori2)
6168 v2cij=v1c(2,j,itori,itori1,itori2)
6169 v2sij=v1s(2,j,itori,itori1,itori2)
6170 cosphi1=dcos(j*phii)
6171 sinphi1=dsin(j*phii)
6172 cosphi2=dcos(j*phii1)
6173 sinphi2=dsin(j*phii1)
6174 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6175 & v2cij*cosphi2+v2sij*sinphi2
6176 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6177 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6179 do k=2,ntermd_2(itori,itori1,itori2)
6181 v1cdij = v2c(k,l,itori,itori1,itori2)
6182 v2cdij = v2c(l,k,itori,itori1,itori2)
6183 v1sdij = v2s(k,l,itori,itori1,itori2)
6184 v2sdij = v2s(l,k,itori,itori1,itori2)
6185 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6186 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6187 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6188 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6189 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6190 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6191 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6192 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6193 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6194 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6197 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6198 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6199 c write (iout,*) "gloci", gloc(i-3,icg)
6204 c------------------------------------------------------------------------------
6205 subroutine eback_sc_corr(esccor)
6206 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6207 c conformational states; temporarily implemented as differences
6208 c between UNRES torsional potentials (dependent on three types of
6209 c residues) and the torsional potentials dependent on all 20 types
6210 c of residues computed from AM1 energy surfaces of terminally-blocked
6211 c amino-acid residues.
6212 implicit real*8 (a-h,o-z)
6213 include 'DIMENSIONS'
6214 include 'COMMON.VAR'
6215 include 'COMMON.GEO'
6216 include 'COMMON.LOCAL'
6217 include 'COMMON.TORSION'
6218 include 'COMMON.SCCOR'
6219 include 'COMMON.INTERACT'
6220 include 'COMMON.DERIV'
6221 include 'COMMON.CHAIN'
6222 include 'COMMON.NAMES'
6223 include 'COMMON.IOUNITS'
6224 include 'COMMON.FFIELD'
6225 include 'COMMON.CONTROL'
6227 C Set lprn=.true. for debugging
6230 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6232 do i=itau_start,itau_end
6234 isccori=isccortyp(itype(i-2))
6235 isccori1=isccortyp(itype(i-1))
6237 cccc Added 9 May 2012
6238 cc Tauangle is torsional engle depending on the value of first digit
6239 c(see comment below)
6240 cc Omicron is flat angle depending on the value of first digit
6241 c(see comment below)
6244 do intertyp=1,3 !intertyp
6245 cc Added 09 May 2012 (Adasko)
6246 cc Intertyp means interaction type of backbone mainchain correlation:
6247 c 1 = SC...Ca...Ca...Ca
6248 c 2 = Ca...Ca...Ca...SC
6249 c 3 = SC...Ca...Ca...SCi
6251 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6252 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6253 & (itype(i-1).eq.21)))
6254 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6255 & .or.(itype(i-2).eq.21)))
6256 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6257 & (itype(i-1).eq.21)))) cycle
6258 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6259 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6261 do j=1,nterm_sccor(isccori,isccori1)
6262 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6263 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6264 cosphi=dcos(j*tauangle(intertyp,i))
6265 sinphi=dsin(j*tauangle(intertyp,i))
6266 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6267 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6269 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6270 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6271 c &gloc_sc(intertyp,i-3,icg)
6273 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6274 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6275 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6276 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6277 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6281 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6285 c----------------------------------------------------------------------------
6286 subroutine multibody(ecorr)
6287 C This subroutine calculates multi-body contributions to energy following
6288 C the idea of Skolnick et al. If side chains I and J make a contact and
6289 C at the same time side chains I+1 and J+1 make a contact, an extra
6290 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6291 implicit real*8 (a-h,o-z)
6292 include 'DIMENSIONS'
6293 include 'COMMON.IOUNITS'
6294 include 'COMMON.DERIV'
6295 include 'COMMON.INTERACT'
6296 include 'COMMON.CONTACTS'
6297 double precision gx(3),gx1(3)
6300 C Set lprn=.true. for debugging
6304 write (iout,'(a)') 'Contact function values:'
6306 write (iout,'(i2,20(1x,i2,f10.5))')
6307 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6322 num_conti=num_cont(i)
6323 num_conti1=num_cont(i1)
6328 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6329 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6330 cd & ' ishift=',ishift
6331 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6332 C The system gains extra energy.
6333 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6334 endif ! j1==j+-ishift
6343 c------------------------------------------------------------------------------
6344 double precision function esccorr(i,j,k,l,jj,kk)
6345 implicit real*8 (a-h,o-z)
6346 include 'DIMENSIONS'
6347 include 'COMMON.IOUNITS'
6348 include 'COMMON.DERIV'
6349 include 'COMMON.INTERACT'
6350 include 'COMMON.CONTACTS'
6351 double precision gx(3),gx1(3)
6356 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6357 C Calculate the multi-body contribution to energy.
6358 C Calculate multi-body contributions to the gradient.
6359 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6360 cd & k,l,(gacont(m,kk,k),m=1,3)
6362 gx(m) =ekl*gacont(m,jj,i)
6363 gx1(m)=eij*gacont(m,kk,k)
6364 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6365 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6366 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6367 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6371 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6376 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6382 c------------------------------------------------------------------------------
6383 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6384 C This subroutine calculates multi-body contributions to hydrogen-bonding
6385 implicit real*8 (a-h,o-z)
6386 include 'DIMENSIONS'
6387 include 'COMMON.IOUNITS'
6390 parameter (max_cont=maxconts)
6391 parameter (max_dim=26)
6392 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6393 double precision zapas(max_dim,maxconts,max_fg_procs),
6394 & zapas_recv(max_dim,maxconts,max_fg_procs)
6395 common /przechowalnia/ zapas
6396 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6397 & status_array(MPI_STATUS_SIZE,maxconts*2)
6399 include 'COMMON.SETUP'
6400 include 'COMMON.FFIELD'
6401 include 'COMMON.DERIV'
6402 include 'COMMON.INTERACT'
6403 include 'COMMON.CONTACTS'
6404 include 'COMMON.CONTROL'
6405 include 'COMMON.LOCAL'
6406 double precision gx(3),gx1(3),time00
6409 C Set lprn=.true. for debugging
6414 if (nfgtasks.le.1) goto 30
6416 write (iout,'(a)') 'Contact function values before RECEIVE:'
6418 write (iout,'(2i3,50(1x,i2,f5.2))')
6419 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6420 & j=1,num_cont_hb(i))
6424 do i=1,ntask_cont_from
6427 do i=1,ntask_cont_to
6430 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6432 C Make the list of contacts to send to send to other procesors
6433 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6435 do i=iturn3_start,iturn3_end
6436 c write (iout,*) "make contact list turn3",i," num_cont",
6438 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6440 do i=iturn4_start,iturn4_end
6441 c write (iout,*) "make contact list turn4",i," num_cont",
6443 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6447 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6449 do j=1,num_cont_hb(i)
6452 iproc=iint_sent_local(k,jjc,ii)
6453 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6454 if (iproc.gt.0) then
6455 ncont_sent(iproc)=ncont_sent(iproc)+1
6456 nn=ncont_sent(iproc)
6458 zapas(2,nn,iproc)=jjc
6459 zapas(3,nn,iproc)=facont_hb(j,i)
6460 zapas(4,nn,iproc)=ees0p(j,i)
6461 zapas(5,nn,iproc)=ees0m(j,i)
6462 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6463 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6464 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6465 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6466 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6467 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6468 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6469 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6470 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6471 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6472 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6473 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6474 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6475 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6476 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6477 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6478 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6479 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6480 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6481 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6482 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6489 & "Numbers of contacts to be sent to other processors",
6490 & (ncont_sent(i),i=1,ntask_cont_to)
6491 write (iout,*) "Contacts sent"
6492 do ii=1,ntask_cont_to
6494 iproc=itask_cont_to(ii)
6495 write (iout,*) nn," contacts to processor",iproc,
6496 & " of CONT_TO_COMM group"
6498 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6506 CorrelID1=nfgtasks+fg_rank+1
6508 C Receive the numbers of needed contacts from other processors
6509 do ii=1,ntask_cont_from
6510 iproc=itask_cont_from(ii)
6512 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6513 & FG_COMM,req(ireq),IERR)
6515 c write (iout,*) "IRECV ended"
6517 C Send the number of contacts needed by other processors
6518 do ii=1,ntask_cont_to
6519 iproc=itask_cont_to(ii)
6521 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6522 & FG_COMM,req(ireq),IERR)
6524 c write (iout,*) "ISEND ended"
6525 c write (iout,*) "number of requests (nn)",ireq
6528 & call MPI_Waitall(ireq,req,status_array,ierr)
6530 c & "Numbers of contacts to be received from other processors",
6531 c & (ncont_recv(i),i=1,ntask_cont_from)
6535 do ii=1,ntask_cont_from
6536 iproc=itask_cont_from(ii)
6538 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6539 c & " of CONT_TO_COMM group"
6543 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6544 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6545 c write (iout,*) "ireq,req",ireq,req(ireq)
6548 C Send the contacts to processors that need them
6549 do ii=1,ntask_cont_to
6550 iproc=itask_cont_to(ii)
6552 c write (iout,*) nn," contacts to processor",iproc,
6553 c & " of CONT_TO_COMM group"
6556 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6557 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6558 c write (iout,*) "ireq,req",ireq,req(ireq)
6560 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6564 c write (iout,*) "number of requests (contacts)",ireq
6565 c write (iout,*) "req",(req(i),i=1,4)
6568 & call MPI_Waitall(ireq,req,status_array,ierr)
6569 do iii=1,ntask_cont_from
6570 iproc=itask_cont_from(iii)
6573 write (iout,*) "Received",nn," contacts from processor",iproc,
6574 & " of CONT_FROM_COMM group"
6577 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6582 ii=zapas_recv(1,i,iii)
6583 c Flag the received contacts to prevent double-counting
6584 jj=-zapas_recv(2,i,iii)
6585 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6587 nnn=num_cont_hb(ii)+1
6590 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6591 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6592 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6593 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6594 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6595 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6596 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6597 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6598 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6599 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6600 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6601 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6602 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6603 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6604 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6605 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6606 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6607 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6608 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6609 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6610 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6611 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6612 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6613 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6618 write (iout,'(a)') 'Contact function values after receive:'
6620 write (iout,'(2i3,50(1x,i3,f5.2))')
6621 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6622 & j=1,num_cont_hb(i))
6629 write (iout,'(a)') 'Contact function values:'
6631 write (iout,'(2i3,50(1x,i3,f5.2))')
6632 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6633 & j=1,num_cont_hb(i))
6637 C Remove the loop below after debugging !!!
6644 C Calculate the local-electrostatic correlation terms
6645 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6647 num_conti=num_cont_hb(i)
6648 num_conti1=num_cont_hb(i+1)
6655 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6656 c & ' jj=',jj,' kk=',kk
6657 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6658 & .or. j.lt.0 .and. j1.gt.0) .and.
6659 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6660 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6661 C The system gains extra energy.
6662 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6663 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6664 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6666 else if (j1.eq.j) then
6667 C Contacts I-J and I-(J+1) occur simultaneously.
6668 C The system loses extra energy.
6669 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6674 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6675 c & ' jj=',jj,' kk=',kk
6677 C Contacts I-J and (I+1)-J occur simultaneously.
6678 C The system loses extra energy.
6679 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6686 c------------------------------------------------------------------------------
6687 subroutine add_hb_contact(ii,jj,itask)
6688 implicit real*8 (a-h,o-z)
6689 include "DIMENSIONS"
6690 include "COMMON.IOUNITS"
6693 parameter (max_cont=maxconts)
6694 parameter (max_dim=26)
6695 include "COMMON.CONTACTS"
6696 double precision zapas(max_dim,maxconts,max_fg_procs),
6697 & zapas_recv(max_dim,maxconts,max_fg_procs)
6698 common /przechowalnia/ zapas
6699 integer i,j,ii,jj,iproc,itask(4),nn
6700 c write (iout,*) "itask",itask
6703 if (iproc.gt.0) then
6704 do j=1,num_cont_hb(ii)
6706 c write (iout,*) "i",ii," j",jj," jjc",jjc
6708 ncont_sent(iproc)=ncont_sent(iproc)+1
6709 nn=ncont_sent(iproc)
6710 zapas(1,nn,iproc)=ii
6711 zapas(2,nn,iproc)=jjc
6712 zapas(3,nn,iproc)=facont_hb(j,ii)
6713 zapas(4,nn,iproc)=ees0p(j,ii)
6714 zapas(5,nn,iproc)=ees0m(j,ii)
6715 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6716 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6717 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6718 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6719 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6720 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6721 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6722 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6723 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6724 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6725 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6726 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6727 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6728 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6729 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6730 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6731 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6732 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6733 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6734 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6735 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6743 c------------------------------------------------------------------------------
6744 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6746 C This subroutine calculates multi-body contributions to hydrogen-bonding
6747 implicit real*8 (a-h,o-z)
6748 include 'DIMENSIONS'
6749 include 'COMMON.IOUNITS'
6752 parameter (max_cont=maxconts)
6753 parameter (max_dim=70)
6754 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6755 double precision zapas(max_dim,maxconts,max_fg_procs),
6756 & zapas_recv(max_dim,maxconts,max_fg_procs)
6757 common /przechowalnia/ zapas
6758 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6759 & status_array(MPI_STATUS_SIZE,maxconts*2)
6761 include 'COMMON.SETUP'
6762 include 'COMMON.FFIELD'
6763 include 'COMMON.DERIV'
6764 include 'COMMON.LOCAL'
6765 include 'COMMON.INTERACT'
6766 include 'COMMON.CONTACTS'
6767 include 'COMMON.CHAIN'
6768 include 'COMMON.CONTROL'
6769 double precision gx(3),gx1(3)
6770 integer num_cont_hb_old(maxres)
6772 double precision eello4,eello5,eelo6,eello_turn6
6773 external eello4,eello5,eello6,eello_turn6
6774 C Set lprn=.true. for debugging
6779 num_cont_hb_old(i)=num_cont_hb(i)
6783 if (nfgtasks.le.1) goto 30
6785 write (iout,'(a)') 'Contact function values before RECEIVE:'
6787 write (iout,'(2i3,50(1x,i2,f5.2))')
6788 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6789 & j=1,num_cont_hb(i))
6793 do i=1,ntask_cont_from
6796 do i=1,ntask_cont_to
6799 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6801 C Make the list of contacts to send to send to other procesors
6802 do i=iturn3_start,iturn3_end
6803 c write (iout,*) "make contact list turn3",i," num_cont",
6805 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6807 do i=iturn4_start,iturn4_end
6808 c write (iout,*) "make contact list turn4",i," num_cont",
6810 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6814 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6816 do j=1,num_cont_hb(i)
6819 iproc=iint_sent_local(k,jjc,ii)
6820 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6821 if (iproc.ne.0) then
6822 ncont_sent(iproc)=ncont_sent(iproc)+1
6823 nn=ncont_sent(iproc)
6825 zapas(2,nn,iproc)=jjc
6826 zapas(3,nn,iproc)=d_cont(j,i)
6830 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6835 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6843 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6854 & "Numbers of contacts to be sent to other processors",
6855 & (ncont_sent(i),i=1,ntask_cont_to)
6856 write (iout,*) "Contacts sent"
6857 do ii=1,ntask_cont_to
6859 iproc=itask_cont_to(ii)
6860 write (iout,*) nn," contacts to processor",iproc,
6861 & " of CONT_TO_COMM group"
6863 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6871 CorrelID1=nfgtasks+fg_rank+1
6873 C Receive the numbers of needed contacts from other processors
6874 do ii=1,ntask_cont_from
6875 iproc=itask_cont_from(ii)
6877 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6878 & FG_COMM,req(ireq),IERR)
6880 c write (iout,*) "IRECV ended"
6882 C Send the number of contacts needed by other processors
6883 do ii=1,ntask_cont_to
6884 iproc=itask_cont_to(ii)
6886 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6887 & FG_COMM,req(ireq),IERR)
6889 c write (iout,*) "ISEND ended"
6890 c write (iout,*) "number of requests (nn)",ireq
6893 & call MPI_Waitall(ireq,req,status_array,ierr)
6895 c & "Numbers of contacts to be received from other processors",
6896 c & (ncont_recv(i),i=1,ntask_cont_from)
6900 do ii=1,ntask_cont_from
6901 iproc=itask_cont_from(ii)
6903 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6904 c & " of CONT_TO_COMM group"
6908 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6909 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6910 c write (iout,*) "ireq,req",ireq,req(ireq)
6913 C Send the contacts to processors that need them
6914 do ii=1,ntask_cont_to
6915 iproc=itask_cont_to(ii)
6917 c write (iout,*) nn," contacts to processor",iproc,
6918 c & " of CONT_TO_COMM group"
6921 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6922 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6923 c write (iout,*) "ireq,req",ireq,req(ireq)
6925 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6929 c write (iout,*) "number of requests (contacts)",ireq
6930 c write (iout,*) "req",(req(i),i=1,4)
6933 & call MPI_Waitall(ireq,req,status_array,ierr)
6934 do iii=1,ntask_cont_from
6935 iproc=itask_cont_from(iii)
6938 write (iout,*) "Received",nn," contacts from processor",iproc,
6939 & " of CONT_FROM_COMM group"
6942 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6947 ii=zapas_recv(1,i,iii)
6948 c Flag the received contacts to prevent double-counting
6949 jj=-zapas_recv(2,i,iii)
6950 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6952 nnn=num_cont_hb(ii)+1
6955 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6959 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6964 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6972 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6981 write (iout,'(a)') 'Contact function values after receive:'
6983 write (iout,'(2i3,50(1x,i3,5f6.3))')
6984 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6985 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6992 write (iout,'(a)') 'Contact function values:'
6994 write (iout,'(2i3,50(1x,i2,5f6.3))')
6995 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6996 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7002 C Remove the loop below after debugging !!!
7009 C Calculate the dipole-dipole interaction energies
7010 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7011 do i=iatel_s,iatel_e+1
7012 num_conti=num_cont_hb(i)
7021 C Calculate the local-electrostatic correlation terms
7022 c write (iout,*) "gradcorr5 in eello5 before loop"
7024 c write (iout,'(i5,3f10.5)')
7025 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7027 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7028 c write (iout,*) "corr loop i",i
7030 num_conti=num_cont_hb(i)
7031 num_conti1=num_cont_hb(i+1)
7038 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7039 c & ' jj=',jj,' kk=',kk
7040 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7041 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7042 & .or. j.lt.0 .and. j1.gt.0) .and.
7043 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7044 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7045 C The system gains extra energy.
7047 sqd1=dsqrt(d_cont(jj,i))
7048 sqd2=dsqrt(d_cont(kk,i1))
7049 sred_geom = sqd1*sqd2
7050 IF (sred_geom.lt.cutoff_corr) THEN
7051 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7053 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7054 cd & ' jj=',jj,' kk=',kk
7055 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7056 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7058 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7059 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7062 cd write (iout,*) 'sred_geom=',sred_geom,
7063 cd & ' ekont=',ekont,' fprim=',fprimcont,
7064 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7065 cd write (iout,*) "g_contij",g_contij
7066 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7067 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7068 call calc_eello(i,jp,i+1,jp1,jj,kk)
7069 if (wcorr4.gt.0.0d0)
7070 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7071 if (energy_dec.and.wcorr4.gt.0.0d0)
7072 1 write (iout,'(a6,4i5,0pf7.3)')
7073 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7074 c write (iout,*) "gradcorr5 before eello5"
7076 c write (iout,'(i5,3f10.5)')
7077 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7079 if (wcorr5.gt.0.0d0)
7080 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7081 c write (iout,*) "gradcorr5 after eello5"
7083 c write (iout,'(i5,3f10.5)')
7084 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7086 if (energy_dec.and.wcorr5.gt.0.0d0)
7087 1 write (iout,'(a6,4i5,0pf7.3)')
7088 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7089 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7090 cd write(2,*)'ijkl',i,jp,i+1,jp1
7091 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7092 & .or. wturn6.eq.0.0d0))then
7093 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7094 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7095 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7096 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7097 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7098 cd & 'ecorr6=',ecorr6
7099 cd write (iout,'(4e15.5)') sred_geom,
7100 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7101 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7102 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7103 else if (wturn6.gt.0.0d0
7104 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7105 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7106 eturn6=eturn6+eello_turn6(i,jj,kk)
7107 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7108 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7109 cd write (2,*) 'multibody_eello:eturn6',eturn6
7118 num_cont_hb(i)=num_cont_hb_old(i)
7120 c write (iout,*) "gradcorr5 in eello5"
7122 c write (iout,'(i5,3f10.5)')
7123 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7127 c------------------------------------------------------------------------------
7128 subroutine add_hb_contact_eello(ii,jj,itask)
7129 implicit real*8 (a-h,o-z)
7130 include "DIMENSIONS"
7131 include "COMMON.IOUNITS"
7134 parameter (max_cont=maxconts)
7135 parameter (max_dim=70)
7136 include "COMMON.CONTACTS"
7137 double precision zapas(max_dim,maxconts,max_fg_procs),
7138 & zapas_recv(max_dim,maxconts,max_fg_procs)
7139 common /przechowalnia/ zapas
7140 integer i,j,ii,jj,iproc,itask(4),nn
7141 c write (iout,*) "itask",itask
7144 if (iproc.gt.0) then
7145 do j=1,num_cont_hb(ii)
7147 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7149 ncont_sent(iproc)=ncont_sent(iproc)+1
7150 nn=ncont_sent(iproc)
7151 zapas(1,nn,iproc)=ii
7152 zapas(2,nn,iproc)=jjc
7153 zapas(3,nn,iproc)=d_cont(j,ii)
7157 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7162 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7170 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7182 c------------------------------------------------------------------------------
7183 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7184 implicit real*8 (a-h,o-z)
7185 include 'DIMENSIONS'
7186 include 'COMMON.IOUNITS'
7187 include 'COMMON.DERIV'
7188 include 'COMMON.INTERACT'
7189 include 'COMMON.CONTACTS'
7190 double precision gx(3),gx1(3)
7200 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7201 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7202 C Following 4 lines for diagnostics.
7207 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7208 c & 'Contacts ',i,j,
7209 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7210 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7212 C Calculate the multi-body contribution to energy.
7213 c ecorr=ecorr+ekont*ees
7214 C Calculate multi-body contributions to the gradient.
7215 coeffpees0pij=coeffp*ees0pij
7216 coeffmees0mij=coeffm*ees0mij
7217 coeffpees0pkl=coeffp*ees0pkl
7218 coeffmees0mkl=coeffm*ees0mkl
7220 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7221 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7222 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7223 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7224 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7225 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7226 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7227 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7228 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7229 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7230 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7231 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7232 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7233 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7234 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7235 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7236 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7237 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7238 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7239 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7240 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7241 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7242 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7243 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7244 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7249 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7250 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7251 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7252 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7257 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7258 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7259 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7260 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7263 c write (iout,*) "ehbcorr",ekont*ees
7268 C---------------------------------------------------------------------------
7269 subroutine dipole(i,j,jj)
7270 implicit real*8 (a-h,o-z)
7271 include 'DIMENSIONS'
7272 include 'COMMON.IOUNITS'
7273 include 'COMMON.CHAIN'
7274 include 'COMMON.FFIELD'
7275 include 'COMMON.DERIV'
7276 include 'COMMON.INTERACT'
7277 include 'COMMON.CONTACTS'
7278 include 'COMMON.TORSION'
7279 include 'COMMON.VAR'
7280 include 'COMMON.GEO'
7281 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7283 iti1 = itortyp(itype(i+1))
7284 if (j.lt.nres-1) then
7285 itj1 = itortyp(itype(j+1))
7290 dipi(iii,1)=Ub2(iii,i)
7291 dipderi(iii)=Ub2der(iii,i)
7292 dipi(iii,2)=b1(iii,iti1)
7293 dipj(iii,1)=Ub2(iii,j)
7294 dipderj(iii)=Ub2der(iii,j)
7295 dipj(iii,2)=b1(iii,itj1)
7299 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7302 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7309 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7313 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7318 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7319 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7321 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7323 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7325 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7330 C---------------------------------------------------------------------------
7331 subroutine calc_eello(i,j,k,l,jj,kk)
7333 C This subroutine computes matrices and vectors needed to calculate
7334 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7336 implicit real*8 (a-h,o-z)
7337 include 'DIMENSIONS'
7338 include 'COMMON.IOUNITS'
7339 include 'COMMON.CHAIN'
7340 include 'COMMON.DERIV'
7341 include 'COMMON.INTERACT'
7342 include 'COMMON.CONTACTS'
7343 include 'COMMON.TORSION'
7344 include 'COMMON.VAR'
7345 include 'COMMON.GEO'
7346 include 'COMMON.FFIELD'
7347 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7348 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7351 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7352 cd & ' jj=',jj,' kk=',kk
7353 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7354 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7355 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7358 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7359 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7362 call transpose2(aa1(1,1),aa1t(1,1))
7363 call transpose2(aa2(1,1),aa2t(1,1))
7366 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7367 & aa1tder(1,1,lll,kkk))
7368 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7369 & aa2tder(1,1,lll,kkk))
7373 C parallel orientation of the two CA-CA-CA frames.
7375 iti=itortyp(itype(i))
7379 itk1=itortyp(itype(k+1))
7380 itj=itortyp(itype(j))
7381 if (l.lt.nres-1) then
7382 itl1=itortyp(itype(l+1))
7386 C A1 kernel(j+1) A2T
7388 cd write (iout,'(3f10.5,5x,3f10.5)')
7389 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7391 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7392 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7393 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7394 C Following matrices are needed only for 6-th order cumulants
7395 IF (wcorr6.gt.0.0d0) THEN
7396 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7397 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7398 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7399 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7400 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7401 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7402 & ADtEAderx(1,1,1,1,1,1))
7404 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7405 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7406 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7407 & ADtEA1derx(1,1,1,1,1,1))
7409 C End 6-th order cumulants
7412 cd write (2,*) 'In calc_eello6'
7414 cd write (2,*) 'iii=',iii
7416 cd write (2,*) 'kkk=',kkk
7418 cd write (2,'(3(2f10.5),5x)')
7419 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7424 call transpose2(EUgder(1,1,k),auxmat(1,1))
7425 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7426 call transpose2(EUg(1,1,k),auxmat(1,1))
7427 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7428 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7432 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7433 & EAEAderx(1,1,lll,kkk,iii,1))
7437 C A1T kernel(i+1) A2
7438 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7439 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7440 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7441 C Following matrices are needed only for 6-th order cumulants
7442 IF (wcorr6.gt.0.0d0) THEN
7443 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7444 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7445 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7446 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7447 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7448 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7449 & ADtEAderx(1,1,1,1,1,2))
7450 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7451 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7452 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7453 & ADtEA1derx(1,1,1,1,1,2))
7455 C End 6-th order cumulants
7456 call transpose2(EUgder(1,1,l),auxmat(1,1))
7457 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7458 call transpose2(EUg(1,1,l),auxmat(1,1))
7459 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7460 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7464 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7465 & EAEAderx(1,1,lll,kkk,iii,2))
7470 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7471 C They are needed only when the fifth- or the sixth-order cumulants are
7473 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7474 call transpose2(AEA(1,1,1),auxmat(1,1))
7475 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7476 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7477 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7478 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7479 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7480 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7481 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7482 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7483 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7484 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7485 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7486 call transpose2(AEA(1,1,2),auxmat(1,1))
7487 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7488 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7489 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7490 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7491 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7492 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7493 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7494 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7495 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7496 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7497 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7498 C Calculate the Cartesian derivatives of the vectors.
7502 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7503 call matvec2(auxmat(1,1),b1(1,iti),
7504 & AEAb1derx(1,lll,kkk,iii,1,1))
7505 call matvec2(auxmat(1,1),Ub2(1,i),
7506 & AEAb2derx(1,lll,kkk,iii,1,1))
7507 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7508 & AEAb1derx(1,lll,kkk,iii,2,1))
7509 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7510 & AEAb2derx(1,lll,kkk,iii,2,1))
7511 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7512 call matvec2(auxmat(1,1),b1(1,itj),
7513 & AEAb1derx(1,lll,kkk,iii,1,2))
7514 call matvec2(auxmat(1,1),Ub2(1,j),
7515 & AEAb2derx(1,lll,kkk,iii,1,2))
7516 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7517 & AEAb1derx(1,lll,kkk,iii,2,2))
7518 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7519 & AEAb2derx(1,lll,kkk,iii,2,2))
7526 C Antiparallel orientation of the two CA-CA-CA frames.
7528 iti=itortyp(itype(i))
7532 itk1=itortyp(itype(k+1))
7533 itl=itortyp(itype(l))
7534 itj=itortyp(itype(j))
7535 if (j.lt.nres-1) then
7536 itj1=itortyp(itype(j+1))
7540 C A2 kernel(j-1)T A1T
7541 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7542 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7543 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7544 C Following matrices are needed only for 6-th order cumulants
7545 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7546 & j.eq.i+4 .and. l.eq.i+3)) THEN
7547 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7548 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7549 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7550 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7551 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7552 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7553 & ADtEAderx(1,1,1,1,1,1))
7554 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7555 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7556 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7557 & ADtEA1derx(1,1,1,1,1,1))
7559 C End 6-th order cumulants
7560 call transpose2(EUgder(1,1,k),auxmat(1,1))
7561 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7562 call transpose2(EUg(1,1,k),auxmat(1,1))
7563 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7564 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7568 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7569 & EAEAderx(1,1,lll,kkk,iii,1))
7573 C A2T kernel(i+1)T A1
7574 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7575 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7576 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7577 C Following matrices are needed only for 6-th order cumulants
7578 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7579 & j.eq.i+4 .and. l.eq.i+3)) THEN
7580 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7581 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7582 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7583 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7584 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7585 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7586 & ADtEAderx(1,1,1,1,1,2))
7587 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7588 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7589 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7590 & ADtEA1derx(1,1,1,1,1,2))
7592 C End 6-th order cumulants
7593 call transpose2(EUgder(1,1,j),auxmat(1,1))
7594 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7595 call transpose2(EUg(1,1,j),auxmat(1,1))
7596 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7597 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7601 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7602 & EAEAderx(1,1,lll,kkk,iii,2))
7607 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7608 C They are needed only when the fifth- or the sixth-order cumulants are
7610 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7611 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7612 call transpose2(AEA(1,1,1),auxmat(1,1))
7613 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7614 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7615 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7616 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7617 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7618 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7619 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7620 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7621 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7622 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7623 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7624 call transpose2(AEA(1,1,2),auxmat(1,1))
7625 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7626 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7627 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7628 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7629 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7630 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7631 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7632 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7633 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7634 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7635 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7636 C Calculate the Cartesian derivatives of the vectors.
7640 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7641 call matvec2(auxmat(1,1),b1(1,iti),
7642 & AEAb1derx(1,lll,kkk,iii,1,1))
7643 call matvec2(auxmat(1,1),Ub2(1,i),
7644 & AEAb2derx(1,lll,kkk,iii,1,1))
7645 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7646 & AEAb1derx(1,lll,kkk,iii,2,1))
7647 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7648 & AEAb2derx(1,lll,kkk,iii,2,1))
7649 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7650 call matvec2(auxmat(1,1),b1(1,itl),
7651 & AEAb1derx(1,lll,kkk,iii,1,2))
7652 call matvec2(auxmat(1,1),Ub2(1,l),
7653 & AEAb2derx(1,lll,kkk,iii,1,2))
7654 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7655 & AEAb1derx(1,lll,kkk,iii,2,2))
7656 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7657 & AEAb2derx(1,lll,kkk,iii,2,2))
7666 C---------------------------------------------------------------------------
7667 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7668 & KK,KKderg,AKA,AKAderg,AKAderx)
7672 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7673 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7674 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7679 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7681 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7684 cd if (lprn) write (2,*) 'In kernel'
7686 cd if (lprn) write (2,*) 'kkk=',kkk
7688 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7689 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7691 cd write (2,*) 'lll=',lll
7692 cd write (2,*) 'iii=1'
7694 cd write (2,'(3(2f10.5),5x)')
7695 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7698 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7699 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7701 cd write (2,*) 'lll=',lll
7702 cd write (2,*) 'iii=2'
7704 cd write (2,'(3(2f10.5),5x)')
7705 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7712 C---------------------------------------------------------------------------
7713 double precision function eello4(i,j,k,l,jj,kk)
7714 implicit real*8 (a-h,o-z)
7715 include 'DIMENSIONS'
7716 include 'COMMON.IOUNITS'
7717 include 'COMMON.CHAIN'
7718 include 'COMMON.DERIV'
7719 include 'COMMON.INTERACT'
7720 include 'COMMON.CONTACTS'
7721 include 'COMMON.TORSION'
7722 include 'COMMON.VAR'
7723 include 'COMMON.GEO'
7724 double precision pizda(2,2),ggg1(3),ggg2(3)
7725 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7729 cd print *,'eello4:',i,j,k,l,jj,kk
7730 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7731 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7732 cold eij=facont_hb(jj,i)
7733 cold ekl=facont_hb(kk,k)
7735 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7736 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7737 gcorr_loc(k-1)=gcorr_loc(k-1)
7738 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7740 gcorr_loc(l-1)=gcorr_loc(l-1)
7741 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7743 gcorr_loc(j-1)=gcorr_loc(j-1)
7744 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7749 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7750 & -EAEAderx(2,2,lll,kkk,iii,1)
7751 cd derx(lll,kkk,iii)=0.0d0
7755 cd gcorr_loc(l-1)=0.0d0
7756 cd gcorr_loc(j-1)=0.0d0
7757 cd gcorr_loc(k-1)=0.0d0
7759 cd write (iout,*)'Contacts have occurred for peptide groups',
7760 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7761 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7762 if (j.lt.nres-1) then
7769 if (l.lt.nres-1) then
7777 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7778 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7779 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7780 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7781 cgrad ghalf=0.5d0*ggg1(ll)
7782 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7783 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7784 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7785 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7786 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7787 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7788 cgrad ghalf=0.5d0*ggg2(ll)
7789 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7790 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7791 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7792 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7793 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7794 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7798 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7803 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7808 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7813 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7817 cd write (2,*) iii,gcorr_loc(iii)
7820 cd write (2,*) 'ekont',ekont
7821 cd write (iout,*) 'eello4',ekont*eel4
7824 C---------------------------------------------------------------------------
7825 double precision function eello5(i,j,k,l,jj,kk)
7826 implicit real*8 (a-h,o-z)
7827 include 'DIMENSIONS'
7828 include 'COMMON.IOUNITS'
7829 include 'COMMON.CHAIN'
7830 include 'COMMON.DERIV'
7831 include 'COMMON.INTERACT'
7832 include 'COMMON.CONTACTS'
7833 include 'COMMON.TORSION'
7834 include 'COMMON.VAR'
7835 include 'COMMON.GEO'
7836 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7837 double precision ggg1(3),ggg2(3)
7838 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7843 C /l\ / \ \ / \ / \ / C
7844 C / \ / \ \ / \ / \ / C
7845 C j| o |l1 | o | o| o | | o |o C
7846 C \ |/k\| |/ \| / |/ \| |/ \| C
7847 C \i/ \ / \ / / \ / \ C
7849 C (I) (II) (III) (IV) C
7851 C eello5_1 eello5_2 eello5_3 eello5_4 C
7853 C Antiparallel chains C
7856 C /j\ / \ \ / \ / \ / C
7857 C / \ / \ \ / \ / \ / C
7858 C j1| o |l | o | o| o | | o |o C
7859 C \ |/k\| |/ \| / |/ \| |/ \| C
7860 C \i/ \ / \ / / \ / \ C
7862 C (I) (II) (III) (IV) C
7864 C eello5_1 eello5_2 eello5_3 eello5_4 C
7866 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7868 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7869 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7874 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7876 itk=itortyp(itype(k))
7877 itl=itortyp(itype(l))
7878 itj=itortyp(itype(j))
7883 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7884 cd & eel5_3_num,eel5_4_num)
7888 derx(lll,kkk,iii)=0.0d0
7892 cd eij=facont_hb(jj,i)
7893 cd ekl=facont_hb(kk,k)
7895 cd write (iout,*)'Contacts have occurred for peptide groups',
7896 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7898 C Contribution from the graph I.
7899 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7900 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7901 call transpose2(EUg(1,1,k),auxmat(1,1))
7902 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7903 vv(1)=pizda(1,1)-pizda(2,2)
7904 vv(2)=pizda(1,2)+pizda(2,1)
7905 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7906 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7907 C Explicit gradient in virtual-dihedral angles.
7908 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7909 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7910 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7911 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7912 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7913 vv(1)=pizda(1,1)-pizda(2,2)
7914 vv(2)=pizda(1,2)+pizda(2,1)
7915 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7916 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7917 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7918 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7919 vv(1)=pizda(1,1)-pizda(2,2)
7920 vv(2)=pizda(1,2)+pizda(2,1)
7922 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7923 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7924 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7926 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7927 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7928 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7930 C Cartesian gradient
7934 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7936 vv(1)=pizda(1,1)-pizda(2,2)
7937 vv(2)=pizda(1,2)+pizda(2,1)
7938 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7939 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7940 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7946 C Contribution from graph II
7947 call transpose2(EE(1,1,itk),auxmat(1,1))
7948 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7949 vv(1)=pizda(1,1)+pizda(2,2)
7950 vv(2)=pizda(2,1)-pizda(1,2)
7951 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7952 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7953 C Explicit gradient in virtual-dihedral angles.
7954 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7955 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7956 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7957 vv(1)=pizda(1,1)+pizda(2,2)
7958 vv(2)=pizda(2,1)-pizda(1,2)
7960 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7961 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7962 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7964 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7965 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7966 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7968 C Cartesian gradient
7972 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7974 vv(1)=pizda(1,1)+pizda(2,2)
7975 vv(2)=pizda(2,1)-pizda(1,2)
7976 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7977 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7978 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7986 C Parallel orientation
7987 C Contribution from graph III
7988 call transpose2(EUg(1,1,l),auxmat(1,1))
7989 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7990 vv(1)=pizda(1,1)-pizda(2,2)
7991 vv(2)=pizda(1,2)+pizda(2,1)
7992 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7993 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7994 C Explicit gradient in virtual-dihedral angles.
7995 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7996 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7997 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7998 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7999 vv(1)=pizda(1,1)-pizda(2,2)
8000 vv(2)=pizda(1,2)+pizda(2,1)
8001 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8002 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8003 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8004 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8005 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8006 vv(1)=pizda(1,1)-pizda(2,2)
8007 vv(2)=pizda(1,2)+pizda(2,1)
8008 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8009 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8010 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8011 C Cartesian gradient
8015 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8017 vv(1)=pizda(1,1)-pizda(2,2)
8018 vv(2)=pizda(1,2)+pizda(2,1)
8019 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8020 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8021 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8026 C Contribution from graph IV
8028 call transpose2(EE(1,1,itl),auxmat(1,1))
8029 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8030 vv(1)=pizda(1,1)+pizda(2,2)
8031 vv(2)=pizda(2,1)-pizda(1,2)
8032 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
8033 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8034 C Explicit gradient in virtual-dihedral angles.
8035 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8036 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8037 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8038 vv(1)=pizda(1,1)+pizda(2,2)
8039 vv(2)=pizda(2,1)-pizda(1,2)
8040 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8041 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
8042 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8043 C Cartesian gradient
8047 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8049 vv(1)=pizda(1,1)+pizda(2,2)
8050 vv(2)=pizda(2,1)-pizda(1,2)
8051 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8052 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
8053 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8058 C Antiparallel orientation
8059 C Contribution from graph III
8061 call transpose2(EUg(1,1,j),auxmat(1,1))
8062 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8063 vv(1)=pizda(1,1)-pizda(2,2)
8064 vv(2)=pizda(1,2)+pizda(2,1)
8065 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8066 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8067 C Explicit gradient in virtual-dihedral angles.
8068 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8069 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8070 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8071 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8072 vv(1)=pizda(1,1)-pizda(2,2)
8073 vv(2)=pizda(1,2)+pizda(2,1)
8074 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8075 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8076 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8077 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8078 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8079 vv(1)=pizda(1,1)-pizda(2,2)
8080 vv(2)=pizda(1,2)+pizda(2,1)
8081 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8082 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8083 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8084 C Cartesian gradient
8088 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8090 vv(1)=pizda(1,1)-pizda(2,2)
8091 vv(2)=pizda(1,2)+pizda(2,1)
8092 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8093 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8094 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8099 C Contribution from graph IV
8101 call transpose2(EE(1,1,itj),auxmat(1,1))
8102 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8103 vv(1)=pizda(1,1)+pizda(2,2)
8104 vv(2)=pizda(2,1)-pizda(1,2)
8105 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8106 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8107 C Explicit gradient in virtual-dihedral angles.
8108 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8109 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8110 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8111 vv(1)=pizda(1,1)+pizda(2,2)
8112 vv(2)=pizda(2,1)-pizda(1,2)
8113 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8114 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8115 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8116 C Cartesian gradient
8120 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8122 vv(1)=pizda(1,1)+pizda(2,2)
8123 vv(2)=pizda(2,1)-pizda(1,2)
8124 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8125 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8126 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8132 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8133 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8134 cd write (2,*) 'ijkl',i,j,k,l
8135 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8136 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8138 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8139 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8140 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8141 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8142 if (j.lt.nres-1) then
8149 if (l.lt.nres-1) then
8159 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8160 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8161 C summed up outside the subrouine as for the other subroutines
8162 C handling long-range interactions. The old code is commented out
8163 C with "cgrad" to keep track of changes.
8165 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8166 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8167 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8168 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8169 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8170 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8171 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8172 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8173 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8174 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8176 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8177 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8178 cgrad ghalf=0.5d0*ggg1(ll)
8180 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8181 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8182 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8183 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8184 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8185 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8186 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8187 cgrad ghalf=0.5d0*ggg2(ll)
8189 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8190 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8191 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8192 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8193 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8194 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8199 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8200 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8205 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8206 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8212 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8217 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8221 cd write (2,*) iii,g_corr5_loc(iii)
8224 cd write (2,*) 'ekont',ekont
8225 cd write (iout,*) 'eello5',ekont*eel5
8228 c--------------------------------------------------------------------------
8229 double precision function eello6(i,j,k,l,jj,kk)
8230 implicit real*8 (a-h,o-z)
8231 include 'DIMENSIONS'
8232 include 'COMMON.IOUNITS'
8233 include 'COMMON.CHAIN'
8234 include 'COMMON.DERIV'
8235 include 'COMMON.INTERACT'
8236 include 'COMMON.CONTACTS'
8237 include 'COMMON.TORSION'
8238 include 'COMMON.VAR'
8239 include 'COMMON.GEO'
8240 include 'COMMON.FFIELD'
8241 double precision ggg1(3),ggg2(3)
8242 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8247 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8255 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8256 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8260 derx(lll,kkk,iii)=0.0d0
8264 cd eij=facont_hb(jj,i)
8265 cd ekl=facont_hb(kk,k)
8271 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8272 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8273 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8274 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8275 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8276 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8278 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8279 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8280 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8281 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8282 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8283 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8287 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8289 C If turn contributions are considered, they will be handled separately.
8290 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8291 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8292 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8293 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8294 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8295 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8296 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8298 if (j.lt.nres-1) then
8305 if (l.lt.nres-1) then
8313 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8314 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8315 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8316 cgrad ghalf=0.5d0*ggg1(ll)
8318 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8319 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8320 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8321 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8322 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8323 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8324 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8325 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8326 cgrad ghalf=0.5d0*ggg2(ll)
8327 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8329 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8330 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8331 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8332 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8333 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8334 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8339 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8340 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8345 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8346 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8352 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8357 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8361 cd write (2,*) iii,g_corr6_loc(iii)
8364 cd write (2,*) 'ekont',ekont
8365 cd write (iout,*) 'eello6',ekont*eel6
8368 c--------------------------------------------------------------------------
8369 double precision function eello6_graph1(i,j,k,l,imat,swap)
8370 implicit real*8 (a-h,o-z)
8371 include 'DIMENSIONS'
8372 include 'COMMON.IOUNITS'
8373 include 'COMMON.CHAIN'
8374 include 'COMMON.DERIV'
8375 include 'COMMON.INTERACT'
8376 include 'COMMON.CONTACTS'
8377 include 'COMMON.TORSION'
8378 include 'COMMON.VAR'
8379 include 'COMMON.GEO'
8380 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8384 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8386 C Parallel Antiparallel
8392 C \ j|/k\| / \ |/k\|l /
8397 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8398 itk=itortyp(itype(k))
8399 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8400 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8401 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8402 call transpose2(EUgC(1,1,k),auxmat(1,1))
8403 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8404 vv1(1)=pizda1(1,1)-pizda1(2,2)
8405 vv1(2)=pizda1(1,2)+pizda1(2,1)
8406 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8407 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8408 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8409 s5=scalar2(vv(1),Dtobr2(1,i))
8410 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8411 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8412 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8413 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8414 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8415 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8416 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8417 & +scalar2(vv(1),Dtobr2der(1,i)))
8418 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8419 vv1(1)=pizda1(1,1)-pizda1(2,2)
8420 vv1(2)=pizda1(1,2)+pizda1(2,1)
8421 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8422 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8424 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8425 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8426 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8427 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8428 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8430 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8431 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8432 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8433 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8434 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8436 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8437 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8438 vv1(1)=pizda1(1,1)-pizda1(2,2)
8439 vv1(2)=pizda1(1,2)+pizda1(2,1)
8440 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8441 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8442 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8443 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8452 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8453 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8454 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8455 call transpose2(EUgC(1,1,k),auxmat(1,1))
8456 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8458 vv1(1)=pizda1(1,1)-pizda1(2,2)
8459 vv1(2)=pizda1(1,2)+pizda1(2,1)
8460 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8461 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8462 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8463 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8464 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8465 s5=scalar2(vv(1),Dtobr2(1,i))
8466 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8472 c----------------------------------------------------------------------------
8473 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8474 implicit real*8 (a-h,o-z)
8475 include 'DIMENSIONS'
8476 include 'COMMON.IOUNITS'
8477 include 'COMMON.CHAIN'
8478 include 'COMMON.DERIV'
8479 include 'COMMON.INTERACT'
8480 include 'COMMON.CONTACTS'
8481 include 'COMMON.TORSION'
8482 include 'COMMON.VAR'
8483 include 'COMMON.GEO'
8485 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8486 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8489 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8491 C Parallel Antiparallel C
8497 C \ j|/k\| \ |/k\|l C
8502 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8503 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8504 C AL 7/4/01 s1 would occur in the sixth-order moment,
8505 C but not in a cluster cumulant
8507 s1=dip(1,jj,i)*dip(1,kk,k)
8509 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8510 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8511 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8512 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8513 call transpose2(EUg(1,1,k),auxmat(1,1))
8514 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8515 vv(1)=pizda(1,1)-pizda(2,2)
8516 vv(2)=pizda(1,2)+pizda(2,1)
8517 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8518 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8520 eello6_graph2=-(s1+s2+s3+s4)
8522 eello6_graph2=-(s2+s3+s4)
8525 C Derivatives in gamma(i-1)
8528 s1=dipderg(1,jj,i)*dip(1,kk,k)
8530 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8531 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8532 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8533 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8535 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8537 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8539 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8541 C Derivatives in gamma(k-1)
8543 s1=dip(1,jj,i)*dipderg(1,kk,k)
8545 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8546 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8547 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8548 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8549 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8550 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8551 vv(1)=pizda(1,1)-pizda(2,2)
8552 vv(2)=pizda(1,2)+pizda(2,1)
8553 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8555 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8557 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8559 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8560 C Derivatives in gamma(j-1) or gamma(l-1)
8563 s1=dipderg(3,jj,i)*dip(1,kk,k)
8565 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8566 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8567 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8568 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8569 vv(1)=pizda(1,1)-pizda(2,2)
8570 vv(2)=pizda(1,2)+pizda(2,1)
8571 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8574 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8576 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8579 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8580 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8582 C Derivatives in gamma(l-1) or gamma(j-1)
8585 s1=dip(1,jj,i)*dipderg(3,kk,k)
8587 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8588 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8589 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8590 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8591 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8592 vv(1)=pizda(1,1)-pizda(2,2)
8593 vv(2)=pizda(1,2)+pizda(2,1)
8594 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8597 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8599 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8602 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8603 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8605 C Cartesian derivatives.
8607 write (2,*) 'In eello6_graph2'
8609 write (2,*) 'iii=',iii
8611 write (2,*) 'kkk=',kkk
8613 write (2,'(3(2f10.5),5x)')
8614 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8624 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8626 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8629 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8631 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8632 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8634 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8635 call transpose2(EUg(1,1,k),auxmat(1,1))
8636 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8638 vv(1)=pizda(1,1)-pizda(2,2)
8639 vv(2)=pizda(1,2)+pizda(2,1)
8640 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8641 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8643 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8645 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8648 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8650 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8657 c----------------------------------------------------------------------------
8658 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8659 implicit real*8 (a-h,o-z)
8660 include 'DIMENSIONS'
8661 include 'COMMON.IOUNITS'
8662 include 'COMMON.CHAIN'
8663 include 'COMMON.DERIV'
8664 include 'COMMON.INTERACT'
8665 include 'COMMON.CONTACTS'
8666 include 'COMMON.TORSION'
8667 include 'COMMON.VAR'
8668 include 'COMMON.GEO'
8669 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8671 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8673 C Parallel Antiparallel C
8679 C j|/k\| / |/k\|l / C
8684 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8686 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8687 C energy moment and not to the cluster cumulant.
8688 iti=itortyp(itype(i))
8689 if (j.lt.nres-1) then
8690 itj1=itortyp(itype(j+1))
8694 itk=itortyp(itype(k))
8695 itk1=itortyp(itype(k+1))
8696 if (l.lt.nres-1) then
8697 itl1=itortyp(itype(l+1))
8702 s1=dip(4,jj,i)*dip(4,kk,k)
8704 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8705 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8706 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8707 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8708 call transpose2(EE(1,1,itk),auxmat(1,1))
8709 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8710 vv(1)=pizda(1,1)+pizda(2,2)
8711 vv(2)=pizda(2,1)-pizda(1,2)
8712 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8713 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8714 cd & "sum",-(s2+s3+s4)
8716 eello6_graph3=-(s1+s2+s3+s4)
8718 eello6_graph3=-(s2+s3+s4)
8721 C Derivatives in gamma(k-1)
8722 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8723 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8724 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8725 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8726 C Derivatives in gamma(l-1)
8727 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8728 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8729 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8730 vv(1)=pizda(1,1)+pizda(2,2)
8731 vv(2)=pizda(2,1)-pizda(1,2)
8732 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8733 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8734 C Cartesian derivatives.
8740 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8742 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8745 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8747 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8748 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8750 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8751 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8753 vv(1)=pizda(1,1)+pizda(2,2)
8754 vv(2)=pizda(2,1)-pizda(1,2)
8755 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8757 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8759 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8762 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8764 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8766 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8772 c----------------------------------------------------------------------------
8773 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8774 implicit real*8 (a-h,o-z)
8775 include 'DIMENSIONS'
8776 include 'COMMON.IOUNITS'
8777 include 'COMMON.CHAIN'
8778 include 'COMMON.DERIV'
8779 include 'COMMON.INTERACT'
8780 include 'COMMON.CONTACTS'
8781 include 'COMMON.TORSION'
8782 include 'COMMON.VAR'
8783 include 'COMMON.GEO'
8784 include 'COMMON.FFIELD'
8785 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8786 & auxvec1(2),auxmat1(2,2)
8788 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8790 C Parallel Antiparallel C
8796 C \ j|/k\| \ |/k\|l C
8801 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8803 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8804 C energy moment and not to the cluster cumulant.
8805 cd write (2,*) 'eello_graph4: wturn6',wturn6
8806 iti=itortyp(itype(i))
8807 itj=itortyp(itype(j))
8808 if (j.lt.nres-1) then
8809 itj1=itortyp(itype(j+1))
8813 itk=itortyp(itype(k))
8814 if (k.lt.nres-1) then
8815 itk1=itortyp(itype(k+1))
8819 itl=itortyp(itype(l))
8820 if (l.lt.nres-1) then
8821 itl1=itortyp(itype(l+1))
8825 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8826 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8827 cd & ' itl',itl,' itl1',itl1
8830 s1=dip(3,jj,i)*dip(3,kk,k)
8832 s1=dip(2,jj,j)*dip(2,kk,l)
8835 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8836 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8838 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8839 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8841 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8842 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8844 call transpose2(EUg(1,1,k),auxmat(1,1))
8845 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8846 vv(1)=pizda(1,1)-pizda(2,2)
8847 vv(2)=pizda(2,1)+pizda(1,2)
8848 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8849 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8851 eello6_graph4=-(s1+s2+s3+s4)
8853 eello6_graph4=-(s2+s3+s4)
8855 C Derivatives in gamma(i-1)
8859 s1=dipderg(2,jj,i)*dip(3,kk,k)
8861 s1=dipderg(4,jj,j)*dip(2,kk,l)
8864 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8866 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8867 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8869 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8870 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8872 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8873 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8874 cd write (2,*) 'turn6 derivatives'
8876 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8878 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8882 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8884 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8888 C Derivatives in gamma(k-1)
8891 s1=dip(3,jj,i)*dipderg(2,kk,k)
8893 s1=dip(2,jj,j)*dipderg(4,kk,l)
8896 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8897 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8899 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8900 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8902 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8903 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8905 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8906 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8907 vv(1)=pizda(1,1)-pizda(2,2)
8908 vv(2)=pizda(2,1)+pizda(1,2)
8909 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8910 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8912 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8914 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8918 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8920 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8923 C Derivatives in gamma(j-1) or gamma(l-1)
8924 if (l.eq.j+1 .and. l.gt.1) then
8925 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8926 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8927 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8928 vv(1)=pizda(1,1)-pizda(2,2)
8929 vv(2)=pizda(2,1)+pizda(1,2)
8930 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8931 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8932 else if (j.gt.1) then
8933 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8934 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8935 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8936 vv(1)=pizda(1,1)-pizda(2,2)
8937 vv(2)=pizda(2,1)+pizda(1,2)
8938 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8939 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8940 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8942 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8945 C Cartesian derivatives.
8952 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8954 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8958 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8960 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8964 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8966 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8968 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8969 & b1(1,itj1),auxvec(1))
8970 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8972 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8973 & b1(1,itl1),auxvec(1))
8974 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8976 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8978 vv(1)=pizda(1,1)-pizda(2,2)
8979 vv(2)=pizda(2,1)+pizda(1,2)
8980 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8982 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8984 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8987 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8990 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8993 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8995 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8997 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9001 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9003 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9006 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9008 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9016 c----------------------------------------------------------------------------
9017 double precision function eello_turn6(i,jj,kk)
9018 implicit real*8 (a-h,o-z)
9019 include 'DIMENSIONS'
9020 include 'COMMON.IOUNITS'
9021 include 'COMMON.CHAIN'
9022 include 'COMMON.DERIV'
9023 include 'COMMON.INTERACT'
9024 include 'COMMON.CONTACTS'
9025 include 'COMMON.TORSION'
9026 include 'COMMON.VAR'
9027 include 'COMMON.GEO'
9028 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9029 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9031 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9032 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9033 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9034 C the respective energy moment and not to the cluster cumulant.
9043 iti=itortyp(itype(i))
9044 itk=itortyp(itype(k))
9045 itk1=itortyp(itype(k+1))
9046 itl=itortyp(itype(l))
9047 itj=itortyp(itype(j))
9048 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9049 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9050 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9055 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9057 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9061 derx_turn(lll,kkk,iii)=0.0d0
9068 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9070 cd write (2,*) 'eello6_5',eello6_5
9072 call transpose2(AEA(1,1,1),auxmat(1,1))
9073 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9074 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9075 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9077 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9078 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9079 s2 = scalar2(b1(1,itk),vtemp1(1))
9081 call transpose2(AEA(1,1,2),atemp(1,1))
9082 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9083 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9084 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9086 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9087 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9088 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9090 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9091 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9092 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9093 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9094 ss13 = scalar2(b1(1,itk),vtemp4(1))
9095 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9097 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9103 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9104 C Derivatives in gamma(i+2)
9108 call transpose2(AEA(1,1,1),auxmatd(1,1))
9109 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9110 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9111 call transpose2(AEAderg(1,1,2),atempd(1,1))
9112 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9113 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9115 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9116 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9117 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9123 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9124 C Derivatives in gamma(i+3)
9126 call transpose2(AEA(1,1,1),auxmatd(1,1))
9127 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9128 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9129 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9131 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9132 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9133 s2d = scalar2(b1(1,itk),vtemp1d(1))
9135 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9136 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9138 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9140 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9141 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9142 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9150 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9151 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9153 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9154 & -0.5d0*ekont*(s2d+s12d)
9156 C Derivatives in gamma(i+4)
9157 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9158 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9159 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9161 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9162 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9163 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9171 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9173 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9175 C Derivatives in gamma(i+5)
9177 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9178 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9179 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9181 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9182 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9183 s2d = scalar2(b1(1,itk),vtemp1d(1))
9185 call transpose2(AEA(1,1,2),atempd(1,1))
9186 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9187 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9189 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9190 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9192 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9193 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9194 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9202 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9203 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9205 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9206 & -0.5d0*ekont*(s2d+s12d)
9208 C Cartesian derivatives
9213 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9214 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9215 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9217 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9218 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9220 s2d = scalar2(b1(1,itk),vtemp1d(1))
9222 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9223 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9224 s8d = -(atempd(1,1)+atempd(2,2))*
9225 & scalar2(cc(1,1,itl),vtemp2(1))
9227 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9229 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9230 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9237 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9240 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9244 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9245 & - 0.5d0*(s8d+s12d)
9247 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9256 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9258 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9259 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9260 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9261 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9262 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9264 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9265 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9266 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9270 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9271 cd & 16*eel_turn6_num
9273 if (j.lt.nres-1) then
9280 if (l.lt.nres-1) then
9288 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9289 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9290 cgrad ghalf=0.5d0*ggg1(ll)
9292 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9293 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9294 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9295 & +ekont*derx_turn(ll,2,1)
9296 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9297 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9298 & +ekont*derx_turn(ll,4,1)
9299 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9300 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9301 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9302 cgrad ghalf=0.5d0*ggg2(ll)
9304 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9305 & +ekont*derx_turn(ll,2,2)
9306 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9307 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9308 & +ekont*derx_turn(ll,4,2)
9309 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9310 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9311 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9316 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9321 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9327 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9332 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9336 cd write (2,*) iii,g_corr6_loc(iii)
9338 eello_turn6=ekont*eel_turn6
9339 cd write (2,*) 'ekont',ekont
9340 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9344 C-----------------------------------------------------------------------------
9345 double precision function scalar(u,v)
9346 !DIR$ INLINEALWAYS scalar
9348 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9351 double precision u(3),v(3)
9352 cd double precision sc
9360 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9363 crc-------------------------------------------------
9364 SUBROUTINE MATVEC2(A1,V1,V2)
9365 !DIR$ INLINEALWAYS MATVEC2
9367 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9369 implicit real*8 (a-h,o-z)
9370 include 'DIMENSIONS'
9371 DIMENSION A1(2,2),V1(2),V2(2)
9375 c 3 VI=VI+A1(I,K)*V1(K)
9379 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9380 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9385 C---------------------------------------
9386 SUBROUTINE MATMAT2(A1,A2,A3)
9388 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9390 implicit real*8 (a-h,o-z)
9391 include 'DIMENSIONS'
9392 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9393 c DIMENSION AI3(2,2)
9397 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9403 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9404 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9405 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9406 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9414 c-------------------------------------------------------------------------
9415 double precision function scalar2(u,v)
9416 !DIR$ INLINEALWAYS scalar2
9418 double precision u(2),v(2)
9421 scalar2=u(1)*v(1)+u(2)*v(2)
9425 C-----------------------------------------------------------------------------
9427 subroutine transpose2(a,at)
9428 !DIR$ INLINEALWAYS transpose2
9430 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9433 double precision a(2,2),at(2,2)
9440 c--------------------------------------------------------------------------
9441 subroutine transpose(n,a,at)
9444 double precision a(n,n),at(n,n)
9452 C---------------------------------------------------------------------------
9453 subroutine prodmat3(a1,a2,kk,transp,prod)
9454 !DIR$ INLINEALWAYS prodmat3
9456 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9460 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9462 crc double precision auxmat(2,2),prod_(2,2)
9465 crc call transpose2(kk(1,1),auxmat(1,1))
9466 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9467 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9469 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9470 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9471 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9472 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9473 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9474 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9475 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9476 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9479 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9480 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9482 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9483 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9484 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9485 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9486 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9487 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9488 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9489 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9492 c call transpose2(a2(1,1),a2t(1,1))
9495 crc print *,((prod_(i,j),i=1,2),j=1,2)
9496 crc print *,((prod(i,j),i=1,2),j=1,2)