1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
30 if (nfgtasks.gt.1) then
32 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
33 if (fg_rank.eq.0) then
34 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
35 c print *,"Processor",myrank," BROADCAST iorder"
36 C FG master sets up the WEIGHTS_ array which will be broadcast to the
37 C FG slaves as WEIGHTS array.
57 C FG Master broadcasts the WEIGHTS_ array
58 call MPI_Bcast(weights_(1),n_ene,
59 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
61 C FG slaves receive the WEIGHTS array
62 call MPI_Bcast(weights(1),n_ene,
63 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
84 time_Bcast=time_Bcast+MPI_Wtime()-time00
85 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
86 c call chainbuild_cart
88 c print *,'Processor',myrank,' calling etotal ipot=',ipot
89 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
91 c if (modecalc.eq.12.or.modecalc.eq.14) then
92 c call int_from_cart1(.false.)
99 C Compute the side-chain and electrostatic interaction energy
101 goto (101,102,103,104,105,106) ipot
102 C Lennard-Jones potential.
104 cd print '(a)','Exit ELJ'
106 C Lennard-Jones-Kihara potential (shifted).
109 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 C Gay-Berne potential (shifted LJ, angular dependence).
115 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 C Soft-sphere potential
119 106 call e_softsphere(evdw)
121 C Calculate electrostatic (H-bonding) energy of the main chain.
125 cmc Sep-06: egb takes care of dynamic ss bonds too
127 C if (dyn_ss) call dyn_set_nss
128 c print *,"Processor",myrank," computed USCSC"
134 time_vec=time_vec+MPI_Wtime()-time01
136 c print *,"Processor",myrank," left VEC_AND_DERIV"
139 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
140 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
141 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
142 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
144 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
145 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
146 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
147 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
149 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
158 c write (iout,*) "Soft-spheer ELEC potential"
159 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
162 c print *,"Processor",myrank," computed UELEC"
164 C Calculate excluded-volume interaction energy between peptide groups
169 call escp(evdw2,evdw2_14)
175 c write (iout,*) "Soft-sphere SCP potential"
176 call escp_soft_sphere(evdw2,evdw2_14)
179 c Calculate the bond-stretching energy
183 C Calculate the disulfide-bridge and other energy and the contributions
184 C from other distance constraints.
185 cd print *,'Calling EHPB'
187 cd print *,'EHPB exitted succesfully.'
189 C Calculate the virtual-bond-angle energy.
191 if (wang.gt.0d0) then
196 c print *,"Processor",myrank," computed UB"
198 C Calculate the SC local energy.
201 c print *,"Processor",myrank," computed USC"
203 C Calculate the virtual-bond torsional energy.
205 cd print *,'nterm=',nterm
207 call etor(etors,edihcnstr)
212 c print *,"Processor",myrank," computed Utor"
214 C 6/23/01 Calculate double-torsional energy
216 if (wtor_d.gt.0) then
221 c print *,"Processor",myrank," computed Utord"
223 C 21/5/07 Calculate local sicdechain correlation energy
225 if (wsccor.gt.0.0d0) then
226 call eback_sc_corr(esccor)
230 c print *,"Processor",myrank," computed Usccorr"
232 C 12/1/95 Multi-body terms
236 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
237 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
238 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
239 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
240 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
247 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
248 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
249 cd write (iout,*) "multibody_hb ecorr",ecorr
251 c print *,"Processor",myrank," computed Ucorr"
253 C If performing constraint dynamics, call the constraint energy
254 C after the equilibration time
255 if(usampl.and.totT.gt.eq_time) then
263 time_enecalc=time_enecalc+MPI_Wtime()-time00
265 c print *,"Processor",myrank," computed Uconstr"
274 energia(2)=evdw2-evdw2_14
291 energia(8)=eello_turn3
292 energia(9)=eello_turn4
299 energia(19)=edihcnstr
301 energia(20)=Uconst+Uconst_back
303 c Here are the energies showed per procesor if the are more processors
304 c per molecule then we sum it up in sum_energy subroutine
305 c print *," Processor",myrank," calls SUM_ENERGY"
306 call sum_energy(energia,.true.)
307 if (dyn_ss) call dyn_set_nss
308 c print *," Processor",myrank," left SUM_ENERGY"
310 time_sumene=time_sumene+MPI_Wtime()-time00
314 c-------------------------------------------------------------------------------
315 subroutine sum_energy(energia,reduce)
316 implicit real*8 (a-h,o-z)
321 cMS$ATTRIBUTES C :: proc_proc
327 include 'COMMON.SETUP'
328 include 'COMMON.IOUNITS'
329 double precision energia(0:n_ene),enebuff(0:n_ene+1)
330 include 'COMMON.FFIELD'
331 include 'COMMON.DERIV'
332 include 'COMMON.INTERACT'
333 include 'COMMON.SBRIDGE'
334 include 'COMMON.CHAIN'
336 include 'COMMON.CONTROL'
337 include 'COMMON.TIME1'
340 if (nfgtasks.gt.1 .and. reduce) then
342 write (iout,*) "energies before REDUCE"
343 call enerprint(energia)
347 enebuff(i)=energia(i)
350 call MPI_Barrier(FG_COMM,IERR)
351 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
353 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
354 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
356 write (iout,*) "energies after REDUCE"
357 call enerprint(energia)
360 time_Reduce=time_Reduce+MPI_Wtime()-time00
362 if (fg_rank.eq.0) then
366 evdw2=energia(2)+energia(18)
382 eello_turn3=energia(8)
383 eello_turn4=energia(9)
390 edihcnstr=energia(19)
395 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
396 & +wang*ebe+wtor*etors+wscloc*escloc
397 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
398 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
399 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
400 & +wbond*estr+Uconst+wsccor*esccor
402 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
403 & +wang*ebe+wtor*etors+wscloc*escloc
404 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
405 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
406 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
407 & +wbond*estr+Uconst+wsccor*esccor
413 if (isnan(etot).ne.0) energia(0)=1.0d+99
415 if (isnan(etot)) energia(0)=1.0d+99
420 idumm=proc_proc(etot,i)
422 call proc_proc(etot,i)
424 if(i.eq.1)energia(0)=1.0d+99
431 c-------------------------------------------------------------------------------
432 subroutine sum_gradient
433 implicit real*8 (a-h,o-z)
438 cMS$ATTRIBUTES C :: proc_proc
443 double precision gradbufc(3,maxres),gradbufx(3,maxres),
444 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
446 include 'COMMON.SETUP'
447 include 'COMMON.IOUNITS'
448 include 'COMMON.FFIELD'
449 include 'COMMON.DERIV'
450 include 'COMMON.INTERACT'
451 include 'COMMON.SBRIDGE'
452 include 'COMMON.CHAIN'
454 include 'COMMON.CONTROL'
455 include 'COMMON.TIME1'
456 include 'COMMON.MAXGRAD'
457 include 'COMMON.SCCOR'
462 write (iout,*) "sum_gradient gvdwc, gvdwx"
464 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
465 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
470 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
471 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
472 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
475 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
476 C in virtual-bond-vector coordinates
479 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
481 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
482 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
484 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
486 c write (iout,'(i5,3f10.5,2x,f10.5)')
487 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
489 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
491 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
492 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
500 gradbufc(j,i)=wsc*gvdwc(j,i)+
501 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
502 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
503 & wel_loc*gel_loc_long(j,i)+
504 & wcorr*gradcorr_long(j,i)+
505 & wcorr5*gradcorr5_long(j,i)+
506 & wcorr6*gradcorr6_long(j,i)+
507 & wturn6*gcorr6_turn_long(j,i)+
514 gradbufc(j,i)=wsc*gvdwc(j,i)+
515 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
516 & welec*gelc_long(j,i)+
518 & wel_loc*gel_loc_long(j,i)+
519 & wcorr*gradcorr_long(j,i)+
520 & wcorr5*gradcorr5_long(j,i)+
521 & wcorr6*gradcorr6_long(j,i)+
522 & wturn6*gcorr6_turn_long(j,i)+
528 if (nfgtasks.gt.1) then
531 write (iout,*) "gradbufc before allreduce"
533 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
539 gradbufc_sum(j,i)=gradbufc(j,i)
542 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
543 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
544 c time_reduce=time_reduce+MPI_Wtime()-time00
546 c write (iout,*) "gradbufc_sum after allreduce"
548 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
553 c time_allreduce=time_allreduce+MPI_Wtime()-time00
561 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
562 write (iout,*) (i," jgrad_start",jgrad_start(i),
563 & " jgrad_end ",jgrad_end(i),
564 & i=igrad_start,igrad_end)
567 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
568 c do not parallelize this part.
570 c do i=igrad_start,igrad_end
571 c do j=jgrad_start(i),jgrad_end(i)
573 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
578 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
582 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
586 write (iout,*) "gradbufc after summing"
588 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
595 write (iout,*) "gradbufc"
597 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
603 gradbufc_sum(j,i)=gradbufc(j,i)
608 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
612 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
617 c gradbufc(k,i)=0.0d0
621 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
626 write (iout,*) "gradbufc after summing"
628 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
636 gradbufc(k,nres)=0.0d0
641 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
642 & wel_loc*gel_loc(j,i)+
643 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
644 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
645 & wel_loc*gel_loc_long(j,i)+
646 & wcorr*gradcorr_long(j,i)+
647 & wcorr5*gradcorr5_long(j,i)+
648 & wcorr6*gradcorr6_long(j,i)+
649 & wturn6*gcorr6_turn_long(j,i))+
651 & wcorr*gradcorr(j,i)+
652 & wturn3*gcorr3_turn(j,i)+
653 & wturn4*gcorr4_turn(j,i)+
654 & wcorr5*gradcorr5(j,i)+
655 & wcorr6*gradcorr6(j,i)+
656 & wturn6*gcorr6_turn(j,i)+
657 & wsccor*gsccorc(j,i)
658 & +wscloc*gscloc(j,i)
660 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
661 & wel_loc*gel_loc(j,i)+
662 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
663 & welec*gelc_long(j,i)
664 & wel_loc*gel_loc_long(j,i)+
665 & wcorr*gcorr_long(j,i)+
666 & wcorr5*gradcorr5_long(j,i)+
667 & wcorr6*gradcorr6_long(j,i)+
668 & wturn6*gcorr6_turn_long(j,i))+
670 & wcorr*gradcorr(j,i)+
671 & wturn3*gcorr3_turn(j,i)+
672 & wturn4*gcorr4_turn(j,i)+
673 & wcorr5*gradcorr5(j,i)+
674 & wcorr6*gradcorr6(j,i)+
675 & wturn6*gcorr6_turn(j,i)+
676 & wsccor*gsccorc(j,i)
677 & +wscloc*gscloc(j,i)
679 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
681 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
682 & wsccor*gsccorx(j,i)
683 & +wscloc*gsclocx(j,i)
687 write (iout,*) "gloc before adding corr"
689 write (iout,*) i,gloc(i,icg)
693 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
694 & +wcorr5*g_corr5_loc(i)
695 & +wcorr6*g_corr6_loc(i)
696 & +wturn4*gel_loc_turn4(i)
697 & +wturn3*gel_loc_turn3(i)
698 & +wturn6*gel_loc_turn6(i)
699 & +wel_loc*gel_loc_loc(i)
702 write (iout,*) "gloc after adding corr"
704 write (iout,*) i,gloc(i,icg)
708 if (nfgtasks.gt.1) then
711 gradbufc(j,i)=gradc(j,i,icg)
712 gradbufx(j,i)=gradx(j,i,icg)
716 glocbuf(i)=gloc(i,icg)
720 write (iout,*) "gloc_sc before reduce"
723 write (iout,*) i,j,gloc_sc(j,i,icg)
730 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
734 call MPI_Barrier(FG_COMM,IERR)
735 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
737 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
738 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
739 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
740 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
741 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
742 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
743 time_reduce=time_reduce+MPI_Wtime()-time00
744 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
745 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
746 time_reduce=time_reduce+MPI_Wtime()-time00
749 write (iout,*) "gloc_sc after reduce"
752 write (iout,*) i,j,gloc_sc(j,i,icg)
758 write (iout,*) "gloc after reduce"
760 write (iout,*) i,gloc(i,icg)
765 if (gnorm_check) then
767 c Compute the maximum elements of the gradient
777 gcorr3_turn_max=0.0d0
778 gcorr4_turn_max=0.0d0
781 gcorr6_turn_max=0.0d0
791 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
792 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
793 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
794 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
795 & gvdwc_scp_max=gvdwc_scp_norm
796 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
797 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
798 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
799 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
800 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
801 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
802 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
803 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
804 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
805 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
806 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
807 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
808 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
810 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
811 & gcorr3_turn_max=gcorr3_turn_norm
812 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
814 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
815 & gcorr4_turn_max=gcorr4_turn_norm
816 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
817 if (gradcorr5_norm.gt.gradcorr5_max)
818 & gradcorr5_max=gradcorr5_norm
819 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
820 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
821 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
823 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
824 & gcorr6_turn_max=gcorr6_turn_norm
825 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
826 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
827 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
828 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
829 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
830 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
831 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
832 if (gradx_scp_norm.gt.gradx_scp_max)
833 & gradx_scp_max=gradx_scp_norm
834 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
835 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
836 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
837 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
838 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
839 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
840 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
841 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
845 open(istat,file=statname,position="append")
847 open(istat,file=statname,access="append")
849 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
850 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
851 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
852 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
853 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
854 & gsccorx_max,gsclocx_max
856 if (gvdwc_max.gt.1.0d4) then
857 write (iout,*) "gvdwc gvdwx gradb gradbx"
859 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
860 & gradb(j,i),gradbx(j,i),j=1,3)
862 call pdbout(0.0d0,'cipiszcze',iout)
868 write (iout,*) "gradc gradx gloc"
870 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
871 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
875 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
879 c-------------------------------------------------------------------------------
880 subroutine rescale_weights(t_bath)
881 implicit real*8 (a-h,o-z)
883 include 'COMMON.IOUNITS'
884 include 'COMMON.FFIELD'
885 include 'COMMON.SBRIDGE'
886 double precision kfac /2.4d0/
887 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
889 c facT=2*temp0/(t_bath+temp0)
890 if (rescale_mode.eq.0) then
896 else if (rescale_mode.eq.1) then
897 facT=kfac/(kfac-1.0d0+t_bath/temp0)
898 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
899 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
900 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
901 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
902 else if (rescale_mode.eq.2) then
908 facT=licznik/dlog(dexp(x)+dexp(-x))
909 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
910 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
911 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
912 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
914 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
915 write (*,*) "Wrong RESCALE_MODE",rescale_mode
917 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
921 welec=weights(3)*fact
922 wcorr=weights(4)*fact3
923 wcorr5=weights(5)*fact4
924 wcorr6=weights(6)*fact5
925 wel_loc=weights(7)*fact2
926 wturn3=weights(8)*fact2
927 wturn4=weights(9)*fact3
928 wturn6=weights(10)*fact5
929 wtor=weights(13)*fact
930 wtor_d=weights(14)*fact2
931 wsccor=weights(21)*fact
935 C------------------------------------------------------------------------
936 subroutine enerprint(energia)
937 implicit real*8 (a-h,o-z)
939 include 'COMMON.IOUNITS'
940 include 'COMMON.FFIELD'
941 include 'COMMON.SBRIDGE'
943 double precision energia(0:n_ene)
948 evdw2=energia(2)+energia(18)
960 eello_turn3=energia(8)
961 eello_turn4=energia(9)
962 eello_turn6=energia(10)
968 edihcnstr=energia(19)
973 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
974 & estr,wbond,ebe,wang,
975 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
977 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
978 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
981 10 format (/'Virtual-chain energies:'//
982 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
983 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
984 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
985 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
986 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
987 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
988 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
989 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
990 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
991 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
992 & ' (SS bridges & dist. cnstr.)'/
993 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
994 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
995 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
996 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
997 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
998 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
999 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1000 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1001 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1002 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1003 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1004 & 'ETOT= ',1pE16.6,' (total)')
1006 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1007 & estr,wbond,ebe,wang,
1008 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1010 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1011 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1012 & ebr*nss,Uconst,etot
1013 10 format (/'Virtual-chain energies:'//
1014 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1015 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1016 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1017 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1018 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1019 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1020 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1021 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1022 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1023 & ' (SS bridges & dist. cnstr.)'/
1024 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1025 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1026 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1027 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1028 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1029 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1030 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1031 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1032 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1033 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1034 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1035 & 'ETOT= ',1pE16.6,' (total)')
1039 C-----------------------------------------------------------------------
1040 subroutine elj(evdw)
1042 C This subroutine calculates the interaction energy of nonbonded side chains
1043 C assuming the LJ potential of interaction.
1045 implicit real*8 (a-h,o-z)
1046 include 'DIMENSIONS'
1047 parameter (accur=1.0d-10)
1048 include 'COMMON.GEO'
1049 include 'COMMON.VAR'
1050 include 'COMMON.LOCAL'
1051 include 'COMMON.CHAIN'
1052 include 'COMMON.DERIV'
1053 include 'COMMON.INTERACT'
1054 include 'COMMON.TORSION'
1055 include 'COMMON.SBRIDGE'
1056 include 'COMMON.NAMES'
1057 include 'COMMON.IOUNITS'
1058 include 'COMMON.CONTACTS'
1060 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1062 do i=iatsc_s,iatsc_e
1063 itypi=iabs(itype(i))
1064 if (itypi.eq.ntyp1) cycle
1065 itypi1=iabs(itype(i+1))
1072 C Calculate SC interaction energy.
1074 do iint=1,nint_gr(i)
1075 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1076 cd & 'iend=',iend(i,iint)
1077 do j=istart(i,iint),iend(i,iint)
1078 itypj=iabs(itype(j))
1079 if (itypj.eq.ntyp1) cycle
1083 C Change 12/1/95 to calculate four-body interactions
1084 rij=xj*xj+yj*yj+zj*zj
1086 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1087 eps0ij=eps(itypi,itypj)
1089 e1=fac*fac*aa(itypi,itypj)
1090 e2=fac*bb(itypi,itypj)
1092 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1093 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1094 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1095 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1096 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1097 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1100 C Calculate the components of the gradient in DC and X
1102 fac=-rrij*(e1+evdwij)
1107 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1108 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1109 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1110 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1114 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1118 C 12/1/95, revised on 5/20/97
1120 C Calculate the contact function. The ith column of the array JCONT will
1121 C contain the numbers of atoms that make contacts with the atom I (of numbers
1122 C greater than I). The arrays FACONT and GACONT will contain the values of
1123 C the contact function and its derivative.
1125 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1126 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1127 C Uncomment next line, if the correlation interactions are contact function only
1128 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1130 sigij=sigma(itypi,itypj)
1131 r0ij=rs0(itypi,itypj)
1133 C Check whether the SC's are not too far to make a contact.
1136 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1137 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1139 if (fcont.gt.0.0D0) then
1140 C If the SC-SC distance if close to sigma, apply spline.
1141 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1142 cAdam & fcont1,fprimcont1)
1143 cAdam fcont1=1.0d0-fcont1
1144 cAdam if (fcont1.gt.0.0d0) then
1145 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1146 cAdam fcont=fcont*fcont1
1148 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1149 cga eps0ij=1.0d0/dsqrt(eps0ij)
1151 cga gg(k)=gg(k)*eps0ij
1153 cga eps0ij=-evdwij*eps0ij
1154 C Uncomment for AL's type of SC correlation interactions.
1155 cadam eps0ij=-evdwij
1156 num_conti=num_conti+1
1157 jcont(num_conti,i)=j
1158 facont(num_conti,i)=fcont*eps0ij
1159 fprimcont=eps0ij*fprimcont/rij
1161 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1162 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1163 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1164 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1165 gacont(1,num_conti,i)=-fprimcont*xj
1166 gacont(2,num_conti,i)=-fprimcont*yj
1167 gacont(3,num_conti,i)=-fprimcont*zj
1168 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1169 cd write (iout,'(2i3,3f10.5)')
1170 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1176 num_cont(i)=num_conti
1180 gvdwc(j,i)=expon*gvdwc(j,i)
1181 gvdwx(j,i)=expon*gvdwx(j,i)
1184 C******************************************************************************
1188 C To save time, the factor of EXPON has been extracted from ALL components
1189 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1192 C******************************************************************************
1195 C-----------------------------------------------------------------------------
1196 subroutine eljk(evdw)
1198 C This subroutine calculates the interaction energy of nonbonded side chains
1199 C assuming the LJK potential of interaction.
1201 implicit real*8 (a-h,o-z)
1202 include 'DIMENSIONS'
1203 include 'COMMON.GEO'
1204 include 'COMMON.VAR'
1205 include 'COMMON.LOCAL'
1206 include 'COMMON.CHAIN'
1207 include 'COMMON.DERIV'
1208 include 'COMMON.INTERACT'
1209 include 'COMMON.IOUNITS'
1210 include 'COMMON.NAMES'
1213 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1215 do i=iatsc_s,iatsc_e
1216 itypi=iabs(itype(i))
1217 if (itypi.eq.ntyp1) cycle
1218 itypi1=iabs(itype(i+1))
1223 C Calculate SC interaction energy.
1225 do iint=1,nint_gr(i)
1226 do j=istart(i,iint),iend(i,iint)
1227 itypj=iabs(itype(j))
1228 if (itypj.eq.ntyp1) cycle
1232 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1233 fac_augm=rrij**expon
1234 e_augm=augm(itypi,itypj)*fac_augm
1235 r_inv_ij=dsqrt(rrij)
1237 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1238 fac=r_shift_inv**expon
1239 e1=fac*fac*aa(itypi,itypj)
1240 e2=fac*bb(itypi,itypj)
1242 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1243 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1244 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1245 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1246 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1247 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1248 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1251 C Calculate the components of the gradient in DC and X
1253 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1258 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1259 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1260 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1261 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1265 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1273 gvdwc(j,i)=expon*gvdwc(j,i)
1274 gvdwx(j,i)=expon*gvdwx(j,i)
1279 C-----------------------------------------------------------------------------
1280 subroutine ebp(evdw)
1282 C This subroutine calculates the interaction energy of nonbonded side chains
1283 C assuming the Berne-Pechukas potential of interaction.
1285 implicit real*8 (a-h,o-z)
1286 include 'DIMENSIONS'
1287 include 'COMMON.GEO'
1288 include 'COMMON.VAR'
1289 include 'COMMON.LOCAL'
1290 include 'COMMON.CHAIN'
1291 include 'COMMON.DERIV'
1292 include 'COMMON.NAMES'
1293 include 'COMMON.INTERACT'
1294 include 'COMMON.IOUNITS'
1295 include 'COMMON.CALC'
1296 common /srutu/ icall
1297 c double precision rrsave(maxdim)
1300 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1302 c if (icall.eq.0) then
1308 do i=iatsc_s,iatsc_e
1309 itypi=iabs(itype(i))
1310 if (itypi.eq.ntyp1) cycle
1311 itypi1=iabs(itype(i+1))
1315 dxi=dc_norm(1,nres+i)
1316 dyi=dc_norm(2,nres+i)
1317 dzi=dc_norm(3,nres+i)
1318 c dsci_inv=dsc_inv(itypi)
1319 dsci_inv=vbld_inv(i+nres)
1321 C Calculate SC interaction energy.
1323 do iint=1,nint_gr(i)
1324 do j=istart(i,iint),iend(i,iint)
1326 itypj=iabs(itype(j))
1327 if (itypj.eq.ntyp1) cycle
1328 c dscj_inv=dsc_inv(itypj)
1329 dscj_inv=vbld_inv(j+nres)
1330 chi1=chi(itypi,itypj)
1331 chi2=chi(itypj,itypi)
1338 alf12=0.5D0*(alf1+alf2)
1339 C For diagnostics only!!!
1352 dxj=dc_norm(1,nres+j)
1353 dyj=dc_norm(2,nres+j)
1354 dzj=dc_norm(3,nres+j)
1355 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1356 cd if (icall.eq.0) then
1362 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1364 C Calculate whole angle-dependent part of epsilon and contributions
1365 C to its derivatives
1366 fac=(rrij*sigsq)**expon2
1367 e1=fac*fac*aa(itypi,itypj)
1368 e2=fac*bb(itypi,itypj)
1369 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1370 eps2der=evdwij*eps3rt
1371 eps3der=evdwij*eps2rt
1372 evdwij=evdwij*eps2rt*eps3rt
1375 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1376 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1377 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1378 cd & restyp(itypi),i,restyp(itypj),j,
1379 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1380 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1381 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1384 C Calculate gradient components.
1385 e1=e1*eps1*eps2rt**2*eps3rt**2
1386 fac=-expon*(e1+evdwij)
1389 C Calculate radial part of the gradient
1393 C Calculate the angular part of the gradient and sum add the contributions
1394 C to the appropriate components of the Cartesian gradient.
1402 C-----------------------------------------------------------------------------
1403 subroutine egb(evdw)
1405 C This subroutine calculates the interaction energy of nonbonded side chains
1406 C assuming the Gay-Berne potential of interaction.
1408 implicit real*8 (a-h,o-z)
1409 include 'DIMENSIONS'
1410 include 'COMMON.GEO'
1411 include 'COMMON.VAR'
1412 include 'COMMON.LOCAL'
1413 include 'COMMON.CHAIN'
1414 include 'COMMON.DERIV'
1415 include 'COMMON.NAMES'
1416 include 'COMMON.INTERACT'
1417 include 'COMMON.IOUNITS'
1418 include 'COMMON.CALC'
1419 include 'COMMON.CONTROL'
1420 include 'COMMON.SBRIDGE'
1423 ccccc energy_dec=.false.
1424 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1427 c if (icall.eq.0) lprn=.false.
1429 do i=iatsc_s,iatsc_e
1430 itypi=iabs(itype(i))
1431 if (itypi.eq.ntyp1) cycle
1432 itypi1=iabs(itype(i+1))
1436 dxi=dc_norm(1,nres+i)
1437 dyi=dc_norm(2,nres+i)
1438 dzi=dc_norm(3,nres+i)
1439 c dsci_inv=dsc_inv(itypi)
1440 dsci_inv=vbld_inv(i+nres)
1441 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1442 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1444 C Calculate SC interaction energy.
1446 do iint=1,nint_gr(i)
1447 do j=istart(i,iint),iend(i,iint)
1448 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1449 call dyn_ssbond_ene(i,j,evdwij)
1451 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1452 & 'evdw',i,j,evdwij,' ss'
1455 itypj=iabs(itype(j))
1456 if (itypj.eq.ntyp1) cycle
1457 c dscj_inv=dsc_inv(itypj)
1458 dscj_inv=vbld_inv(j+nres)
1459 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1460 c & 1.0d0/vbld(j+nres)
1461 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1462 sig0ij=sigma(itypi,itypj)
1463 chi1=chi(itypi,itypj)
1464 chi2=chi(itypj,itypi)
1471 alf12=0.5D0*(alf1+alf2)
1472 C For diagnostics only!!!
1485 dxj=dc_norm(1,nres+j)
1486 dyj=dc_norm(2,nres+j)
1487 dzj=dc_norm(3,nres+j)
1488 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1489 c write (iout,*) "j",j," dc_norm",
1490 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1491 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1493 C Calculate angle-dependent terms of energy and contributions to their
1497 sig=sig0ij*dsqrt(sigsq)
1498 rij_shift=1.0D0/rij-sig+sig0ij
1499 c for diagnostics; uncomment
1500 c rij_shift=1.2*sig0ij
1501 C I hate to put IF's in the loops, but here don't have another choice!!!!
1502 if (rij_shift.le.0.0D0) then
1504 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1505 cd & restyp(itypi),i,restyp(itypj),j,
1506 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1510 c---------------------------------------------------------------
1511 rij_shift=1.0D0/rij_shift
1512 fac=rij_shift**expon
1513 e1=fac*fac*aa(itypi,itypj)
1514 e2=fac*bb(itypi,itypj)
1515 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1516 eps2der=evdwij*eps3rt
1517 eps3der=evdwij*eps2rt
1518 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1519 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1520 evdwij=evdwij*eps2rt*eps3rt
1523 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1524 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1525 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1526 & restyp(itypi),i,restyp(itypj),j,
1527 & epsi,sigm,chi1,chi2,chip1,chip2,
1528 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1529 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1533 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1536 C Calculate gradient components.
1537 e1=e1*eps1*eps2rt**2*eps3rt**2
1538 fac=-expon*(e1+evdwij)*rij_shift
1542 C Calculate the radial part of the gradient
1546 C Calculate angular part of the gradient.
1552 c write (iout,*) "Number of loop steps in EGB:",ind
1553 cccc energy_dec=.false.
1556 C-----------------------------------------------------------------------------
1557 subroutine egbv(evdw)
1559 C This subroutine calculates the interaction energy of nonbonded side chains
1560 C assuming the Gay-Berne-Vorobjev potential of interaction.
1562 implicit real*8 (a-h,o-z)
1563 include 'DIMENSIONS'
1564 include 'COMMON.GEO'
1565 include 'COMMON.VAR'
1566 include 'COMMON.LOCAL'
1567 include 'COMMON.CHAIN'
1568 include 'COMMON.DERIV'
1569 include 'COMMON.NAMES'
1570 include 'COMMON.INTERACT'
1571 include 'COMMON.IOUNITS'
1572 include 'COMMON.CALC'
1573 common /srutu/ icall
1576 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1579 c if (icall.eq.0) lprn=.true.
1581 do i=iatsc_s,iatsc_e
1582 itypi=iabs(itype(i))
1583 if (itypi.eq.ntyp1) cycle
1584 itypi1=iabs(itype(i+1))
1588 dxi=dc_norm(1,nres+i)
1589 dyi=dc_norm(2,nres+i)
1590 dzi=dc_norm(3,nres+i)
1591 c dsci_inv=dsc_inv(itypi)
1592 dsci_inv=vbld_inv(i+nres)
1594 C Calculate SC interaction energy.
1596 do iint=1,nint_gr(i)
1597 do j=istart(i,iint),iend(i,iint)
1599 itypj=iabs(itype(j))
1600 if (itypj.eq.ntyp1) cycle
1601 c dscj_inv=dsc_inv(itypj)
1602 dscj_inv=vbld_inv(j+nres)
1603 sig0ij=sigma(itypi,itypj)
1604 r0ij=r0(itypi,itypj)
1605 chi1=chi(itypi,itypj)
1606 chi2=chi(itypj,itypi)
1613 alf12=0.5D0*(alf1+alf2)
1614 C For diagnostics only!!!
1627 dxj=dc_norm(1,nres+j)
1628 dyj=dc_norm(2,nres+j)
1629 dzj=dc_norm(3,nres+j)
1630 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1632 C Calculate angle-dependent terms of energy and contributions to their
1636 sig=sig0ij*dsqrt(sigsq)
1637 rij_shift=1.0D0/rij-sig+r0ij
1638 C I hate to put IF's in the loops, but here don't have another choice!!!!
1639 if (rij_shift.le.0.0D0) then
1644 c---------------------------------------------------------------
1645 rij_shift=1.0D0/rij_shift
1646 fac=rij_shift**expon
1647 e1=fac*fac*aa(itypi,itypj)
1648 e2=fac*bb(itypi,itypj)
1649 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1650 eps2der=evdwij*eps3rt
1651 eps3der=evdwij*eps2rt
1652 fac_augm=rrij**expon
1653 e_augm=augm(itypi,itypj)*fac_augm
1654 evdwij=evdwij*eps2rt*eps3rt
1655 evdw=evdw+evdwij+e_augm
1657 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1658 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1659 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1660 & restyp(itypi),i,restyp(itypj),j,
1661 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1662 & chi1,chi2,chip1,chip2,
1663 & eps1,eps2rt**2,eps3rt**2,
1664 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1667 C Calculate gradient components.
1668 e1=e1*eps1*eps2rt**2*eps3rt**2
1669 fac=-expon*(e1+evdwij)*rij_shift
1671 fac=rij*fac-2*expon*rrij*e_augm
1672 C Calculate the radial part of the gradient
1676 C Calculate angular part of the gradient.
1682 C-----------------------------------------------------------------------------
1683 subroutine sc_angular
1684 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1685 C om12. Called by ebp, egb, and egbv.
1687 include 'COMMON.CALC'
1688 include 'COMMON.IOUNITS'
1692 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1693 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1694 om12=dxi*dxj+dyi*dyj+dzi*dzj
1696 C Calculate eps1(om12) and its derivative in om12
1697 faceps1=1.0D0-om12*chiom12
1698 faceps1_inv=1.0D0/faceps1
1699 eps1=dsqrt(faceps1_inv)
1700 C Following variable is eps1*deps1/dom12
1701 eps1_om12=faceps1_inv*chiom12
1706 c write (iout,*) "om12",om12," eps1",eps1
1707 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1712 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1713 sigsq=1.0D0-facsig*faceps1_inv
1714 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1715 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1716 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1722 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1723 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1725 C Calculate eps2 and its derivatives in om1, om2, and om12.
1728 chipom12=chip12*om12
1729 facp=1.0D0-om12*chipom12
1731 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1732 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1733 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1734 C Following variable is the square root of eps2
1735 eps2rt=1.0D0-facp1*facp_inv
1736 C Following three variables are the derivatives of the square root of eps
1737 C in om1, om2, and om12.
1738 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1739 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1740 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1741 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1742 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1743 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1744 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1745 c & " eps2rt_om12",eps2rt_om12
1746 C Calculate whole angle-dependent part of epsilon and contributions
1747 C to its derivatives
1750 C----------------------------------------------------------------------------
1752 implicit real*8 (a-h,o-z)
1753 include 'DIMENSIONS'
1754 include 'COMMON.CHAIN'
1755 include 'COMMON.DERIV'
1756 include 'COMMON.CALC'
1757 include 'COMMON.IOUNITS'
1758 double precision dcosom1(3),dcosom2(3)
1759 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1760 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1761 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1762 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1766 c eom12=evdwij*eps1_om12
1768 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1769 c & " sigder",sigder
1770 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1771 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1773 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1774 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1777 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1779 c write (iout,*) "gg",(gg(k),k=1,3)
1781 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1782 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1783 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1784 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1785 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1786 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1787 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1788 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1789 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1790 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1793 C Calculate the components of the gradient in DC and X
1797 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1801 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1802 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1806 C-----------------------------------------------------------------------
1807 subroutine e_softsphere(evdw)
1809 C This subroutine calculates the interaction energy of nonbonded side chains
1810 C assuming the LJ potential of interaction.
1812 implicit real*8 (a-h,o-z)
1813 include 'DIMENSIONS'
1814 parameter (accur=1.0d-10)
1815 include 'COMMON.GEO'
1816 include 'COMMON.VAR'
1817 include 'COMMON.LOCAL'
1818 include 'COMMON.CHAIN'
1819 include 'COMMON.DERIV'
1820 include 'COMMON.INTERACT'
1821 include 'COMMON.TORSION'
1822 include 'COMMON.SBRIDGE'
1823 include 'COMMON.NAMES'
1824 include 'COMMON.IOUNITS'
1825 include 'COMMON.CONTACTS'
1827 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1829 do i=iatsc_s,iatsc_e
1830 itypi=iabs(itype(i))
1831 if (itypi.eq.ntyp1) cycle
1832 itypi1=iabs(itype(i+1))
1837 C Calculate SC interaction energy.
1839 do iint=1,nint_gr(i)
1840 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1841 cd & 'iend=',iend(i,iint)
1842 do j=istart(i,iint),iend(i,iint)
1843 itypj=iabs(itype(j))
1844 if (itypj.eq.ntyp1) cycle
1848 rij=xj*xj+yj*yj+zj*zj
1849 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1850 r0ij=r0(itypi,itypj)
1852 c print *,i,j,r0ij,dsqrt(rij)
1853 if (rij.lt.r0ijsq) then
1854 evdwij=0.25d0*(rij-r0ijsq)**2
1862 C Calculate the components of the gradient in DC and X
1868 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1869 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1870 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1871 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1875 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1883 C--------------------------------------------------------------------------
1884 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1887 C Soft-sphere potential of p-p interaction
1889 implicit real*8 (a-h,o-z)
1890 include 'DIMENSIONS'
1891 include 'COMMON.CONTROL'
1892 include 'COMMON.IOUNITS'
1893 include 'COMMON.GEO'
1894 include 'COMMON.VAR'
1895 include 'COMMON.LOCAL'
1896 include 'COMMON.CHAIN'
1897 include 'COMMON.DERIV'
1898 include 'COMMON.INTERACT'
1899 include 'COMMON.CONTACTS'
1900 include 'COMMON.TORSION'
1901 include 'COMMON.VECTORS'
1902 include 'COMMON.FFIELD'
1904 cd write(iout,*) 'In EELEC_soft_sphere'
1911 do i=iatel_s,iatel_e
1912 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1916 xmedi=c(1,i)+0.5d0*dxi
1917 ymedi=c(2,i)+0.5d0*dyi
1918 zmedi=c(3,i)+0.5d0*dzi
1920 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1921 do j=ielstart(i),ielend(i)
1922 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1926 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1927 r0ij=rpp(iteli,itelj)
1932 xj=c(1,j)+0.5D0*dxj-xmedi
1933 yj=c(2,j)+0.5D0*dyj-ymedi
1934 zj=c(3,j)+0.5D0*dzj-zmedi
1935 rij=xj*xj+yj*yj+zj*zj
1936 if (rij.lt.r0ijsq) then
1937 evdw1ij=0.25d0*(rij-r0ijsq)**2
1945 C Calculate contributions to the Cartesian gradient.
1951 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1952 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1955 * Loop over residues i+1 thru j-1.
1959 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1964 cgrad do i=nnt,nct-1
1966 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1968 cgrad do j=i+1,nct-1
1970 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
1976 c------------------------------------------------------------------------------
1977 subroutine vec_and_deriv
1978 implicit real*8 (a-h,o-z)
1979 include 'DIMENSIONS'
1983 include 'COMMON.IOUNITS'
1984 include 'COMMON.GEO'
1985 include 'COMMON.VAR'
1986 include 'COMMON.LOCAL'
1987 include 'COMMON.CHAIN'
1988 include 'COMMON.VECTORS'
1989 include 'COMMON.SETUP'
1990 include 'COMMON.TIME1'
1991 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1992 C Compute the local reference systems. For reference system (i), the
1993 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1994 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1996 do i=ivec_start,ivec_end
2000 if (i.eq.nres-1) then
2001 C Case of the last full residue
2002 C Compute the Z-axis
2003 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2004 costh=dcos(pi-theta(nres))
2005 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2009 C Compute the derivatives of uz
2011 uzder(2,1,1)=-dc_norm(3,i-1)
2012 uzder(3,1,1)= dc_norm(2,i-1)
2013 uzder(1,2,1)= dc_norm(3,i-1)
2015 uzder(3,2,1)=-dc_norm(1,i-1)
2016 uzder(1,3,1)=-dc_norm(2,i-1)
2017 uzder(2,3,1)= dc_norm(1,i-1)
2020 uzder(2,1,2)= dc_norm(3,i)
2021 uzder(3,1,2)=-dc_norm(2,i)
2022 uzder(1,2,2)=-dc_norm(3,i)
2024 uzder(3,2,2)= dc_norm(1,i)
2025 uzder(1,3,2)= dc_norm(2,i)
2026 uzder(2,3,2)=-dc_norm(1,i)
2028 C Compute the Y-axis
2031 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2033 C Compute the derivatives of uy
2036 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2037 & -dc_norm(k,i)*dc_norm(j,i-1)
2038 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2040 uyder(j,j,1)=uyder(j,j,1)-costh
2041 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2046 uygrad(l,k,j,i)=uyder(l,k,j)
2047 uzgrad(l,k,j,i)=uzder(l,k,j)
2051 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2052 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2053 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2054 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2057 C Compute the Z-axis
2058 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2059 costh=dcos(pi-theta(i+2))
2060 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2064 C Compute the derivatives of uz
2066 uzder(2,1,1)=-dc_norm(3,i+1)
2067 uzder(3,1,1)= dc_norm(2,i+1)
2068 uzder(1,2,1)= dc_norm(3,i+1)
2070 uzder(3,2,1)=-dc_norm(1,i+1)
2071 uzder(1,3,1)=-dc_norm(2,i+1)
2072 uzder(2,3,1)= dc_norm(1,i+1)
2075 uzder(2,1,2)= dc_norm(3,i)
2076 uzder(3,1,2)=-dc_norm(2,i)
2077 uzder(1,2,2)=-dc_norm(3,i)
2079 uzder(3,2,2)= dc_norm(1,i)
2080 uzder(1,3,2)= dc_norm(2,i)
2081 uzder(2,3,2)=-dc_norm(1,i)
2083 C Compute the Y-axis
2086 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2088 C Compute the derivatives of uy
2091 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2092 & -dc_norm(k,i)*dc_norm(j,i+1)
2093 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2095 uyder(j,j,1)=uyder(j,j,1)-costh
2096 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2101 uygrad(l,k,j,i)=uyder(l,k,j)
2102 uzgrad(l,k,j,i)=uzder(l,k,j)
2106 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2107 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2108 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2109 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2113 vbld_inv_temp(1)=vbld_inv(i+1)
2114 if (i.lt.nres-1) then
2115 vbld_inv_temp(2)=vbld_inv(i+2)
2117 vbld_inv_temp(2)=vbld_inv(i)
2122 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2123 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2128 #if defined(PARVEC) && defined(MPI)
2129 if (nfgtasks1.gt.1) then
2131 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2132 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2133 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2134 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2135 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2137 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2138 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2140 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2141 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2142 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2143 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2144 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2145 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2146 time_gather=time_gather+MPI_Wtime()-time00
2148 c if (fg_rank.eq.0) then
2149 c write (iout,*) "Arrays UY and UZ"
2151 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2158 C-----------------------------------------------------------------------------
2159 subroutine check_vecgrad
2160 implicit real*8 (a-h,o-z)
2161 include 'DIMENSIONS'
2162 include 'COMMON.IOUNITS'
2163 include 'COMMON.GEO'
2164 include 'COMMON.VAR'
2165 include 'COMMON.LOCAL'
2166 include 'COMMON.CHAIN'
2167 include 'COMMON.VECTORS'
2168 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2169 dimension uyt(3,maxres),uzt(3,maxres)
2170 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2171 double precision delta /1.0d-7/
2174 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2175 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2176 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2177 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2178 cd & (dc_norm(if90,i),if90=1,3)
2179 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2180 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2181 cd write(iout,'(a)')
2187 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2188 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2201 cd write (iout,*) 'i=',i
2203 erij(k)=dc_norm(k,i)
2207 dc_norm(k,i)=erij(k)
2209 dc_norm(j,i)=dc_norm(j,i)+delta
2210 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2212 c dc_norm(k,i)=dc_norm(k,i)/fac
2214 c write (iout,*) (dc_norm(k,i),k=1,3)
2215 c write (iout,*) (erij(k),k=1,3)
2218 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2219 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2220 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2221 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2223 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2224 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2225 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2228 dc_norm(k,i)=erij(k)
2231 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2232 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2233 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2234 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2235 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2236 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2237 cd write (iout,'(a)')
2242 C--------------------------------------------------------------------------
2243 subroutine set_matrices
2244 implicit real*8 (a-h,o-z)
2245 include 'DIMENSIONS'
2248 include "COMMON.SETUP"
2250 integer status(MPI_STATUS_SIZE)
2252 include 'COMMON.IOUNITS'
2253 include 'COMMON.GEO'
2254 include 'COMMON.VAR'
2255 include 'COMMON.LOCAL'
2256 include 'COMMON.CHAIN'
2257 include 'COMMON.DERIV'
2258 include 'COMMON.INTERACT'
2259 include 'COMMON.CONTACTS'
2260 include 'COMMON.TORSION'
2261 include 'COMMON.VECTORS'
2262 include 'COMMON.FFIELD'
2263 double precision auxvec(2),auxmat(2,2)
2265 C Compute the virtual-bond-torsional-angle dependent quantities needed
2266 C to calculate the el-loc multibody terms of various order.
2268 c write(iout,*) 'nphi=',nphi,nres
2270 do i=ivec_start+2,ivec_end+2
2275 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2276 iti = itortyp(itype(i-2))
2280 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2281 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2282 iti1 = itortyp(itype(i-1))
2287 b1(1,i-2)=bnew1(1,1,iti)*sin(theta(i-1)/2.0)
2288 & +bnew1(2,1,iti)*sin(theta(i-1))
2289 & +bnew1(3,1,iti)*cos(theta(i-1)/2.0)
2290 gtb1(1,i-2)=bnew1(1,1,iti)*cos(theta(i-1)/2.0)/2.0
2291 & +bnew1(2,1,iti)*cos(theta(i-1))
2292 & -bnew1(3,1,iti)*sin(theta(i-1)/2.0)/2.0
2293 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2294 c &*(cos(theta(i)/2.0)
2295 b2(1,i-2)=bnew2(1,1,iti)*sin(theta(i-1)/2.0)
2296 & +bnew2(2,1,iti)*sin(theta(i-1))
2297 & +bnew2(3,1,iti)*cos(theta(i-1)/2.0)
2298 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2299 c &*(cos(theta(i)/2.0)
2300 gtb2(1,i-2)=bnew2(1,1,iti)*cos(theta(i-1)/2.0)/2.0
2301 & +bnew2(2,1,iti)*cos(theta(i-1))
2302 & -bnew2(3,1,iti)*sin(theta(i-1)/2.0)/2.0
2303 c if (ggb1(1,i).eq.0.0d0) then
2304 c write(iout,*) 'i=',i,ggb1(1,i),
2305 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2306 c &bnew1(2,1,iti)*cos(theta(i)),
2307 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2309 b1(2,i-2)=bnew1(1,2,iti)
2311 b2(2,i-2)=bnew2(1,2,iti)
2313 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2314 EE(1,2,i-2)=eeold(1,2,iti)
2315 EE(2,1,i-2)=eeold(2,1,iti)
2316 EE(2,2,i-2)=eeold(2,2,iti)
2317 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2322 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2323 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2324 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2325 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2326 b1tilde(1,i-2)=b1(1,i-2)
2327 b1tilde(2,i-2)=-b1(2,i-2)
2328 b2tilde(1,i-2)=b2(1,i-2)
2329 b2tilde(2,i-2)=-b2(2,i-2)
2330 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2331 c write (iout,*) 'theta=', theta(i-1)
2334 do i=ivec_start+2,ivec_end+2
2339 if (i .lt. nres+1) then
2376 if (i .gt. 3 .and. i .lt. nres+1) then
2377 obrot_der(1,i-2)=-sin1
2378 obrot_der(2,i-2)= cos1
2379 Ugder(1,1,i-2)= sin1
2380 Ugder(1,2,i-2)=-cos1
2381 Ugder(2,1,i-2)=-cos1
2382 Ugder(2,2,i-2)=-sin1
2385 obrot2_der(1,i-2)=-dwasin2
2386 obrot2_der(2,i-2)= dwacos2
2387 Ug2der(1,1,i-2)= dwasin2
2388 Ug2der(1,2,i-2)=-dwacos2
2389 Ug2der(2,1,i-2)=-dwacos2
2390 Ug2der(2,2,i-2)=-dwasin2
2392 obrot_der(1,i-2)=0.0d0
2393 obrot_der(2,i-2)=0.0d0
2394 Ugder(1,1,i-2)=0.0d0
2395 Ugder(1,2,i-2)=0.0d0
2396 Ugder(2,1,i-2)=0.0d0
2397 Ugder(2,2,i-2)=0.0d0
2398 obrot2_der(1,i-2)=0.0d0
2399 obrot2_der(2,i-2)=0.0d0
2400 Ug2der(1,1,i-2)=0.0d0
2401 Ug2der(1,2,i-2)=0.0d0
2402 Ug2der(2,1,i-2)=0.0d0
2403 Ug2der(2,2,i-2)=0.0d0
2405 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2406 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2407 iti = itortyp(itype(i-2))
2411 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2412 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2413 iti1 = itortyp(itype(i-1))
2417 cd write (iout,*) '*******i',i,' iti1',iti
2418 cd write (iout,*) 'b1',b1(:,iti)
2419 cd write (iout,*) 'b2',b2(:,iti)
2420 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2421 c if (i .gt. iatel_s+2) then
2422 if (i .gt. nnt+2) then
2423 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2425 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2426 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2428 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2429 c & EE(1,2,iti),EE(2,2,iti)
2430 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2431 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2432 c write(iout,*) "Macierz EUG",
2433 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2435 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2437 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2438 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2439 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2440 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2441 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2452 DtUg2(l,k,i-2)=0.0d0
2456 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2457 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2459 muder(k,i-2)=Ub2der(k,i-2)
2461 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2462 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2463 if (itype(i-1).le.ntyp) then
2464 iti1 = itortyp(itype(i-1))
2472 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2475 write (iout,'(2hmu,i3,3f8.1,7f10.5)') i-2,rad2deg*theta(i-1),
2476 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
2477 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
2478 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
2479 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2)
2481 cd write (iout,*) 'mu ',mu(:,i-2)
2482 cd write (iout,*) 'mu1',mu1(:,i-2)
2483 cd write (iout,*) 'mu2',mu2(:,i-2)
2484 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2486 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2487 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2488 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2489 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2490 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2491 C Vectors and matrices dependent on a single virtual-bond dihedral.
2492 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2493 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2494 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2495 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2496 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2497 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2498 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2499 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2500 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2503 C Matrices dependent on two consecutive virtual-bond dihedrals.
2504 C The order of matrices is from left to right.
2505 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2507 c do i=max0(ivec_start,2),ivec_end
2509 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2510 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2511 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2512 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2513 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2514 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2515 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2516 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2519 #if defined(MPI) && defined(PARMAT)
2521 c if (fg_rank.eq.0) then
2522 write (iout,*) "Arrays UG and UGDER before GATHER"
2524 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2525 & ((ug(l,k,i),l=1,2),k=1,2),
2526 & ((ugder(l,k,i),l=1,2),k=1,2)
2528 write (iout,*) "Arrays UG2 and UG2DER"
2530 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2531 & ((ug2(l,k,i),l=1,2),k=1,2),
2532 & ((ug2der(l,k,i),l=1,2),k=1,2)
2534 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2536 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2537 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2538 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2540 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2542 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2543 & costab(i),sintab(i),costab2(i),sintab2(i)
2545 write (iout,*) "Array MUDER"
2547 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2551 if (nfgtasks.gt.1) then
2553 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2554 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2555 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2557 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2558 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2560 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2561 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2563 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2564 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2566 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2567 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2569 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2570 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2572 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2573 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2575 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2576 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2577 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2578 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2579 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2580 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2581 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2582 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2583 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2584 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2585 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2586 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2587 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2589 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2590 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2592 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2593 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2595 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2596 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2598 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2599 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2601 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2602 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2604 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2605 & ivec_count(fg_rank1),
2606 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2608 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2609 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2611 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2612 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2614 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2615 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2617 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2618 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2620 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2621 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2623 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2624 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2626 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2627 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2629 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2630 & ivec_count(fg_rank1),
2631 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2633 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2634 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2636 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2637 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2639 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2640 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2642 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2643 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2645 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2646 & ivec_count(fg_rank1),
2647 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2649 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2650 & ivec_count(fg_rank1),
2651 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2653 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2654 & ivec_count(fg_rank1),
2655 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2656 & MPI_MAT2,FG_COMM1,IERR)
2657 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2658 & ivec_count(fg_rank1),
2659 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2660 & MPI_MAT2,FG_COMM1,IERR)
2663 c Passes matrix info through the ring
2666 if (irecv.lt.0) irecv=nfgtasks1-1
2669 if (inext.ge.nfgtasks1) inext=0
2671 c write (iout,*) "isend",isend," irecv",irecv
2673 lensend=lentyp(isend)
2674 lenrecv=lentyp(irecv)
2675 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2676 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2677 c & MPI_ROTAT1(lensend),inext,2200+isend,
2678 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2679 c & iprev,2200+irecv,FG_COMM,status,IERR)
2680 c write (iout,*) "Gather ROTAT1"
2682 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2683 c & MPI_ROTAT2(lensend),inext,3300+isend,
2684 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2685 c & iprev,3300+irecv,FG_COMM,status,IERR)
2686 c write (iout,*) "Gather ROTAT2"
2688 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2689 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2690 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2691 & iprev,4400+irecv,FG_COMM,status,IERR)
2692 c write (iout,*) "Gather ROTAT_OLD"
2694 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2695 & MPI_PRECOMP11(lensend),inext,5500+isend,
2696 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2697 & iprev,5500+irecv,FG_COMM,status,IERR)
2698 c write (iout,*) "Gather PRECOMP11"
2700 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2701 & MPI_PRECOMP12(lensend),inext,6600+isend,
2702 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2703 & iprev,6600+irecv,FG_COMM,status,IERR)
2704 c write (iout,*) "Gather PRECOMP12"
2706 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2708 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2709 & MPI_ROTAT2(lensend),inext,7700+isend,
2710 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2711 & iprev,7700+irecv,FG_COMM,status,IERR)
2712 c write (iout,*) "Gather PRECOMP21"
2714 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2715 & MPI_PRECOMP22(lensend),inext,8800+isend,
2716 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2717 & iprev,8800+irecv,FG_COMM,status,IERR)
2718 c write (iout,*) "Gather PRECOMP22"
2720 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2721 & MPI_PRECOMP23(lensend),inext,9900+isend,
2722 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2723 & MPI_PRECOMP23(lenrecv),
2724 & iprev,9900+irecv,FG_COMM,status,IERR)
2725 c write (iout,*) "Gather PRECOMP23"
2730 if (irecv.lt.0) irecv=nfgtasks1-1
2733 time_gather=time_gather+MPI_Wtime()-time00
2736 c if (fg_rank.eq.0) then
2737 write (iout,*) "Arrays UG and UGDER"
2739 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2740 & ((ug(l,k,i),l=1,2),k=1,2),
2741 & ((ugder(l,k,i),l=1,2),k=1,2)
2743 write (iout,*) "Arrays UG2 and UG2DER"
2745 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2746 & ((ug2(l,k,i),l=1,2),k=1,2),
2747 & ((ug2der(l,k,i),l=1,2),k=1,2)
2749 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2751 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2752 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2753 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2755 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2757 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2758 & costab(i),sintab(i),costab2(i),sintab2(i)
2760 write (iout,*) "Array MUDER"
2762 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2768 cd iti = itortyp(itype(i))
2771 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2772 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2777 C--------------------------------------------------------------------------
2778 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2780 C This subroutine calculates the average interaction energy and its gradient
2781 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2782 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2783 C The potential depends both on the distance of peptide-group centers and on
2784 C the orientation of the CA-CA virtual bonds.
2786 implicit real*8 (a-h,o-z)
2790 include 'DIMENSIONS'
2791 include 'COMMON.CONTROL'
2792 include 'COMMON.SETUP'
2793 include 'COMMON.IOUNITS'
2794 include 'COMMON.GEO'
2795 include 'COMMON.VAR'
2796 include 'COMMON.LOCAL'
2797 include 'COMMON.CHAIN'
2798 include 'COMMON.DERIV'
2799 include 'COMMON.INTERACT'
2800 include 'COMMON.CONTACTS'
2801 include 'COMMON.TORSION'
2802 include 'COMMON.VECTORS'
2803 include 'COMMON.FFIELD'
2804 include 'COMMON.TIME1'
2805 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2806 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2807 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2808 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2809 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2810 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2812 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2814 double precision scal_el /1.0d0/
2816 double precision scal_el /0.5d0/
2819 C 13-go grudnia roku pamietnego...
2820 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2821 & 0.0d0,1.0d0,0.0d0,
2822 & 0.0d0,0.0d0,1.0d0/
2823 cd write(iout,*) 'In EELEC'
2825 cd write(iout,*) 'Type',i
2826 cd write(iout,*) 'B1',B1(:,i)
2827 cd write(iout,*) 'B2',B2(:,i)
2828 cd write(iout,*) 'CC',CC(:,:,i)
2829 cd write(iout,*) 'DD',DD(:,:,i)
2830 cd write(iout,*) 'EE',EE(:,:,i)
2832 cd call check_vecgrad
2834 if (icheckgrad.eq.1) then
2836 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2838 dc_norm(k,i)=dc(k,i)*fac
2840 c write (iout,*) 'i',i,' fac',fac
2843 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2844 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2845 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2846 c call vec_and_deriv
2852 time_mat=time_mat+MPI_Wtime()-time01
2856 cd write (iout,*) 'i=',i
2858 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2861 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2862 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2875 cd print '(a)','Enter EELEC'
2876 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2878 gel_loc_loc(i)=0.0d0
2883 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2885 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2887 do i=iturn3_start,iturn3_end
2888 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2889 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2893 dx_normi=dc_norm(1,i)
2894 dy_normi=dc_norm(2,i)
2895 dz_normi=dc_norm(3,i)
2896 xmedi=c(1,i)+0.5d0*dxi
2897 ymedi=c(2,i)+0.5d0*dyi
2898 zmedi=c(3,i)+0.5d0*dzi
2900 call eelecij(i,i+2,ees,evdw1,eel_loc)
2901 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2902 num_cont_hb(i)=num_conti
2904 do i=iturn4_start,iturn4_end
2905 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2906 & .or. itype(i+3).eq.ntyp1
2907 & .or. itype(i+4).eq.ntyp1) cycle
2911 dx_normi=dc_norm(1,i)
2912 dy_normi=dc_norm(2,i)
2913 dz_normi=dc_norm(3,i)
2914 xmedi=c(1,i)+0.5d0*dxi
2915 ymedi=c(2,i)+0.5d0*dyi
2916 zmedi=c(3,i)+0.5d0*dzi
2917 num_conti=num_cont_hb(i)
2918 c write(iout,*) "JESTEM W PETLI"
2919 call eelecij(i,i+3,ees,evdw1,eel_loc)
2920 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2921 & call eturn4(i,eello_turn4)
2922 num_cont_hb(i)=num_conti
2925 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2927 do i=iatel_s,iatel_e
2929 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2933 dx_normi=dc_norm(1,i)
2934 dy_normi=dc_norm(2,i)
2935 dz_normi=dc_norm(3,i)
2936 xmedi=c(1,i)+0.5d0*dxi
2937 ymedi=c(2,i)+0.5d0*dyi
2938 zmedi=c(3,i)+0.5d0*dzi
2939 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2940 num_conti=num_cont_hb(i)
2941 do j=ielstart(i),ielend(i)
2943 c write (iout,*) 'tu wchodze',i,j,itype(i),itype(j)
2944 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2945 call eelecij(i,j,ees,evdw1,eel_loc)
2947 num_cont_hb(i)=num_conti
2949 c write (iout,*) "Number of loop steps in EELEC:",ind
2951 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2952 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2954 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2955 ccc eel_loc=eel_loc+eello_turn3
2956 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2959 C-------------------------------------------------------------------------------
2960 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2961 implicit real*8 (a-h,o-z)
2962 include 'DIMENSIONS'
2966 include 'COMMON.CONTROL'
2967 include 'COMMON.IOUNITS'
2968 include 'COMMON.GEO'
2969 include 'COMMON.VAR'
2970 include 'COMMON.LOCAL'
2971 include 'COMMON.CHAIN'
2972 include 'COMMON.DERIV'
2973 include 'COMMON.INTERACT'
2974 include 'COMMON.CONTACTS'
2975 include 'COMMON.TORSION'
2976 include 'COMMON.VECTORS'
2977 include 'COMMON.FFIELD'
2978 include 'COMMON.TIME1'
2979 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2980 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2981 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2982 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2983 & gmuij2(4),gmuji2(4)
2984 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2985 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2987 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2989 double precision scal_el /1.0d0/
2991 double precision scal_el /0.5d0/
2994 C 13-go grudnia roku pamietnego...
2995 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2996 & 0.0d0,1.0d0,0.0d0,
2997 & 0.0d0,0.0d0,1.0d0/
2998 c time00=MPI_Wtime()
2999 cd write (iout,*) "eelecij",i,j
3003 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3004 aaa=app(iteli,itelj)
3005 bbb=bpp(iteli,itelj)
3006 ael6i=ael6(iteli,itelj)
3007 ael3i=ael3(iteli,itelj)
3011 dx_normj=dc_norm(1,j)
3012 dy_normj=dc_norm(2,j)
3013 dz_normj=dc_norm(3,j)
3014 xj=c(1,j)+0.5D0*dxj-xmedi
3015 yj=c(2,j)+0.5D0*dyj-ymedi
3016 zj=c(3,j)+0.5D0*dzj-zmedi
3017 rij=xj*xj+yj*yj+zj*zj
3023 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3024 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3025 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3026 fac=cosa-3.0D0*cosb*cosg
3028 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3029 if (j.eq.i+2) ev1=scal_el*ev1
3034 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3037 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3038 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3041 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3042 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3043 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3044 cd & xmedi,ymedi,zmedi,xj,yj,zj
3046 if (energy_dec) then
3047 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3049 &,iteli,itelj,aaa,evdw1
3050 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3054 C Calculate contributions to the Cartesian gradient.
3057 facvdw=-6*rrmij*(ev1+evdwij)
3058 facel=-3*rrmij*(el1+eesij)
3064 * Radial derivatives. First process both termini of the fragment (i,j)
3070 c ghalf=0.5D0*ggg(k)
3071 c gelc(k,i)=gelc(k,i)+ghalf
3072 c gelc(k,j)=gelc(k,j)+ghalf
3074 c 9/28/08 AL Gradient compotents will be summed only at the end
3076 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3077 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3080 * Loop over residues i+1 thru j-1.
3084 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3091 c ghalf=0.5D0*ggg(k)
3092 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3093 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3095 c 9/28/08 AL Gradient compotents will be summed only at the end
3097 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3098 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3101 * Loop over residues i+1 thru j-1.
3105 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3112 fac=-3*rrmij*(facvdw+facvdw+facel)
3117 * Radial derivatives. First process both termini of the fragment (i,j)
3123 c ghalf=0.5D0*ggg(k)
3124 c gelc(k,i)=gelc(k,i)+ghalf
3125 c gelc(k,j)=gelc(k,j)+ghalf
3127 c 9/28/08 AL Gradient compotents will be summed only at the end
3129 gelc_long(k,j)=gelc(k,j)+ggg(k)
3130 gelc_long(k,i)=gelc(k,i)-ggg(k)
3133 * Loop over residues i+1 thru j-1.
3137 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3140 c 9/28/08 AL Gradient compotents will be summed only at the end
3145 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3146 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3152 ecosa=2.0D0*fac3*fac1+fac4
3155 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3156 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3158 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3159 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3161 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3162 cd & (dcosg(k),k=1,3)
3164 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3167 c ghalf=0.5D0*ggg(k)
3168 c gelc(k,i)=gelc(k,i)+ghalf
3169 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3170 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3171 c gelc(k,j)=gelc(k,j)+ghalf
3172 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3173 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3177 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3182 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3183 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3185 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3186 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3187 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3188 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3190 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3191 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3192 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3194 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3195 C energy of a peptide unit is assumed in the form of a second-order
3196 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3197 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3198 C are computed for EVERY pair of non-contiguous peptide groups.
3201 if (j.lt.nres-1) then
3213 muij(kkk)=mu(k,i)*mu(l,j)
3215 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3216 c write(iout,*) 'kkk=', gtb1(k,i)*mu(l,j),gtb1(k,i),k,i
3217 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3218 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3219 c write(iout,*) 'kkk=', gtb1(k,i)*mu(l,j),gtb1(l,j),l,j
3220 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3224 cd write (iout,*) 'EELEC: i',i,' j',j
3225 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3226 cd write(iout,*) 'muij',muij
3227 ury=scalar(uy(1,i),erij)
3228 urz=scalar(uz(1,i),erij)
3229 vry=scalar(uy(1,j),erij)
3230 vrz=scalar(uz(1,j),erij)
3231 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3232 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3233 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3234 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3235 fac=dsqrt(-ael6i)*r3ij
3240 cd write (iout,'(4i5,4f10.5)')
3241 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3242 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3243 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3244 cd & uy(:,j),uz(:,j)
3245 cd write (iout,'(4f10.5)')
3246 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3247 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3248 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3249 cd write (iout,'(9f10.5/)')
3250 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3251 C Derivatives of the elements of A in virtual-bond vectors
3252 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3254 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3255 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3256 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3257 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3258 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3259 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3260 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3261 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3262 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3263 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3264 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3265 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3267 C Compute radial contributions to the gradient
3285 C Add the contributions coming from er
3288 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3289 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3290 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3291 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3294 C Derivatives in DC(i)
3295 cgrad ghalf1=0.5d0*agg(k,1)
3296 cgrad ghalf2=0.5d0*agg(k,2)
3297 cgrad ghalf3=0.5d0*agg(k,3)
3298 cgrad ghalf4=0.5d0*agg(k,4)
3299 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3300 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3301 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3302 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3303 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3304 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3305 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3306 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3307 C Derivatives in DC(i+1)
3308 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3309 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3310 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3311 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3312 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3313 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3314 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3315 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3316 C Derivatives in DC(j)
3317 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3318 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3319 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3320 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3321 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3322 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3323 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3324 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3325 C Derivatives in DC(j+1) or DC(nres-1)
3326 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3327 & -3.0d0*vryg(k,3)*ury)
3328 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3329 & -3.0d0*vrzg(k,3)*ury)
3330 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3331 & -3.0d0*vryg(k,3)*urz)
3332 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3333 & -3.0d0*vrzg(k,3)*urz)
3334 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3336 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3349 aggi(k,l)=-aggi(k,l)
3350 aggi1(k,l)=-aggi1(k,l)
3351 aggj(k,l)=-aggj(k,l)
3352 aggj1(k,l)=-aggj1(k,l)
3355 if (j.lt.nres-1) then
3361 aggi(k,l)=-aggi(k,l)
3362 aggi1(k,l)=-aggi1(k,l)
3363 aggj(k,l)=-aggj(k,l)
3364 aggj1(k,l)=-aggj1(k,l)
3375 aggi(k,l)=-aggi(k,l)
3376 aggi1(k,l)=-aggi1(k,l)
3377 aggj(k,l)=-aggj(k,l)
3378 aggj1(k,l)=-aggj1(k,l)
3383 IF (wel_loc.gt.0.0d0) THEN
3384 c if ((i.eq.8).and.(j.eq.14)) then
3385 C Contribution to the local-electrostatic energy coming from the i-j pair
3386 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3388 C Calculate patrial derivative for theta angle
3390 geel_loc_ij=a22*gmuij1(1)
3394 c write(iout,*) "derivative over thatai"
3395 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3397 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3398 & geel_loc_ij*wel_loc
3399 c write(iout,*) "derivative over thatai-1"
3400 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3402 geel_loc_ij=a22*gmuij2(1)+a23*gmuij2(2)+a32*gmuij2(3)
3404 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3405 & geel_loc_ij*wel_loc
3406 geel_loc_ji=a22*gmuji1(1)+a23*gmuji1(2)+a32*gmuji1(3)
3408 c write(iout,*) "derivative over thataj"
3409 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3412 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3413 & geel_loc_ji*wel_loc
3414 geel_loc_ji=a22*gmuji2(1)+a23*gmuji2(2)+a32*gmuji2(3)
3416 c write(iout,*) "derivative over thataj-1"
3417 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3419 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3420 & geel_loc_ji*wel_loc
3422 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3424 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3425 & 'eelloc',i,j,eel_loc_ij
3426 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3428 eel_loc=eel_loc+eel_loc_ij
3429 C Partial derivatives in virtual-bond dihedral angles gamma
3431 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3432 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3433 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3434 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3435 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3436 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3437 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3439 ggg(l)=agg(l,1)*muij(1)+
3440 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3441 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3442 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3443 cgrad ghalf=0.5d0*ggg(l)
3444 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3445 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3449 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3452 C Remaining derivatives of eello
3454 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3455 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3456 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3457 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3458 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3459 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3460 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3461 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3465 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3466 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3467 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3468 & .and. num_conti.le.maxconts) then
3469 c write (iout,*) i,j," entered corr"
3471 C Calculate the contact function. The ith column of the array JCONT will
3472 C contain the numbers of atoms that make contacts with the atom I (of numbers
3473 C greater than I). The arrays FACONT and GACONT will contain the values of
3474 C the contact function and its derivative.
3475 c r0ij=1.02D0*rpp(iteli,itelj)
3476 c r0ij=1.11D0*rpp(iteli,itelj)
3477 r0ij=2.20D0*rpp(iteli,itelj)
3478 c r0ij=1.55D0*rpp(iteli,itelj)
3479 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3480 if (fcont.gt.0.0D0) then
3481 num_conti=num_conti+1
3482 if (num_conti.gt.maxconts) then
3483 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3484 & ' will skip next contacts for this conf.'
3486 jcont_hb(num_conti,i)=j
3487 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3488 cd & " jcont_hb",jcont_hb(num_conti,i)
3489 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3490 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3491 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3493 d_cont(num_conti,i)=rij
3494 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3495 C --- Electrostatic-interaction matrix ---
3496 a_chuj(1,1,num_conti,i)=a22
3497 a_chuj(1,2,num_conti,i)=a23
3498 a_chuj(2,1,num_conti,i)=a32
3499 a_chuj(2,2,num_conti,i)=a33
3500 C --- Gradient of rij
3502 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3509 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3510 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3511 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3512 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3513 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3518 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3519 C Calculate contact energies
3521 wij=cosa-3.0D0*cosb*cosg
3524 c fac3=dsqrt(-ael6i)/r0ij**3
3525 fac3=dsqrt(-ael6i)*r3ij
3526 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3527 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3528 if (ees0tmp.gt.0) then
3529 ees0pij=dsqrt(ees0tmp)
3533 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3534 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3535 if (ees0tmp.gt.0) then
3536 ees0mij=dsqrt(ees0tmp)
3541 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3542 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3543 C Diagnostics. Comment out or remove after debugging!
3544 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3545 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3546 c ees0m(num_conti,i)=0.0D0
3548 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3549 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3550 C Angular derivatives of the contact function
3551 ees0pij1=fac3/ees0pij
3552 ees0mij1=fac3/ees0mij
3553 fac3p=-3.0D0*fac3*rrmij
3554 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3555 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3557 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3558 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3559 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3560 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3561 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3562 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3563 ecosap=ecosa1+ecosa2
3564 ecosbp=ecosb1+ecosb2
3565 ecosgp=ecosg1+ecosg2
3566 ecosam=ecosa1-ecosa2
3567 ecosbm=ecosb1-ecosb2
3568 ecosgm=ecosg1-ecosg2
3577 facont_hb(num_conti,i)=fcont
3578 fprimcont=fprimcont/rij
3579 cd facont_hb(num_conti,i)=1.0D0
3580 C Following line is for diagnostics.
3583 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3584 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3587 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3588 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3590 gggp(1)=gggp(1)+ees0pijp*xj
3591 gggp(2)=gggp(2)+ees0pijp*yj
3592 gggp(3)=gggp(3)+ees0pijp*zj
3593 gggm(1)=gggm(1)+ees0mijp*xj
3594 gggm(2)=gggm(2)+ees0mijp*yj
3595 gggm(3)=gggm(3)+ees0mijp*zj
3596 C Derivatives due to the contact function
3597 gacont_hbr(1,num_conti,i)=fprimcont*xj
3598 gacont_hbr(2,num_conti,i)=fprimcont*yj
3599 gacont_hbr(3,num_conti,i)=fprimcont*zj
3602 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3603 c following the change of gradient-summation algorithm.
3605 cgrad ghalfp=0.5D0*gggp(k)
3606 cgrad ghalfm=0.5D0*gggm(k)
3607 gacontp_hb1(k,num_conti,i)=!ghalfp
3608 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3609 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3610 gacontp_hb2(k,num_conti,i)=!ghalfp
3611 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3612 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3613 gacontp_hb3(k,num_conti,i)=gggp(k)
3614 gacontm_hb1(k,num_conti,i)=!ghalfm
3615 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3616 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3617 gacontm_hb2(k,num_conti,i)=!ghalfm
3618 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3619 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3620 gacontm_hb3(k,num_conti,i)=gggm(k)
3622 C Diagnostics. Comment out or remove after debugging!
3624 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3625 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3626 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3627 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3628 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3629 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3632 endif ! num_conti.le.maxconts
3635 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3638 ghalf=0.5d0*agg(l,k)
3639 aggi(l,k)=aggi(l,k)+ghalf
3640 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3641 aggj(l,k)=aggj(l,k)+ghalf
3644 if (j.eq.nres-1 .and. i.lt.j-2) then
3647 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3652 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3655 C-----------------------------------------------------------------------------
3656 subroutine eturn3(i,eello_turn3)
3657 C Third- and fourth-order contributions from turns
3658 implicit real*8 (a-h,o-z)
3659 include 'DIMENSIONS'
3660 include 'COMMON.IOUNITS'
3661 include 'COMMON.GEO'
3662 include 'COMMON.VAR'
3663 include 'COMMON.LOCAL'
3664 include 'COMMON.CHAIN'
3665 include 'COMMON.DERIV'
3666 include 'COMMON.INTERACT'
3667 include 'COMMON.CONTACTS'
3668 include 'COMMON.TORSION'
3669 include 'COMMON.VECTORS'
3670 include 'COMMON.FFIELD'
3671 include 'COMMON.CONTROL'
3673 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3674 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3675 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3676 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3677 & auxgmat2(2,2),auxgmatt2(2,2)
3678 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3679 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3680 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3681 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3684 c write (iout,*) "eturn3",i,j,j1,j2
3689 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3691 C Third-order contributions
3698 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3699 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3700 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3701 c auxalary matices for theta gradient
3702 c auxalary matrix for i+1 and constant i+2
3703 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3704 c auxalary matrix for i+2 and constant i+1
3705 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3706 call transpose2(auxmat(1,1),auxmat1(1,1))
3707 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3708 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3709 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3710 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3711 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3712 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3713 C Derivatives in theta
3714 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3715 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3716 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3717 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3719 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3720 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3721 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3722 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3723 cd & ' eello_turn3_num',4*eello_turn3_num
3724 C Derivatives in gamma(i)
3725 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3726 call transpose2(auxmat2(1,1),auxmat3(1,1))
3727 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3728 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3729 C Derivatives in gamma(i+1)
3730 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3731 call transpose2(auxmat2(1,1),auxmat3(1,1))
3732 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3733 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3734 & +0.5d0*(pizda(1,1)+pizda(2,2))
3735 C Cartesian derivatives
3737 c ghalf1=0.5d0*agg(l,1)
3738 c ghalf2=0.5d0*agg(l,2)
3739 c ghalf3=0.5d0*agg(l,3)
3740 c ghalf4=0.5d0*agg(l,4)
3741 a_temp(1,1)=aggi(l,1)!+ghalf1
3742 a_temp(1,2)=aggi(l,2)!+ghalf2
3743 a_temp(2,1)=aggi(l,3)!+ghalf3
3744 a_temp(2,2)=aggi(l,4)!+ghalf4
3745 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3746 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3747 & +0.5d0*(pizda(1,1)+pizda(2,2))
3748 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3749 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3750 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3751 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3752 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3753 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3754 & +0.5d0*(pizda(1,1)+pizda(2,2))
3755 a_temp(1,1)=aggj(l,1)!+ghalf1
3756 a_temp(1,2)=aggj(l,2)!+ghalf2
3757 a_temp(2,1)=aggj(l,3)!+ghalf3
3758 a_temp(2,2)=aggj(l,4)!+ghalf4
3759 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3760 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3761 & +0.5d0*(pizda(1,1)+pizda(2,2))
3762 a_temp(1,1)=aggj1(l,1)
3763 a_temp(1,2)=aggj1(l,2)
3764 a_temp(2,1)=aggj1(l,3)
3765 a_temp(2,2)=aggj1(l,4)
3766 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3767 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3768 & +0.5d0*(pizda(1,1)+pizda(2,2))
3772 C-------------------------------------------------------------------------------
3773 subroutine eturn4(i,eello_turn4)
3774 C Third- and fourth-order contributions from turns
3775 implicit real*8 (a-h,o-z)
3776 include 'DIMENSIONS'
3777 include 'COMMON.IOUNITS'
3778 include 'COMMON.GEO'
3779 include 'COMMON.VAR'
3780 include 'COMMON.LOCAL'
3781 include 'COMMON.CHAIN'
3782 include 'COMMON.DERIV'
3783 include 'COMMON.INTERACT'
3784 include 'COMMON.CONTACTS'
3785 include 'COMMON.TORSION'
3786 include 'COMMON.VECTORS'
3787 include 'COMMON.FFIELD'
3788 include 'COMMON.CONTROL'
3790 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3791 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3792 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3793 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3794 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3795 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3796 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3797 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3798 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3799 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3800 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3803 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3805 C Fourth-order contributions
3813 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3814 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3815 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3816 c write(iout,*)"WCHODZE W PROGRAM"
3821 iti1=itortyp(itype(i+1))
3822 iti2=itortyp(itype(i+2))
3823 iti3=itortyp(itype(i+3))
3824 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3825 call transpose2(EUg(1,1,i+1),e1t(1,1))
3826 call transpose2(Eug(1,1,i+2),e2t(1,1))
3827 call transpose2(Eug(1,1,i+3),e3t(1,1))
3828 C Ematrix derivative in theta
3829 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3830 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3831 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3832 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3833 c eta1 in derivative theta
3834 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3835 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3836 c auxgvec is derivative of Ub2 so i+3 theta
3837 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3838 c auxalary matrix of E i+1
3839 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3842 s1=scalar2(b1(1,i+2),auxvec(1))
3843 c derivative of theta i+2 with constant i+3
3844 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3845 c derivative of theta i+2 with constant i+2
3846 gs32=scalar2(b1(1,i+2),auxgvec(1))
3847 c derivative of E matix in theta of i+1
3848 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3850 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3851 c ea31 in derivative theta
3852 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3853 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3854 c auxilary matrix auxgvec of Ub2 with constant E matirx
3855 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3856 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3857 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3861 s2=scalar2(b1(1,i+1),auxvec(1))
3862 c derivative of theta i+1 with constant i+3
3863 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3864 c derivative of theta i+2 with constant i+1
3865 gs21=scalar2(b1(1,i+1),auxgvec(1))
3866 c derivative of theta i+3 with constant i+1
3867 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3868 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3870 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3871 c two derivatives over diffetent matrices
3872 c gtae3e2 is derivative over i+3
3873 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3874 c ae3gte2 is derivative over i+2
3875 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3876 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3877 c three possible derivative over theta E matices
3879 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3881 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3883 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3884 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3886 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3887 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3888 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3890 eello_turn4=eello_turn4-(s1+s2+s3)
3892 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3893 & -(gs13+gsE13+gsEE1)*wturn4
3894 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3895 & -(gs23+gs21+gsEE2)*wturn4
3896 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3897 & -(gs32+gsE31+gsEE3)*wturn4
3898 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3901 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3902 & 'eturn4',i,j,-(s1+s2+s3)
3903 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3904 c & ' eello_turn4_num',8*eello_turn4_num
3905 C Derivatives in gamma(i)
3906 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3907 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3908 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3909 s1=scalar2(b1(1,i+2),auxvec(1))
3910 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3911 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3912 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3913 C Derivatives in gamma(i+1)
3914 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3915 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3916 s2=scalar2(b1(1,i+1),auxvec(1))
3917 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3918 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3919 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3920 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3921 C Derivatives in gamma(i+2)
3922 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3923 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3924 s1=scalar2(b1(1,i+2),auxvec(1))
3925 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3926 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3927 s2=scalar2(b1(1,i+1),auxvec(1))
3928 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3929 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3930 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3931 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3932 C Cartesian derivatives
3933 C Derivatives of this turn contributions in DC(i+2)
3934 if (j.lt.nres-1) then
3936 a_temp(1,1)=agg(l,1)
3937 a_temp(1,2)=agg(l,2)
3938 a_temp(2,1)=agg(l,3)
3939 a_temp(2,2)=agg(l,4)
3940 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3941 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3942 s1=scalar2(b1(1,i+2),auxvec(1))
3943 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3944 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3945 s2=scalar2(b1(1,i+1),auxvec(1))
3946 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3947 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3948 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3950 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3953 C Remaining derivatives of this turn contribution
3955 a_temp(1,1)=aggi(l,1)
3956 a_temp(1,2)=aggi(l,2)
3957 a_temp(2,1)=aggi(l,3)
3958 a_temp(2,2)=aggi(l,4)
3959 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3960 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3961 s1=scalar2(b1(1,i+2),auxvec(1))
3962 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3963 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3964 s2=scalar2(b1(1,i+1),auxvec(1))
3965 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3966 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3967 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3968 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3969 a_temp(1,1)=aggi1(l,1)
3970 a_temp(1,2)=aggi1(l,2)
3971 a_temp(2,1)=aggi1(l,3)
3972 a_temp(2,2)=aggi1(l,4)
3973 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3974 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3975 s1=scalar2(b1(1,i+2),auxvec(1))
3976 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3977 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3978 s2=scalar2(b1(1,i+1),auxvec(1))
3979 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3980 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3981 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3982 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3983 a_temp(1,1)=aggj(l,1)
3984 a_temp(1,2)=aggj(l,2)
3985 a_temp(2,1)=aggj(l,3)
3986 a_temp(2,2)=aggj(l,4)
3987 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3988 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3989 s1=scalar2(b1(1,i+2),auxvec(1))
3990 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3991 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3992 s2=scalar2(b1(1,i+1),auxvec(1))
3993 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3994 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3995 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3996 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3997 a_temp(1,1)=aggj1(l,1)
3998 a_temp(1,2)=aggj1(l,2)
3999 a_temp(2,1)=aggj1(l,3)
4000 a_temp(2,2)=aggj1(l,4)
4001 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4002 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4003 s1=scalar2(b1(1,i+2),auxvec(1))
4004 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4005 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4006 s2=scalar2(b1(1,i+1),auxvec(1))
4007 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4008 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4009 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4010 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4011 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4015 C-----------------------------------------------------------------------------
4016 subroutine vecpr(u,v,w)
4017 implicit real*8(a-h,o-z)
4018 dimension u(3),v(3),w(3)
4019 w(1)=u(2)*v(3)-u(3)*v(2)
4020 w(2)=-u(1)*v(3)+u(3)*v(1)
4021 w(3)=u(1)*v(2)-u(2)*v(1)
4024 C-----------------------------------------------------------------------------
4025 subroutine unormderiv(u,ugrad,unorm,ungrad)
4026 C This subroutine computes the derivatives of a normalized vector u, given
4027 C the derivatives computed without normalization conditions, ugrad. Returns
4030 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4031 double precision vec(3)
4032 double precision scalar
4034 c write (2,*) 'ugrad',ugrad
4037 vec(i)=scalar(ugrad(1,i),u(1))
4039 c write (2,*) 'vec',vec
4042 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4045 c write (2,*) 'ungrad',ungrad
4048 C-----------------------------------------------------------------------------
4049 subroutine escp_soft_sphere(evdw2,evdw2_14)
4051 C This subroutine calculates the excluded-volume interaction energy between
4052 C peptide-group centers and side chains and its gradient in virtual-bond and
4053 C side-chain vectors.
4055 implicit real*8 (a-h,o-z)
4056 include 'DIMENSIONS'
4057 include 'COMMON.GEO'
4058 include 'COMMON.VAR'
4059 include 'COMMON.LOCAL'
4060 include 'COMMON.CHAIN'
4061 include 'COMMON.DERIV'
4062 include 'COMMON.INTERACT'
4063 include 'COMMON.FFIELD'
4064 include 'COMMON.IOUNITS'
4065 include 'COMMON.CONTROL'
4070 cd print '(a)','Enter ESCP'
4071 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4072 do i=iatscp_s,iatscp_e
4073 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4075 xi=0.5D0*(c(1,i)+c(1,i+1))
4076 yi=0.5D0*(c(2,i)+c(2,i+1))
4077 zi=0.5D0*(c(3,i)+c(3,i+1))
4079 do iint=1,nscp_gr(i)
4081 do j=iscpstart(i,iint),iscpend(i,iint)
4082 if (itype(j).eq.ntyp1) cycle
4083 itypj=iabs(itype(j))
4084 C Uncomment following three lines for SC-p interactions
4088 C Uncomment following three lines for Ca-p interactions
4092 rij=xj*xj+yj*yj+zj*zj
4095 if (rij.lt.r0ijsq) then
4096 evdwij=0.25d0*(rij-r0ijsq)**2
4104 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4109 cgrad if (j.lt.i) then
4110 cd write (iout,*) 'j<i'
4111 C Uncomment following three lines for SC-p interactions
4113 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4116 cd write (iout,*) 'j>i'
4118 cgrad ggg(k)=-ggg(k)
4119 C Uncomment following line for SC-p interactions
4120 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4124 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4126 cgrad kstart=min0(i+1,j)
4127 cgrad kend=max0(i-1,j-1)
4128 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4129 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4130 cgrad do k=kstart,kend
4132 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4136 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4137 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4145 C-----------------------------------------------------------------------------
4146 subroutine escp(evdw2,evdw2_14)
4148 C This subroutine calculates the excluded-volume interaction energy between
4149 C peptide-group centers and side chains and its gradient in virtual-bond and
4150 C side-chain vectors.
4152 implicit real*8 (a-h,o-z)
4153 include 'DIMENSIONS'
4154 include 'COMMON.GEO'
4155 include 'COMMON.VAR'
4156 include 'COMMON.LOCAL'
4157 include 'COMMON.CHAIN'
4158 include 'COMMON.DERIV'
4159 include 'COMMON.INTERACT'
4160 include 'COMMON.FFIELD'
4161 include 'COMMON.IOUNITS'
4162 include 'COMMON.CONTROL'
4166 cd print '(a)','Enter ESCP'
4167 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4168 do i=iatscp_s,iatscp_e
4169 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4171 xi=0.5D0*(c(1,i)+c(1,i+1))
4172 yi=0.5D0*(c(2,i)+c(2,i+1))
4173 zi=0.5D0*(c(3,i)+c(3,i+1))
4175 do iint=1,nscp_gr(i)
4177 do j=iscpstart(i,iint),iscpend(i,iint)
4178 itypj=iabs(itype(j))
4179 if (itypj.eq.ntyp1) cycle
4180 C Uncomment following three lines for SC-p interactions
4184 C Uncomment following three lines for Ca-p interactions
4188 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4190 e1=fac*fac*aad(itypj,iteli)
4191 e2=fac*bad(itypj,iteli)
4192 if (iabs(j-i) .le. 2) then
4195 evdw2_14=evdw2_14+e1+e2
4199 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4200 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4203 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4205 fac=-(evdwij+e1)*rrij
4209 cgrad if (j.lt.i) then
4210 cd write (iout,*) 'j<i'
4211 C Uncomment following three lines for SC-p interactions
4213 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4216 cd write (iout,*) 'j>i'
4218 cgrad ggg(k)=-ggg(k)
4219 C Uncomment following line for SC-p interactions
4220 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4221 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4225 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4227 cgrad kstart=min0(i+1,j)
4228 cgrad kend=max0(i-1,j-1)
4229 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4230 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4231 cgrad do k=kstart,kend
4233 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4237 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4238 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4246 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4247 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4248 gradx_scp(j,i)=expon*gradx_scp(j,i)
4251 C******************************************************************************
4255 C To save time the factor EXPON has been extracted from ALL components
4256 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4259 C******************************************************************************
4262 C--------------------------------------------------------------------------
4263 subroutine edis(ehpb)
4265 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4267 implicit real*8 (a-h,o-z)
4268 include 'DIMENSIONS'
4269 include 'COMMON.SBRIDGE'
4270 include 'COMMON.CHAIN'
4271 include 'COMMON.DERIV'
4272 include 'COMMON.VAR'
4273 include 'COMMON.INTERACT'
4274 include 'COMMON.IOUNITS'
4277 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4278 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4279 if (link_end.eq.0) return
4280 do i=link_start,link_end
4281 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4282 C CA-CA distance used in regularization of structure.
4285 C iii and jjj point to the residues for which the distance is assigned.
4286 if (ii.gt.nres) then
4293 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4294 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4295 C distance and angle dependent SS bond potential.
4296 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4297 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4298 c if (.not.dyn_ss .and. i.le.nss) then
4299 C 15/02/13 CC dynamic SSbond
4300 C if (.not.dyn_ss.and.
4301 C & ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4303 if (.not.dyn_ss .and. i.le.nss) then
4304 C 15/02/13 CC dynamic SSbond - additional check
4306 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4307 call ssbond_ene(iii,jjj,eij)
4310 cd write (iout,*) "eij",eij
4312 C Calculate the distance between the two points and its difference from the
4316 C Get the force constant corresponding to this distance.
4318 C Calculate the contribution to energy.
4319 ehpb=ehpb+waga*rdis*rdis
4321 C Evaluate gradient.
4324 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4325 cd & ' waga=',waga,' fac=',fac
4327 ggg(j)=fac*(c(j,jj)-c(j,ii))
4329 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4330 C If this is a SC-SC distance, we need to calculate the contributions to the
4331 C Cartesian gradient in the SC vectors (ghpbx).
4334 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4335 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4338 cgrad do j=iii,jjj-1
4340 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4344 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4345 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4352 C--------------------------------------------------------------------------
4353 subroutine ssbond_ene(i,j,eij)
4355 C Calculate the distance and angle dependent SS-bond potential energy
4356 C using a free-energy function derived based on RHF/6-31G** ab initio
4357 C calculations of diethyl disulfide.
4359 C A. Liwo and U. Kozlowska, 11/24/03
4361 implicit real*8 (a-h,o-z)
4362 include 'DIMENSIONS'
4363 include 'COMMON.SBRIDGE'
4364 include 'COMMON.CHAIN'
4365 include 'COMMON.DERIV'
4366 include 'COMMON.LOCAL'
4367 include 'COMMON.INTERACT'
4368 include 'COMMON.VAR'
4369 include 'COMMON.IOUNITS'
4370 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4371 itypi=iabs(itype(i))
4375 dxi=dc_norm(1,nres+i)
4376 dyi=dc_norm(2,nres+i)
4377 dzi=dc_norm(3,nres+i)
4378 c dsci_inv=dsc_inv(itypi)
4379 dsci_inv=vbld_inv(nres+i)
4380 itypj=iabs(itype(j))
4381 c dscj_inv=dsc_inv(itypj)
4382 dscj_inv=vbld_inv(nres+j)
4386 dxj=dc_norm(1,nres+j)
4387 dyj=dc_norm(2,nres+j)
4388 dzj=dc_norm(3,nres+j)
4389 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4394 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4395 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4396 om12=dxi*dxj+dyi*dyj+dzi*dzj
4398 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4399 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4405 deltat12=om2-om1+2.0d0
4407 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4408 & +akct*deltad*deltat12
4409 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4410 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4411 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4412 c & " deltat12",deltat12," eij",eij
4413 ed=2*akcm*deltad+akct*deltat12
4415 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4416 eom1=-2*akth*deltat1-pom1-om2*pom2
4417 eom2= 2*akth*deltat2+pom1-om1*pom2
4420 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4421 ghpbx(k,i)=ghpbx(k,i)-ggk
4422 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4423 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4424 ghpbx(k,j)=ghpbx(k,j)+ggk
4425 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4426 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4427 ghpbc(k,i)=ghpbc(k,i)-ggk
4428 ghpbc(k,j)=ghpbc(k,j)+ggk
4431 C Calculate the components of the gradient in DC and X
4435 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4440 C--------------------------------------------------------------------------
4441 subroutine ebond(estr)
4443 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4445 implicit real*8 (a-h,o-z)
4446 include 'DIMENSIONS'
4447 include 'COMMON.LOCAL'
4448 include 'COMMON.GEO'
4449 include 'COMMON.INTERACT'
4450 include 'COMMON.DERIV'
4451 include 'COMMON.VAR'
4452 include 'COMMON.CHAIN'
4453 include 'COMMON.IOUNITS'
4454 include 'COMMON.NAMES'
4455 include 'COMMON.FFIELD'
4456 include 'COMMON.CONTROL'
4457 include 'COMMON.SETUP'
4458 double precision u(3),ud(3)
4461 do i=ibondp_start,ibondp_end
4462 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4463 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4465 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4466 & *dc(j,i-1)/vbld(i)
4468 if (energy_dec) write(iout,*)
4469 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4471 diff = vbld(i)-vbldp0
4472 if (energy_dec) write (iout,*)
4473 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4476 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4478 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4481 estr=0.5d0*AKP*estr+estr1
4483 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4485 do i=ibond_start,ibond_end
4487 if (iti.ne.10 .and. iti.ne.ntyp1) then
4490 diff=vbld(i+nres)-vbldsc0(1,iti)
4491 if (energy_dec) write (iout,*)
4492 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4493 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4494 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4496 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4500 diff=vbld(i+nres)-vbldsc0(j,iti)
4501 ud(j)=aksc(j,iti)*diff
4502 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4516 uprod2=uprod2*u(k)*u(k)
4520 usumsqder=usumsqder+ud(j)*uprod2
4522 estr=estr+uprod/usum
4524 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4532 C--------------------------------------------------------------------------
4533 subroutine ebend(etheta)
4535 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4536 C angles gamma and its derivatives in consecutive thetas and gammas.
4538 implicit real*8 (a-h,o-z)
4539 include 'DIMENSIONS'
4540 include 'COMMON.LOCAL'
4541 include 'COMMON.GEO'
4542 include 'COMMON.INTERACT'
4543 include 'COMMON.DERIV'
4544 include 'COMMON.VAR'
4545 include 'COMMON.CHAIN'
4546 include 'COMMON.IOUNITS'
4547 include 'COMMON.NAMES'
4548 include 'COMMON.FFIELD'
4549 include 'COMMON.CONTROL'
4550 common /calcthet/ term1,term2,termm,diffak,ratak,
4551 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4552 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4553 double precision y(2),z(2)
4555 c time11=dexp(-2*time)
4558 c write (*,'(a,i2)') 'EBEND ICG=',icg
4559 do i=ithet_start,ithet_end
4560 if (itype(i-1).eq.ntyp1) cycle
4561 C Zero the energy function and its derivative at 0 or pi.
4562 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4564 ichir1=isign(1,itype(i-2))
4565 ichir2=isign(1,itype(i))
4566 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4567 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4568 if (itype(i-1).eq.10) then
4569 itype1=isign(10,itype(i-2))
4570 ichir11=isign(1,itype(i-2))
4571 ichir12=isign(1,itype(i-2))
4572 itype2=isign(10,itype(i))
4573 ichir21=isign(1,itype(i))
4574 ichir22=isign(1,itype(i))
4577 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4580 if (phii.ne.phii) phii=150.0
4590 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4593 if (phii1.ne.phii1) phii1=150.0
4605 C Calculate the "mean" value of theta from the part of the distribution
4606 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4607 C In following comments this theta will be referred to as t_c.
4608 thet_pred_mean=0.0d0
4610 athetk=athet(k,it,ichir1,ichir2)
4611 bthetk=bthet(k,it,ichir1,ichir2)
4613 athetk=athet(k,itype1,ichir11,ichir12)
4614 bthetk=bthet(k,itype2,ichir21,ichir22)
4616 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4618 dthett=thet_pred_mean*ssd
4619 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4620 C Derivatives of the "mean" values in gamma1 and gamma2.
4621 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4622 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4623 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4624 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4626 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4627 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4628 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4629 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4631 if (theta(i).gt.pi-delta) then
4632 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4634 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4635 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4636 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4638 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4640 else if (theta(i).lt.delta) then
4641 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4642 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4643 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4645 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4646 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4649 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4652 etheta=etheta+ethetai
4653 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4655 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4656 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4657 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4659 C Ufff.... We've done all this!!!
4662 C---------------------------------------------------------------------------
4663 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4665 implicit real*8 (a-h,o-z)
4666 include 'DIMENSIONS'
4667 include 'COMMON.LOCAL'
4668 include 'COMMON.IOUNITS'
4669 common /calcthet/ term1,term2,termm,diffak,ratak,
4670 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4671 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4672 C Calculate the contributions to both Gaussian lobes.
4673 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4674 C The "polynomial part" of the "standard deviation" of this part of
4678 sig=sig*thet_pred_mean+polthet(j,it)
4680 C Derivative of the "interior part" of the "standard deviation of the"
4681 C gamma-dependent Gaussian lobe in t_c.
4682 sigtc=3*polthet(3,it)
4684 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4687 C Set the parameters of both Gaussian lobes of the distribution.
4688 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4689 fac=sig*sig+sigc0(it)
4692 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4693 sigsqtc=-4.0D0*sigcsq*sigtc
4694 c print *,i,sig,sigtc,sigsqtc
4695 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4696 sigtc=-sigtc/(fac*fac)
4697 C Following variable is sigma(t_c)**(-2)
4698 sigcsq=sigcsq*sigcsq
4700 sig0inv=1.0D0/sig0i**2
4701 delthec=thetai-thet_pred_mean
4702 delthe0=thetai-theta0i
4703 term1=-0.5D0*sigcsq*delthec*delthec
4704 term2=-0.5D0*sig0inv*delthe0*delthe0
4705 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4706 C NaNs in taking the logarithm. We extract the largest exponent which is added
4707 C to the energy (this being the log of the distribution) at the end of energy
4708 C term evaluation for this virtual-bond angle.
4709 if (term1.gt.term2) then
4711 term2=dexp(term2-termm)
4715 term1=dexp(term1-termm)
4718 C The ratio between the gamma-independent and gamma-dependent lobes of
4719 C the distribution is a Gaussian function of thet_pred_mean too.
4720 diffak=gthet(2,it)-thet_pred_mean
4721 ratak=diffak/gthet(3,it)**2
4722 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4723 C Let's differentiate it in thet_pred_mean NOW.
4725 C Now put together the distribution terms to make complete distribution.
4726 termexp=term1+ak*term2
4727 termpre=sigc+ak*sig0i
4728 C Contribution of the bending energy from this theta is just the -log of
4729 C the sum of the contributions from the two lobes and the pre-exponential
4730 C factor. Simple enough, isn't it?
4731 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4732 C NOW the derivatives!!!
4733 C 6/6/97 Take into account the deformation.
4734 E_theta=(delthec*sigcsq*term1
4735 & +ak*delthe0*sig0inv*term2)/termexp
4736 E_tc=((sigtc+aktc*sig0i)/termpre
4737 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4738 & aktc*term2)/termexp)
4741 c-----------------------------------------------------------------------------
4742 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4743 implicit real*8 (a-h,o-z)
4744 include 'DIMENSIONS'
4745 include 'COMMON.LOCAL'
4746 include 'COMMON.IOUNITS'
4747 common /calcthet/ term1,term2,termm,diffak,ratak,
4748 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4749 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4750 delthec=thetai-thet_pred_mean
4751 delthe0=thetai-theta0i
4752 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4753 t3 = thetai-thet_pred_mean
4757 t14 = t12+t6*sigsqtc
4759 t21 = thetai-theta0i
4765 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4766 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4767 & *(-t12*t9-ak*sig0inv*t27)
4771 C--------------------------------------------------------------------------
4772 subroutine ebend(etheta)
4774 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4775 C angles gamma and its derivatives in consecutive thetas and gammas.
4776 C ab initio-derived potentials from
4777 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4779 implicit real*8 (a-h,o-z)
4780 include 'DIMENSIONS'
4781 include 'COMMON.LOCAL'
4782 include 'COMMON.GEO'
4783 include 'COMMON.INTERACT'
4784 include 'COMMON.DERIV'
4785 include 'COMMON.VAR'
4786 include 'COMMON.CHAIN'
4787 include 'COMMON.IOUNITS'
4788 include 'COMMON.NAMES'
4789 include 'COMMON.FFIELD'
4790 include 'COMMON.CONTROL'
4791 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4792 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4793 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4794 & sinph1ph2(maxdouble,maxdouble)
4795 logical lprn /.false./, lprn1 /.false./
4797 do i=ithet_start,ithet_end
4798 if (itype(i-1).eq.ntyp1) cycle
4799 if (iabs(itype(i+1)).eq.20) iblock=2
4800 if (iabs(itype(i+1)).ne.20) iblock=1
4804 theti2=0.5d0*theta(i)
4805 ityp2=ithetyp((itype(i-1)))
4807 coskt(k)=dcos(k*theti2)
4808 sinkt(k)=dsin(k*theti2)
4810 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4813 if (phii.ne.phii) phii=150.0
4817 ityp1=ithetyp((itype(i-2)))
4818 C propagation of chirality for glycine type
4820 cosph1(k)=dcos(k*phii)
4821 sinph1(k)=dsin(k*phii)
4831 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4834 if (phii1.ne.phii1) phii1=150.0
4839 ityp3=ithetyp((itype(i)))
4841 cosph2(k)=dcos(k*phii1)
4842 sinph2(k)=dsin(k*phii1)
4852 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4855 ccl=cosph1(l)*cosph2(k-l)
4856 ssl=sinph1(l)*sinph2(k-l)
4857 scl=sinph1(l)*cosph2(k-l)
4858 csl=cosph1(l)*sinph2(k-l)
4859 cosph1ph2(l,k)=ccl-ssl
4860 cosph1ph2(k,l)=ccl+ssl
4861 sinph1ph2(l,k)=scl+csl
4862 sinph1ph2(k,l)=scl-csl
4866 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4867 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4868 write (iout,*) "coskt and sinkt"
4870 write (iout,*) k,coskt(k),sinkt(k)
4874 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4875 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4878 & write (iout,*) "k",k,"
4879 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4880 & " ethetai",ethetai
4883 write (iout,*) "cosph and sinph"
4885 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4887 write (iout,*) "cosph1ph2 and sinph2ph2"
4890 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4891 & sinph1ph2(l,k),sinph1ph2(k,l)
4894 write(iout,*) "ethetai",ethetai
4898 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4899 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4900 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4901 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4902 ethetai=ethetai+sinkt(m)*aux
4903 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4904 dephii=dephii+k*sinkt(m)*(
4905 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4906 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4907 dephii1=dephii1+k*sinkt(m)*(
4908 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4909 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4911 & write (iout,*) "m",m," k",k," bbthet",
4912 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4913 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4914 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4915 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4919 & write(iout,*) "ethetai",ethetai
4923 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4924 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4925 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4926 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4927 ethetai=ethetai+sinkt(m)*aux
4928 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4929 dephii=dephii+l*sinkt(m)*(
4930 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4931 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4932 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4933 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4934 dephii1=dephii1+(k-l)*sinkt(m)*(
4935 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4936 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4937 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4938 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4940 write (iout,*) "m",m," k",k," l",l," ffthet",
4941 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4942 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4943 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4944 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4945 & " ethetai",ethetai
4946 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4947 & cosph1ph2(k,l)*sinkt(m),
4948 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4956 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4957 & i,theta(i)*rad2deg,phii*rad2deg,
4958 & phii1*rad2deg,ethetai
4960 etheta=etheta+ethetai
4961 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4962 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4963 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
4969 c-----------------------------------------------------------------------------
4970 subroutine esc(escloc)
4971 C Calculate the local energy of a side chain and its derivatives in the
4972 C corresponding virtual-bond valence angles THETA and the spherical angles
4974 implicit real*8 (a-h,o-z)
4975 include 'DIMENSIONS'
4976 include 'COMMON.GEO'
4977 include 'COMMON.LOCAL'
4978 include 'COMMON.VAR'
4979 include 'COMMON.INTERACT'
4980 include 'COMMON.DERIV'
4981 include 'COMMON.CHAIN'
4982 include 'COMMON.IOUNITS'
4983 include 'COMMON.NAMES'
4984 include 'COMMON.FFIELD'
4985 include 'COMMON.CONTROL'
4986 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4987 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4988 common /sccalc/ time11,time12,time112,theti,it,nlobit
4991 c write (iout,'(a)') 'ESC'
4992 do i=loc_start,loc_end
4994 if (it.eq.ntyp1) cycle
4995 if (it.eq.10) goto 1
4996 nlobit=nlob(iabs(it))
4997 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4998 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4999 theti=theta(i+1)-pipol
5004 if (x(2).gt.pi-delta) then
5008 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5010 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5011 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5013 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5014 & ddersc0(1),dersc(1))
5015 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5016 & ddersc0(3),dersc(3))
5018 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5020 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5021 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5022 & dersc0(2),esclocbi,dersc02)
5023 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5025 call splinthet(x(2),0.5d0*delta,ss,ssd)
5030 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5032 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5033 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5035 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5037 c write (iout,*) escloci
5038 else if (x(2).lt.delta) then
5042 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5044 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5045 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5047 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5048 & ddersc0(1),dersc(1))
5049 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5050 & ddersc0(3),dersc(3))
5052 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5054 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5055 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5056 & dersc0(2),esclocbi,dersc02)
5057 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5062 call splinthet(x(2),0.5d0*delta,ss,ssd)
5064 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5066 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5067 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5069 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5070 c write (iout,*) escloci
5072 call enesc(x,escloci,dersc,ddummy,.false.)
5075 escloc=escloc+escloci
5076 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5077 & 'escloc',i,escloci
5078 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5080 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5082 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5083 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5088 C---------------------------------------------------------------------------
5089 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5090 implicit real*8 (a-h,o-z)
5091 include 'DIMENSIONS'
5092 include 'COMMON.GEO'
5093 include 'COMMON.LOCAL'
5094 include 'COMMON.IOUNITS'
5095 common /sccalc/ time11,time12,time112,theti,it,nlobit
5096 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5097 double precision contr(maxlob,-1:1)
5099 c write (iout,*) 'it=',it,' nlobit=',nlobit
5103 if (mixed) ddersc(j)=0.0d0
5107 C Because of periodicity of the dependence of the SC energy in omega we have
5108 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5109 C To avoid underflows, first compute & store the exponents.
5117 z(k)=x(k)-censc(k,j,it)
5122 Axk=Axk+gaussc(l,k,j,it)*z(l)
5128 expfac=expfac+Ax(k,j,iii)*z(k)
5136 C As in the case of ebend, we want to avoid underflows in exponentiation and
5137 C subsequent NaNs and INFs in energy calculation.
5138 C Find the largest exponent
5142 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5146 cd print *,'it=',it,' emin=',emin
5148 C Compute the contribution to SC energy and derivatives
5153 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5154 if(adexp.ne.adexp) adexp=1.0
5157 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5159 cd print *,'j=',j,' expfac=',expfac
5160 escloc_i=escloc_i+expfac
5162 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5166 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5167 & +gaussc(k,2,j,it))*expfac
5174 dersc(1)=dersc(1)/cos(theti)**2
5175 ddersc(1)=ddersc(1)/cos(theti)**2
5178 escloci=-(dlog(escloc_i)-emin)
5180 dersc(j)=dersc(j)/escloc_i
5184 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5189 C------------------------------------------------------------------------------
5190 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5191 implicit real*8 (a-h,o-z)
5192 include 'DIMENSIONS'
5193 include 'COMMON.GEO'
5194 include 'COMMON.LOCAL'
5195 include 'COMMON.IOUNITS'
5196 common /sccalc/ time11,time12,time112,theti,it,nlobit
5197 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5198 double precision contr(maxlob)
5209 z(k)=x(k)-censc(k,j,it)
5215 Axk=Axk+gaussc(l,k,j,it)*z(l)
5221 expfac=expfac+Ax(k,j)*z(k)
5226 C As in the case of ebend, we want to avoid underflows in exponentiation and
5227 C subsequent NaNs and INFs in energy calculation.
5228 C Find the largest exponent
5231 if (emin.gt.contr(j)) emin=contr(j)
5235 C Compute the contribution to SC energy and derivatives
5239 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5240 escloc_i=escloc_i+expfac
5242 dersc(k)=dersc(k)+Ax(k,j)*expfac
5244 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5245 & +gaussc(1,2,j,it))*expfac
5249 dersc(1)=dersc(1)/cos(theti)**2
5250 dersc12=dersc12/cos(theti)**2
5251 escloci=-(dlog(escloc_i)-emin)
5253 dersc(j)=dersc(j)/escloc_i
5255 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5259 c----------------------------------------------------------------------------------
5260 subroutine esc(escloc)
5261 C Calculate the local energy of a side chain and its derivatives in the
5262 C corresponding virtual-bond valence angles THETA and the spherical angles
5263 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5264 C added by Urszula Kozlowska. 07/11/2007
5266 implicit real*8 (a-h,o-z)
5267 include 'DIMENSIONS'
5268 include 'COMMON.GEO'
5269 include 'COMMON.LOCAL'
5270 include 'COMMON.VAR'
5271 include 'COMMON.SCROT'
5272 include 'COMMON.INTERACT'
5273 include 'COMMON.DERIV'
5274 include 'COMMON.CHAIN'
5275 include 'COMMON.IOUNITS'
5276 include 'COMMON.NAMES'
5277 include 'COMMON.FFIELD'
5278 include 'COMMON.CONTROL'
5279 include 'COMMON.VECTORS'
5280 double precision x_prime(3),y_prime(3),z_prime(3)
5281 & , sumene,dsc_i,dp2_i,x(65),
5282 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5283 & de_dxx,de_dyy,de_dzz,de_dt
5284 double precision s1_t,s1_6_t,s2_t,s2_6_t
5286 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5287 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5288 & dt_dCi(3),dt_dCi1(3)
5289 common /sccalc/ time11,time12,time112,theti,it,nlobit
5292 do i=loc_start,loc_end
5293 if (itype(i).eq.ntyp1) cycle
5294 costtab(i+1) =dcos(theta(i+1))
5295 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5296 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5297 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5298 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5299 cosfac=dsqrt(cosfac2)
5300 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5301 sinfac=dsqrt(sinfac2)
5303 if (it.eq.10) goto 1
5305 C Compute the axes of tghe local cartesian coordinates system; store in
5306 c x_prime, y_prime and z_prime
5313 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5314 C & dc_norm(3,i+nres)
5316 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5317 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5320 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5323 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5324 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5325 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5326 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5327 c & " xy",scalar(x_prime(1),y_prime(1)),
5328 c & " xz",scalar(x_prime(1),z_prime(1)),
5329 c & " yy",scalar(y_prime(1),y_prime(1)),
5330 c & " yz",scalar(y_prime(1),z_prime(1)),
5331 c & " zz",scalar(z_prime(1),z_prime(1))
5333 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5334 C to local coordinate system. Store in xx, yy, zz.
5340 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5341 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5342 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5349 C Compute the energy of the ith side cbain
5351 c write (2,*) "xx",xx," yy",yy," zz",zz
5354 x(j) = sc_parmin(j,it)
5357 Cc diagnostics - remove later
5359 yy1 = dsin(alph(2))*dcos(omeg(2))
5360 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5361 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5362 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5364 C," --- ", xx_w,yy_w,zz_w
5367 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5368 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5370 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5371 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5373 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5374 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5375 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5376 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5377 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5379 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5380 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5381 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5382 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5383 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5385 dsc_i = 0.743d0+x(61)
5387 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5388 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5389 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5390 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5391 s1=(1+x(63))/(0.1d0 + dscp1)
5392 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5393 s2=(1+x(65))/(0.1d0 + dscp2)
5394 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5395 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5396 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5397 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5399 c & dscp1,dscp2,sumene
5400 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5401 escloc = escloc + sumene
5402 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5407 C This section to check the numerical derivatives of the energy of ith side
5408 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5409 C #define DEBUG in the code to turn it on.
5411 write (2,*) "sumene =",sumene
5415 write (2,*) xx,yy,zz
5416 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5417 de_dxx_num=(sumenep-sumene)/aincr
5419 write (2,*) "xx+ sumene from enesc=",sumenep
5422 write (2,*) xx,yy,zz
5423 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5424 de_dyy_num=(sumenep-sumene)/aincr
5426 write (2,*) "yy+ sumene from enesc=",sumenep
5429 write (2,*) xx,yy,zz
5430 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5431 de_dzz_num=(sumenep-sumene)/aincr
5433 write (2,*) "zz+ sumene from enesc=",sumenep
5434 costsave=cost2tab(i+1)
5435 sintsave=sint2tab(i+1)
5436 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5437 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5438 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5439 de_dt_num=(sumenep-sumene)/aincr
5440 write (2,*) " t+ sumene from enesc=",sumenep
5441 cost2tab(i+1)=costsave
5442 sint2tab(i+1)=sintsave
5443 C End of diagnostics section.
5446 C Compute the gradient of esc
5448 c zz=zz*dsign(1.0,dfloat(itype(i)))
5449 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5450 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5451 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5452 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5453 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5454 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5455 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5456 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5457 pom1=(sumene3*sint2tab(i+1)+sumene1)
5458 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5459 pom2=(sumene4*cost2tab(i+1)+sumene2)
5460 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5461 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5462 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5463 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5465 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5466 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5467 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5469 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5470 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5471 & +(pom1+pom2)*pom_dx
5473 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5476 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5477 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5478 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5480 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5481 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5482 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5483 & +x(59)*zz**2 +x(60)*xx*zz
5484 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5485 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5486 & +(pom1-pom2)*pom_dy
5488 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5491 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5492 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5493 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5494 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5495 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5496 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5497 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5498 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5500 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5503 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5504 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5505 & +pom1*pom_dt1+pom2*pom_dt2
5507 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5512 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5513 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5514 cosfac2xx=cosfac2*xx
5515 sinfac2yy=sinfac2*yy
5517 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5519 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5521 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5522 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5523 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5524 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5525 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5526 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5527 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5528 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5529 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5530 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5534 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5535 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5536 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5537 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5540 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5541 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5542 dZZ_XYZ(k)=vbld_inv(i+nres)*
5543 & (z_prime(k)-zz*dC_norm(k,i+nres))
5545 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5546 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5550 dXX_Ctab(k,i)=dXX_Ci(k)
5551 dXX_C1tab(k,i)=dXX_Ci1(k)
5552 dYY_Ctab(k,i)=dYY_Ci(k)
5553 dYY_C1tab(k,i)=dYY_Ci1(k)
5554 dZZ_Ctab(k,i)=dZZ_Ci(k)
5555 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5556 dXX_XYZtab(k,i)=dXX_XYZ(k)
5557 dYY_XYZtab(k,i)=dYY_XYZ(k)
5558 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5562 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5563 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5564 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5565 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5566 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5568 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5569 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5570 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5571 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5572 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5573 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5574 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5575 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5577 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5578 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5580 C to check gradient call subroutine check_grad
5586 c------------------------------------------------------------------------------
5587 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5589 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5590 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5591 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5592 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5594 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5595 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5597 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5598 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5599 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5600 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5601 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5603 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5604 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5605 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5606 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5607 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5609 dsc_i = 0.743d0+x(61)
5611 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5612 & *(xx*cost2+yy*sint2))
5613 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5614 & *(xx*cost2-yy*sint2))
5615 s1=(1+x(63))/(0.1d0 + dscp1)
5616 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5617 s2=(1+x(65))/(0.1d0 + dscp2)
5618 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5619 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5620 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5625 c------------------------------------------------------------------------------
5626 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5628 C This procedure calculates two-body contact function g(rij) and its derivative:
5631 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5634 C where x=(rij-r0ij)/delta
5636 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5639 double precision rij,r0ij,eps0ij,fcont,fprimcont
5640 double precision x,x2,x4,delta
5644 if (x.lt.-1.0D0) then
5647 else if (x.le.1.0D0) then
5650 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5651 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5658 c------------------------------------------------------------------------------
5659 subroutine splinthet(theti,delta,ss,ssder)
5660 implicit real*8 (a-h,o-z)
5661 include 'DIMENSIONS'
5662 include 'COMMON.VAR'
5663 include 'COMMON.GEO'
5666 if (theti.gt.pipol) then
5667 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5669 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5674 c------------------------------------------------------------------------------
5675 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5677 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5678 double precision ksi,ksi2,ksi3,a1,a2,a3
5679 a1=fprim0*delta/(f1-f0)
5685 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5686 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5689 c------------------------------------------------------------------------------
5690 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5692 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5693 double precision ksi,ksi2,ksi3,a1,a2,a3
5698 a2=3*(f1x-f0x)-2*fprim0x*delta
5699 a3=fprim0x*delta-2*(f1x-f0x)
5700 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5703 C-----------------------------------------------------------------------------
5705 C-----------------------------------------------------------------------------
5706 subroutine etor(etors,edihcnstr)
5707 implicit real*8 (a-h,o-z)
5708 include 'DIMENSIONS'
5709 include 'COMMON.VAR'
5710 include 'COMMON.GEO'
5711 include 'COMMON.LOCAL'
5712 include 'COMMON.TORSION'
5713 include 'COMMON.INTERACT'
5714 include 'COMMON.DERIV'
5715 include 'COMMON.CHAIN'
5716 include 'COMMON.NAMES'
5717 include 'COMMON.IOUNITS'
5718 include 'COMMON.FFIELD'
5719 include 'COMMON.TORCNSTR'
5720 include 'COMMON.CONTROL'
5722 C Set lprn=.true. for debugging
5726 do i=iphi_start,iphi_end
5728 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5729 & .or. itype(i).eq.ntyp1) cycle
5730 itori=itortyp(itype(i-2))
5731 itori1=itortyp(itype(i-1))
5734 C Proline-Proline pair is a special case...
5735 if (itori.eq.3 .and. itori1.eq.3) then
5736 if (phii.gt.-dwapi3) then
5738 fac=1.0D0/(1.0D0-cosphi)
5739 etorsi=v1(1,3,3)*fac
5740 etorsi=etorsi+etorsi
5741 etors=etors+etorsi-v1(1,3,3)
5742 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5743 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5746 v1ij=v1(j+1,itori,itori1)
5747 v2ij=v2(j+1,itori,itori1)
5750 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5751 if (energy_dec) etors_ii=etors_ii+
5752 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5753 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5757 v1ij=v1(j,itori,itori1)
5758 v2ij=v2(j,itori,itori1)
5761 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5762 if (energy_dec) etors_ii=etors_ii+
5763 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5764 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5767 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5770 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5771 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5772 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5773 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5774 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5776 ! 6/20/98 - dihedral angle constraints
5779 itori=idih_constr(i)
5782 if (difi.gt.drange(i)) then
5784 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5785 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5786 else if (difi.lt.-drange(i)) then
5788 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5789 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5791 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5792 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5794 ! write (iout,*) 'edihcnstr',edihcnstr
5797 c------------------------------------------------------------------------------
5798 subroutine etor_d(etors_d)
5802 c----------------------------------------------------------------------------
5804 subroutine etor(etors,edihcnstr)
5805 implicit real*8 (a-h,o-z)
5806 include 'DIMENSIONS'
5807 include 'COMMON.VAR'
5808 include 'COMMON.GEO'
5809 include 'COMMON.LOCAL'
5810 include 'COMMON.TORSION'
5811 include 'COMMON.INTERACT'
5812 include 'COMMON.DERIV'
5813 include 'COMMON.CHAIN'
5814 include 'COMMON.NAMES'
5815 include 'COMMON.IOUNITS'
5816 include 'COMMON.FFIELD'
5817 include 'COMMON.TORCNSTR'
5818 include 'COMMON.CONTROL'
5820 C Set lprn=.true. for debugging
5824 do i=iphi_start,iphi_end
5825 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5826 & .or. itype(i).eq.ntyp1) cycle
5828 if (iabs(itype(i)).eq.20) then
5833 itori=itortyp(itype(i-2))
5834 itori1=itortyp(itype(i-1))
5837 C Regular cosine and sine terms
5838 do j=1,nterm(itori,itori1,iblock)
5839 v1ij=v1(j,itori,itori1,iblock)
5840 v2ij=v2(j,itori,itori1,iblock)
5843 etors=etors+v1ij*cosphi+v2ij*sinphi
5844 if (energy_dec) etors_ii=etors_ii+
5845 & v1ij*cosphi+v2ij*sinphi
5846 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5850 C E = SUM ----------------------------------- - v1
5851 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5853 cosphi=dcos(0.5d0*phii)
5854 sinphi=dsin(0.5d0*phii)
5855 do j=1,nlor(itori,itori1,iblock)
5856 vl1ij=vlor1(j,itori,itori1)
5857 vl2ij=vlor2(j,itori,itori1)
5858 vl3ij=vlor3(j,itori,itori1)
5859 pom=vl2ij*cosphi+vl3ij*sinphi
5860 pom1=1.0d0/(pom*pom+1.0d0)
5861 etors=etors+vl1ij*pom1
5862 if (energy_dec) etors_ii=etors_ii+
5865 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5867 C Subtract the constant term
5868 etors=etors-v0(itori,itori1,iblock)
5869 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5870 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5872 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5873 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5874 & (v1(j,itori,itori1,iblock),j=1,6),
5875 & (v2(j,itori,itori1,iblock),j=1,6)
5876 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5877 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5879 ! 6/20/98 - dihedral angle constraints
5881 c do i=1,ndih_constr
5882 do i=idihconstr_start,idihconstr_end
5883 itori=idih_constr(i)
5885 difi=pinorm(phii-phi0(i))
5886 if (difi.gt.drange(i)) then
5888 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5889 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5890 else if (difi.lt.-drange(i)) then
5892 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5893 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5897 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5898 cd & rad2deg*phi0(i), rad2deg*drange(i),
5899 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5901 cd write (iout,*) 'edihcnstr',edihcnstr
5904 c----------------------------------------------------------------------------
5905 subroutine etor_d(etors_d)
5906 C 6/23/01 Compute double torsional energy
5907 implicit real*8 (a-h,o-z)
5908 include 'DIMENSIONS'
5909 include 'COMMON.VAR'
5910 include 'COMMON.GEO'
5911 include 'COMMON.LOCAL'
5912 include 'COMMON.TORSION'
5913 include 'COMMON.INTERACT'
5914 include 'COMMON.DERIV'
5915 include 'COMMON.CHAIN'
5916 include 'COMMON.NAMES'
5917 include 'COMMON.IOUNITS'
5918 include 'COMMON.FFIELD'
5919 include 'COMMON.TORCNSTR'
5921 C Set lprn=.true. for debugging
5925 c write(iout,*) "a tu??"
5926 do i=iphid_start,iphid_end
5927 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5928 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5929 itori=itortyp(itype(i-2))
5930 itori1=itortyp(itype(i-1))
5931 itori2=itortyp(itype(i))
5937 if (iabs(itype(i+1)).eq.20) iblock=2
5939 C Regular cosine and sine terms
5940 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5941 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5942 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5943 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5944 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5945 cosphi1=dcos(j*phii)
5946 sinphi1=dsin(j*phii)
5947 cosphi2=dcos(j*phii1)
5948 sinphi2=dsin(j*phii1)
5949 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5950 & v2cij*cosphi2+v2sij*sinphi2
5951 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5952 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5954 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5956 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5957 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5958 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5959 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5960 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5961 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5962 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5963 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5964 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5965 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5966 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5967 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5968 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5969 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5972 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5973 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5978 c------------------------------------------------------------------------------
5979 subroutine eback_sc_corr(esccor)
5980 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5981 c conformational states; temporarily implemented as differences
5982 c between UNRES torsional potentials (dependent on three types of
5983 c residues) and the torsional potentials dependent on all 20 types
5984 c of residues computed from AM1 energy surfaces of terminally-blocked
5985 c amino-acid residues.
5986 implicit real*8 (a-h,o-z)
5987 include 'DIMENSIONS'
5988 include 'COMMON.VAR'
5989 include 'COMMON.GEO'
5990 include 'COMMON.LOCAL'
5991 include 'COMMON.TORSION'
5992 include 'COMMON.SCCOR'
5993 include 'COMMON.INTERACT'
5994 include 'COMMON.DERIV'
5995 include 'COMMON.CHAIN'
5996 include 'COMMON.NAMES'
5997 include 'COMMON.IOUNITS'
5998 include 'COMMON.FFIELD'
5999 include 'COMMON.CONTROL'
6001 C Set lprn=.true. for debugging
6004 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6006 do i=itau_start,itau_end
6007 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6009 isccori=isccortyp(itype(i-2))
6010 isccori1=isccortyp(itype(i-1))
6011 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6013 do intertyp=1,3 !intertyp
6014 cc Added 09 May 2012 (Adasko)
6015 cc Intertyp means interaction type of backbone mainchain correlation:
6016 c 1 = SC...Ca...Ca...Ca
6017 c 2 = Ca...Ca...Ca...SC
6018 c 3 = SC...Ca...Ca...SCi
6020 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6021 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6022 & (itype(i-1).eq.ntyp1)))
6023 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6024 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6025 & .or.(itype(i).eq.ntyp1)))
6026 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6027 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6028 & (itype(i-3).eq.ntyp1)))) cycle
6029 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6030 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6032 do j=1,nterm_sccor(isccori,isccori1)
6033 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6034 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6035 cosphi=dcos(j*tauangle(intertyp,i))
6036 sinphi=dsin(j*tauangle(intertyp,i))
6037 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6038 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6040 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6041 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6043 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6044 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6045 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6046 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6047 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6053 c----------------------------------------------------------------------------
6054 subroutine multibody(ecorr)
6055 C This subroutine calculates multi-body contributions to energy following
6056 C the idea of Skolnick et al. If side chains I and J make a contact and
6057 C at the same time side chains I+1 and J+1 make a contact, an extra
6058 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6059 implicit real*8 (a-h,o-z)
6060 include 'DIMENSIONS'
6061 include 'COMMON.IOUNITS'
6062 include 'COMMON.DERIV'
6063 include 'COMMON.INTERACT'
6064 include 'COMMON.CONTACTS'
6065 double precision gx(3),gx1(3)
6068 C Set lprn=.true. for debugging
6072 write (iout,'(a)') 'Contact function values:'
6074 write (iout,'(i2,20(1x,i2,f10.5))')
6075 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6090 num_conti=num_cont(i)
6091 num_conti1=num_cont(i1)
6096 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6097 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6098 cd & ' ishift=',ishift
6099 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6100 C The system gains extra energy.
6101 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6102 endif ! j1==j+-ishift
6111 c------------------------------------------------------------------------------
6112 double precision function esccorr(i,j,k,l,jj,kk)
6113 implicit real*8 (a-h,o-z)
6114 include 'DIMENSIONS'
6115 include 'COMMON.IOUNITS'
6116 include 'COMMON.DERIV'
6117 include 'COMMON.INTERACT'
6118 include 'COMMON.CONTACTS'
6119 double precision gx(3),gx1(3)
6124 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6125 C Calculate the multi-body contribution to energy.
6126 C Calculate multi-body contributions to the gradient.
6127 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6128 cd & k,l,(gacont(m,kk,k),m=1,3)
6130 gx(m) =ekl*gacont(m,jj,i)
6131 gx1(m)=eij*gacont(m,kk,k)
6132 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6133 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6134 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6135 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6139 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6144 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6150 c------------------------------------------------------------------------------
6151 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6152 C This subroutine calculates multi-body contributions to hydrogen-bonding
6153 implicit real*8 (a-h,o-z)
6154 include 'DIMENSIONS'
6155 include 'COMMON.IOUNITS'
6158 parameter (max_cont=maxconts)
6159 parameter (max_dim=26)
6160 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6161 double precision zapas(max_dim,maxconts,max_fg_procs),
6162 & zapas_recv(max_dim,maxconts,max_fg_procs)
6163 common /przechowalnia/ zapas
6164 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6165 & status_array(MPI_STATUS_SIZE,maxconts*2)
6167 include 'COMMON.SETUP'
6168 include 'COMMON.FFIELD'
6169 include 'COMMON.DERIV'
6170 include 'COMMON.INTERACT'
6171 include 'COMMON.CONTACTS'
6172 include 'COMMON.CONTROL'
6173 include 'COMMON.LOCAL'
6174 double precision gx(3),gx1(3),time00
6177 C Set lprn=.true. for debugging
6182 if (nfgtasks.le.1) goto 30
6184 write (iout,'(a)') 'Contact function values before RECEIVE:'
6186 write (iout,'(2i3,50(1x,i2,f5.2))')
6187 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6188 & j=1,num_cont_hb(i))
6192 do i=1,ntask_cont_from
6195 do i=1,ntask_cont_to
6198 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6200 C Make the list of contacts to send to send to other procesors
6201 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6203 do i=iturn3_start,iturn3_end
6204 c write (iout,*) "make contact list turn3",i," num_cont",
6206 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6208 do i=iturn4_start,iturn4_end
6209 c write (iout,*) "make contact list turn4",i," num_cont",
6211 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6215 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6217 do j=1,num_cont_hb(i)
6220 iproc=iint_sent_local(k,jjc,ii)
6221 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6222 if (iproc.gt.0) then
6223 ncont_sent(iproc)=ncont_sent(iproc)+1
6224 nn=ncont_sent(iproc)
6226 zapas(2,nn,iproc)=jjc
6227 zapas(3,nn,iproc)=facont_hb(j,i)
6228 zapas(4,nn,iproc)=ees0p(j,i)
6229 zapas(5,nn,iproc)=ees0m(j,i)
6230 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6231 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6232 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6233 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6234 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6235 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6236 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6237 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6238 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6239 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6240 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6241 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6242 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6243 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6244 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6245 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6246 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6247 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6248 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6249 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6250 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6257 & "Numbers of contacts to be sent to other processors",
6258 & (ncont_sent(i),i=1,ntask_cont_to)
6259 write (iout,*) "Contacts sent"
6260 do ii=1,ntask_cont_to
6262 iproc=itask_cont_to(ii)
6263 write (iout,*) nn," contacts to processor",iproc,
6264 & " of CONT_TO_COMM group"
6266 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6274 CorrelID1=nfgtasks+fg_rank+1
6276 C Receive the numbers of needed contacts from other processors
6277 do ii=1,ntask_cont_from
6278 iproc=itask_cont_from(ii)
6280 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6281 & FG_COMM,req(ireq),IERR)
6283 c write (iout,*) "IRECV ended"
6285 C Send the number of contacts needed by other processors
6286 do ii=1,ntask_cont_to
6287 iproc=itask_cont_to(ii)
6289 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6290 & FG_COMM,req(ireq),IERR)
6292 c write (iout,*) "ISEND ended"
6293 c write (iout,*) "number of requests (nn)",ireq
6296 & call MPI_Waitall(ireq,req,status_array,ierr)
6298 c & "Numbers of contacts to be received from other processors",
6299 c & (ncont_recv(i),i=1,ntask_cont_from)
6303 do ii=1,ntask_cont_from
6304 iproc=itask_cont_from(ii)
6306 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6307 c & " of CONT_TO_COMM group"
6311 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6312 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6313 c write (iout,*) "ireq,req",ireq,req(ireq)
6316 C Send the contacts to processors that need them
6317 do ii=1,ntask_cont_to
6318 iproc=itask_cont_to(ii)
6320 c write (iout,*) nn," contacts to processor",iproc,
6321 c & " of CONT_TO_COMM group"
6324 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6325 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6326 c write (iout,*) "ireq,req",ireq,req(ireq)
6328 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6332 c write (iout,*) "number of requests (contacts)",ireq
6333 c write (iout,*) "req",(req(i),i=1,4)
6336 & call MPI_Waitall(ireq,req,status_array,ierr)
6337 do iii=1,ntask_cont_from
6338 iproc=itask_cont_from(iii)
6341 write (iout,*) "Received",nn," contacts from processor",iproc,
6342 & " of CONT_FROM_COMM group"
6345 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6350 ii=zapas_recv(1,i,iii)
6351 c Flag the received contacts to prevent double-counting
6352 jj=-zapas_recv(2,i,iii)
6353 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6355 nnn=num_cont_hb(ii)+1
6358 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6359 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6360 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6361 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6362 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6363 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6364 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6365 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6366 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6367 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6368 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6369 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6370 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6371 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6372 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6373 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6374 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6375 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6376 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6377 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6378 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6379 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6380 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6381 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6386 write (iout,'(a)') 'Contact function values after receive:'
6388 write (iout,'(2i3,50(1x,i3,f5.2))')
6389 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6390 & j=1,num_cont_hb(i))
6397 write (iout,'(a)') 'Contact function values:'
6399 write (iout,'(2i3,50(1x,i3,f5.2))')
6400 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6401 & j=1,num_cont_hb(i))
6405 C Remove the loop below after debugging !!!
6412 C Calculate the local-electrostatic correlation terms
6413 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6415 num_conti=num_cont_hb(i)
6416 num_conti1=num_cont_hb(i+1)
6423 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6424 c & ' jj=',jj,' kk=',kk
6425 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6426 & .or. j.lt.0 .and. j1.gt.0) .and.
6427 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6428 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6429 C The system gains extra energy.
6430 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6431 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6432 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6434 else if (j1.eq.j) then
6435 C Contacts I-J and I-(J+1) occur simultaneously.
6436 C The system loses extra energy.
6437 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6442 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6443 c & ' jj=',jj,' kk=',kk
6445 C Contacts I-J and (I+1)-J occur simultaneously.
6446 C The system loses extra energy.
6447 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6454 c------------------------------------------------------------------------------
6455 subroutine add_hb_contact(ii,jj,itask)
6456 implicit real*8 (a-h,o-z)
6457 include "DIMENSIONS"
6458 include "COMMON.IOUNITS"
6461 parameter (max_cont=maxconts)
6462 parameter (max_dim=26)
6463 include "COMMON.CONTACTS"
6464 double precision zapas(max_dim,maxconts,max_fg_procs),
6465 & zapas_recv(max_dim,maxconts,max_fg_procs)
6466 common /przechowalnia/ zapas
6467 integer i,j,ii,jj,iproc,itask(4),nn
6468 c write (iout,*) "itask",itask
6471 if (iproc.gt.0) then
6472 do j=1,num_cont_hb(ii)
6474 c write (iout,*) "i",ii," j",jj," jjc",jjc
6476 ncont_sent(iproc)=ncont_sent(iproc)+1
6477 nn=ncont_sent(iproc)
6478 zapas(1,nn,iproc)=ii
6479 zapas(2,nn,iproc)=jjc
6480 zapas(3,nn,iproc)=facont_hb(j,ii)
6481 zapas(4,nn,iproc)=ees0p(j,ii)
6482 zapas(5,nn,iproc)=ees0m(j,ii)
6483 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6484 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6485 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6486 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6487 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6488 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6489 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6490 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6491 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6492 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6493 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6494 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6495 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6496 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6497 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6498 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6499 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6500 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6501 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6502 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6503 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6511 c------------------------------------------------------------------------------
6512 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6514 C This subroutine calculates multi-body contributions to hydrogen-bonding
6515 implicit real*8 (a-h,o-z)
6516 include 'DIMENSIONS'
6517 include 'COMMON.IOUNITS'
6520 parameter (max_cont=maxconts)
6521 parameter (max_dim=70)
6522 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6523 double precision zapas(max_dim,maxconts,max_fg_procs),
6524 & zapas_recv(max_dim,maxconts,max_fg_procs)
6525 common /przechowalnia/ zapas
6526 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6527 & status_array(MPI_STATUS_SIZE,maxconts*2)
6529 include 'COMMON.SETUP'
6530 include 'COMMON.FFIELD'
6531 include 'COMMON.DERIV'
6532 include 'COMMON.LOCAL'
6533 include 'COMMON.INTERACT'
6534 include 'COMMON.CONTACTS'
6535 include 'COMMON.CHAIN'
6536 include 'COMMON.CONTROL'
6537 double precision gx(3),gx1(3)
6538 integer num_cont_hb_old(maxres)
6540 double precision eello4,eello5,eelo6,eello_turn6
6541 external eello4,eello5,eello6,eello_turn6
6542 C Set lprn=.true. for debugging
6547 num_cont_hb_old(i)=num_cont_hb(i)
6551 if (nfgtasks.le.1) goto 30
6553 write (iout,'(a)') 'Contact function values before RECEIVE:'
6555 write (iout,'(2i3,50(1x,i2,f5.2))')
6556 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6557 & j=1,num_cont_hb(i))
6561 do i=1,ntask_cont_from
6564 do i=1,ntask_cont_to
6567 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6569 C Make the list of contacts to send to send to other procesors
6570 do i=iturn3_start,iturn3_end
6571 c write (iout,*) "make contact list turn3",i," num_cont",
6573 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6575 do i=iturn4_start,iturn4_end
6576 c write (iout,*) "make contact list turn4",i," num_cont",
6578 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6582 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6584 do j=1,num_cont_hb(i)
6587 iproc=iint_sent_local(k,jjc,ii)
6588 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6589 if (iproc.ne.0) then
6590 ncont_sent(iproc)=ncont_sent(iproc)+1
6591 nn=ncont_sent(iproc)
6593 zapas(2,nn,iproc)=jjc
6594 zapas(3,nn,iproc)=d_cont(j,i)
6598 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6603 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6611 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6622 & "Numbers of contacts to be sent to other processors",
6623 & (ncont_sent(i),i=1,ntask_cont_to)
6624 write (iout,*) "Contacts sent"
6625 do ii=1,ntask_cont_to
6627 iproc=itask_cont_to(ii)
6628 write (iout,*) nn," contacts to processor",iproc,
6629 & " of CONT_TO_COMM group"
6631 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6639 CorrelID1=nfgtasks+fg_rank+1
6641 C Receive the numbers of needed contacts from other processors
6642 do ii=1,ntask_cont_from
6643 iproc=itask_cont_from(ii)
6645 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6646 & FG_COMM,req(ireq),IERR)
6648 c write (iout,*) "IRECV ended"
6650 C Send the number of contacts needed by other processors
6651 do ii=1,ntask_cont_to
6652 iproc=itask_cont_to(ii)
6654 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6655 & FG_COMM,req(ireq),IERR)
6657 c write (iout,*) "ISEND ended"
6658 c write (iout,*) "number of requests (nn)",ireq
6661 & call MPI_Waitall(ireq,req,status_array,ierr)
6663 c & "Numbers of contacts to be received from other processors",
6664 c & (ncont_recv(i),i=1,ntask_cont_from)
6668 do ii=1,ntask_cont_from
6669 iproc=itask_cont_from(ii)
6671 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6672 c & " of CONT_TO_COMM group"
6676 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6677 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6678 c write (iout,*) "ireq,req",ireq,req(ireq)
6681 C Send the contacts to processors that need them
6682 do ii=1,ntask_cont_to
6683 iproc=itask_cont_to(ii)
6685 c write (iout,*) nn," contacts to processor",iproc,
6686 c & " of CONT_TO_COMM group"
6689 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6690 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6691 c write (iout,*) "ireq,req",ireq,req(ireq)
6693 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6697 c write (iout,*) "number of requests (contacts)",ireq
6698 c write (iout,*) "req",(req(i),i=1,4)
6701 & call MPI_Waitall(ireq,req,status_array,ierr)
6702 do iii=1,ntask_cont_from
6703 iproc=itask_cont_from(iii)
6706 write (iout,*) "Received",nn," contacts from processor",iproc,
6707 & " of CONT_FROM_COMM group"
6710 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6715 ii=zapas_recv(1,i,iii)
6716 c Flag the received contacts to prevent double-counting
6717 jj=-zapas_recv(2,i,iii)
6718 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6720 nnn=num_cont_hb(ii)+1
6723 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6727 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6732 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6740 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6749 write (iout,'(a)') 'Contact function values after receive:'
6751 write (iout,'(2i3,50(1x,i3,5f6.3))')
6752 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6753 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6760 write (iout,'(a)') 'Contact function values:'
6762 write (iout,'(2i3,50(1x,i2,5f6.3))')
6763 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6764 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6770 C Remove the loop below after debugging !!!
6777 C Calculate the dipole-dipole interaction energies
6778 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6779 do i=iatel_s,iatel_e+1
6780 num_conti=num_cont_hb(i)
6789 C Calculate the local-electrostatic correlation terms
6790 c write (iout,*) "gradcorr5 in eello5 before loop"
6792 c write (iout,'(i5,3f10.5)')
6793 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6795 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6796 c write (iout,*) "corr loop i",i
6798 num_conti=num_cont_hb(i)
6799 num_conti1=num_cont_hb(i+1)
6806 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6807 c & ' jj=',jj,' kk=',kk
6808 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6809 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6810 & .or. j.lt.0 .and. j1.gt.0) .and.
6811 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6812 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6813 C The system gains extra energy.
6815 sqd1=dsqrt(d_cont(jj,i))
6816 sqd2=dsqrt(d_cont(kk,i1))
6817 sred_geom = sqd1*sqd2
6818 IF (sred_geom.lt.cutoff_corr) THEN
6819 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6821 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6822 cd & ' jj=',jj,' kk=',kk
6823 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6824 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6826 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6827 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6830 cd write (iout,*) 'sred_geom=',sred_geom,
6831 cd & ' ekont=',ekont,' fprim=',fprimcont,
6832 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6833 cd write (iout,*) "g_contij",g_contij
6834 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6835 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6836 call calc_eello(i,jp,i+1,jp1,jj,kk)
6837 if (wcorr4.gt.0.0d0)
6838 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6839 if (energy_dec.and.wcorr4.gt.0.0d0)
6840 1 write (iout,'(a6,4i5,0pf7.3)')
6841 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6842 c write (iout,*) "gradcorr5 before eello5"
6844 c write (iout,'(i5,3f10.5)')
6845 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6847 if (wcorr5.gt.0.0d0)
6848 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6849 c write (iout,*) "gradcorr5 after eello5"
6851 c write (iout,'(i5,3f10.5)')
6852 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6854 if (energy_dec.and.wcorr5.gt.0.0d0)
6855 1 write (iout,'(a6,4i5,0pf7.3)')
6856 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6857 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6858 cd write(2,*)'ijkl',i,jp,i+1,jp1
6859 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6860 & .or. wturn6.eq.0.0d0))then
6861 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6862 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6863 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6864 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6865 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6866 cd & 'ecorr6=',ecorr6
6867 cd write (iout,'(4e15.5)') sred_geom,
6868 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6869 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6870 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6871 else if (wturn6.gt.0.0d0
6872 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6873 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6874 eturn6=eturn6+eello_turn6(i,jj,kk)
6875 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6876 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6877 cd write (2,*) 'multibody_eello:eturn6',eturn6
6886 num_cont_hb(i)=num_cont_hb_old(i)
6888 c write (iout,*) "gradcorr5 in eello5"
6890 c write (iout,'(i5,3f10.5)')
6891 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6895 c------------------------------------------------------------------------------
6896 subroutine add_hb_contact_eello(ii,jj,itask)
6897 implicit real*8 (a-h,o-z)
6898 include "DIMENSIONS"
6899 include "COMMON.IOUNITS"
6902 parameter (max_cont=maxconts)
6903 parameter (max_dim=70)
6904 include "COMMON.CONTACTS"
6905 double precision zapas(max_dim,maxconts,max_fg_procs),
6906 & zapas_recv(max_dim,maxconts,max_fg_procs)
6907 common /przechowalnia/ zapas
6908 integer i,j,ii,jj,iproc,itask(4),nn
6909 c write (iout,*) "itask",itask
6912 if (iproc.gt.0) then
6913 do j=1,num_cont_hb(ii)
6915 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6917 ncont_sent(iproc)=ncont_sent(iproc)+1
6918 nn=ncont_sent(iproc)
6919 zapas(1,nn,iproc)=ii
6920 zapas(2,nn,iproc)=jjc
6921 zapas(3,nn,iproc)=d_cont(j,ii)
6925 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6930 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6938 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6950 c------------------------------------------------------------------------------
6951 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6952 implicit real*8 (a-h,o-z)
6953 include 'DIMENSIONS'
6954 include 'COMMON.IOUNITS'
6955 include 'COMMON.DERIV'
6956 include 'COMMON.INTERACT'
6957 include 'COMMON.CONTACTS'
6958 double precision gx(3),gx1(3)
6968 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6969 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6970 C Following 4 lines for diagnostics.
6975 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6976 c & 'Contacts ',i,j,
6977 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6978 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6980 C Calculate the multi-body contribution to energy.
6981 c ecorr=ecorr+ekont*ees
6982 C Calculate multi-body contributions to the gradient.
6983 coeffpees0pij=coeffp*ees0pij
6984 coeffmees0mij=coeffm*ees0mij
6985 coeffpees0pkl=coeffp*ees0pkl
6986 coeffmees0mkl=coeffm*ees0mkl
6988 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6989 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6990 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6991 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6992 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6993 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6994 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6995 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6996 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6997 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6998 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6999 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7000 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7001 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7002 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7003 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7004 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7005 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7006 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7007 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7008 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7009 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7010 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7011 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7012 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7017 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7018 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7019 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7020 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7025 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7026 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7027 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7028 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7031 c write (iout,*) "ehbcorr",ekont*ees
7036 C---------------------------------------------------------------------------
7037 subroutine dipole(i,j,jj)
7038 implicit real*8 (a-h,o-z)
7039 include 'DIMENSIONS'
7040 include 'COMMON.IOUNITS'
7041 include 'COMMON.CHAIN'
7042 include 'COMMON.FFIELD'
7043 include 'COMMON.DERIV'
7044 include 'COMMON.INTERACT'
7045 include 'COMMON.CONTACTS'
7046 include 'COMMON.TORSION'
7047 include 'COMMON.VAR'
7048 include 'COMMON.GEO'
7049 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7051 iti1 = itortyp(itype(i+1))
7052 if (j.lt.nres-1) then
7053 itj1 = itortyp(itype(j+1))
7058 dipi(iii,1)=Ub2(iii,i)
7059 dipderi(iii)=Ub2der(iii,i)
7060 dipi(iii,2)=b1(iii,i+1)
7061 dipj(iii,1)=Ub2(iii,j)
7062 dipderj(iii)=Ub2der(iii,j)
7063 dipj(iii,2)=b1(iii,j+1)
7067 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7070 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7077 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7081 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7086 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7087 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7089 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7091 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7093 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7098 C---------------------------------------------------------------------------
7099 subroutine calc_eello(i,j,k,l,jj,kk)
7101 C This subroutine computes matrices and vectors needed to calculate
7102 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7104 implicit real*8 (a-h,o-z)
7105 include 'DIMENSIONS'
7106 include 'COMMON.IOUNITS'
7107 include 'COMMON.CHAIN'
7108 include 'COMMON.DERIV'
7109 include 'COMMON.INTERACT'
7110 include 'COMMON.CONTACTS'
7111 include 'COMMON.TORSION'
7112 include 'COMMON.VAR'
7113 include 'COMMON.GEO'
7114 include 'COMMON.FFIELD'
7115 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7116 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7119 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7120 cd & ' jj=',jj,' kk=',kk
7121 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7122 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7123 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7126 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7127 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7130 call transpose2(aa1(1,1),aa1t(1,1))
7131 call transpose2(aa2(1,1),aa2t(1,1))
7134 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7135 & aa1tder(1,1,lll,kkk))
7136 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7137 & aa2tder(1,1,lll,kkk))
7141 C parallel orientation of the two CA-CA-CA frames.
7143 iti=itortyp(itype(i))
7147 itk1=itortyp(itype(k+1))
7148 itj=itortyp(itype(j))
7149 if (l.lt.nres-1) then
7150 itl1=itortyp(itype(l+1))
7154 C A1 kernel(j+1) A2T
7156 cd write (iout,'(3f10.5,5x,3f10.5)')
7157 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7159 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7160 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7161 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7162 C Following matrices are needed only for 6-th order cumulants
7163 IF (wcorr6.gt.0.0d0) THEN
7164 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7165 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7166 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7167 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7168 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7169 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7170 & ADtEAderx(1,1,1,1,1,1))
7172 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7173 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7174 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7175 & ADtEA1derx(1,1,1,1,1,1))
7177 C End 6-th order cumulants
7180 cd write (2,*) 'In calc_eello6'
7182 cd write (2,*) 'iii=',iii
7184 cd write (2,*) 'kkk=',kkk
7186 cd write (2,'(3(2f10.5),5x)')
7187 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7192 call transpose2(EUgder(1,1,k),auxmat(1,1))
7193 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7194 call transpose2(EUg(1,1,k),auxmat(1,1))
7195 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7196 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7200 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7201 & EAEAderx(1,1,lll,kkk,iii,1))
7205 C A1T kernel(i+1) A2
7206 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7207 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7208 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7209 C Following matrices are needed only for 6-th order cumulants
7210 IF (wcorr6.gt.0.0d0) THEN
7211 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7212 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7213 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7214 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7215 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7216 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7217 & ADtEAderx(1,1,1,1,1,2))
7218 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7219 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7220 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7221 & ADtEA1derx(1,1,1,1,1,2))
7223 C End 6-th order cumulants
7224 call transpose2(EUgder(1,1,l),auxmat(1,1))
7225 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7226 call transpose2(EUg(1,1,l),auxmat(1,1))
7227 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7228 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7232 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7233 & EAEAderx(1,1,lll,kkk,iii,2))
7238 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7239 C They are needed only when the fifth- or the sixth-order cumulants are
7241 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7242 call transpose2(AEA(1,1,1),auxmat(1,1))
7243 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7244 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7245 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7246 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7247 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7248 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7249 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7250 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7251 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7252 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7253 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7254 call transpose2(AEA(1,1,2),auxmat(1,1))
7255 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7256 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7257 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7258 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7259 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7260 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7261 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7262 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7263 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7264 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7265 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7266 C Calculate the Cartesian derivatives of the vectors.
7270 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7271 call matvec2(auxmat(1,1),b1(1,i),
7272 & AEAb1derx(1,lll,kkk,iii,1,1))
7273 call matvec2(auxmat(1,1),Ub2(1,i),
7274 & AEAb2derx(1,lll,kkk,iii,1,1))
7275 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7276 & AEAb1derx(1,lll,kkk,iii,2,1))
7277 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7278 & AEAb2derx(1,lll,kkk,iii,2,1))
7279 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7280 call matvec2(auxmat(1,1),b1(1,j),
7281 & AEAb1derx(1,lll,kkk,iii,1,2))
7282 call matvec2(auxmat(1,1),Ub2(1,j),
7283 & AEAb2derx(1,lll,kkk,iii,1,2))
7284 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7285 & AEAb1derx(1,lll,kkk,iii,2,2))
7286 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7287 & AEAb2derx(1,lll,kkk,iii,2,2))
7294 C Antiparallel orientation of the two CA-CA-CA frames.
7296 iti=itortyp(itype(i))
7300 itk1=itortyp(itype(k+1))
7301 itl=itortyp(itype(l))
7302 itj=itortyp(itype(j))
7303 if (j.lt.nres-1) then
7304 itj1=itortyp(itype(j+1))
7308 C A2 kernel(j-1)T A1T
7309 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7310 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7311 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7312 C Following matrices are needed only for 6-th order cumulants
7313 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7314 & j.eq.i+4 .and. l.eq.i+3)) THEN
7315 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7316 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7317 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7318 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7319 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7320 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7321 & ADtEAderx(1,1,1,1,1,1))
7322 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7323 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7324 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7325 & ADtEA1derx(1,1,1,1,1,1))
7327 C End 6-th order cumulants
7328 call transpose2(EUgder(1,1,k),auxmat(1,1))
7329 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7330 call transpose2(EUg(1,1,k),auxmat(1,1))
7331 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7332 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7336 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7337 & EAEAderx(1,1,lll,kkk,iii,1))
7341 C A2T kernel(i+1)T A1
7342 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7343 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7344 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7345 C Following matrices are needed only for 6-th order cumulants
7346 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7347 & j.eq.i+4 .and. l.eq.i+3)) THEN
7348 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7349 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7350 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7351 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7352 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7353 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7354 & ADtEAderx(1,1,1,1,1,2))
7355 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7356 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7357 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7358 & ADtEA1derx(1,1,1,1,1,2))
7360 C End 6-th order cumulants
7361 call transpose2(EUgder(1,1,j),auxmat(1,1))
7362 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7363 call transpose2(EUg(1,1,j),auxmat(1,1))
7364 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7365 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7369 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7370 & EAEAderx(1,1,lll,kkk,iii,2))
7375 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7376 C They are needed only when the fifth- or the sixth-order cumulants are
7378 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7379 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7380 call transpose2(AEA(1,1,1),auxmat(1,1))
7381 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7382 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7383 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7384 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7385 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7386 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7387 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7388 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7389 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7390 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7391 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7392 call transpose2(AEA(1,1,2),auxmat(1,1))
7393 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7394 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7395 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7396 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7397 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7398 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7399 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7400 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7401 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7402 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7403 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7404 C Calculate the Cartesian derivatives of the vectors.
7408 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7409 call matvec2(auxmat(1,1),b1(1,i),
7410 & AEAb1derx(1,lll,kkk,iii,1,1))
7411 call matvec2(auxmat(1,1),Ub2(1,i),
7412 & AEAb2derx(1,lll,kkk,iii,1,1))
7413 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7414 & AEAb1derx(1,lll,kkk,iii,2,1))
7415 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7416 & AEAb2derx(1,lll,kkk,iii,2,1))
7417 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7418 call matvec2(auxmat(1,1),b1(1,l),
7419 & AEAb1derx(1,lll,kkk,iii,1,2))
7420 call matvec2(auxmat(1,1),Ub2(1,l),
7421 & AEAb2derx(1,lll,kkk,iii,1,2))
7422 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7423 & AEAb1derx(1,lll,kkk,iii,2,2))
7424 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7425 & AEAb2derx(1,lll,kkk,iii,2,2))
7434 C---------------------------------------------------------------------------
7435 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7436 & KK,KKderg,AKA,AKAderg,AKAderx)
7440 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7441 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7442 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7447 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7449 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7452 cd if (lprn) write (2,*) 'In kernel'
7454 cd if (lprn) write (2,*) 'kkk=',kkk
7456 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7457 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7459 cd write (2,*) 'lll=',lll
7460 cd write (2,*) 'iii=1'
7462 cd write (2,'(3(2f10.5),5x)')
7463 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7466 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7467 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7469 cd write (2,*) 'lll=',lll
7470 cd write (2,*) 'iii=2'
7472 cd write (2,'(3(2f10.5),5x)')
7473 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7480 C---------------------------------------------------------------------------
7481 double precision function eello4(i,j,k,l,jj,kk)
7482 implicit real*8 (a-h,o-z)
7483 include 'DIMENSIONS'
7484 include 'COMMON.IOUNITS'
7485 include 'COMMON.CHAIN'
7486 include 'COMMON.DERIV'
7487 include 'COMMON.INTERACT'
7488 include 'COMMON.CONTACTS'
7489 include 'COMMON.TORSION'
7490 include 'COMMON.VAR'
7491 include 'COMMON.GEO'
7492 double precision pizda(2,2),ggg1(3),ggg2(3)
7493 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7497 cd print *,'eello4:',i,j,k,l,jj,kk
7498 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7499 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7500 cold eij=facont_hb(jj,i)
7501 cold ekl=facont_hb(kk,k)
7503 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7504 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7505 gcorr_loc(k-1)=gcorr_loc(k-1)
7506 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7508 gcorr_loc(l-1)=gcorr_loc(l-1)
7509 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7511 gcorr_loc(j-1)=gcorr_loc(j-1)
7512 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7517 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7518 & -EAEAderx(2,2,lll,kkk,iii,1)
7519 cd derx(lll,kkk,iii)=0.0d0
7523 cd gcorr_loc(l-1)=0.0d0
7524 cd gcorr_loc(j-1)=0.0d0
7525 cd gcorr_loc(k-1)=0.0d0
7527 cd write (iout,*)'Contacts have occurred for peptide groups',
7528 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7529 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7530 if (j.lt.nres-1) then
7537 if (l.lt.nres-1) then
7545 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7546 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7547 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7548 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7549 cgrad ghalf=0.5d0*ggg1(ll)
7550 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7551 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7552 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7553 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7554 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7555 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7556 cgrad ghalf=0.5d0*ggg2(ll)
7557 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7558 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7559 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7560 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7561 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7562 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7566 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7571 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7576 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7581 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7585 cd write (2,*) iii,gcorr_loc(iii)
7588 cd write (2,*) 'ekont',ekont
7589 cd write (iout,*) 'eello4',ekont*eel4
7592 C---------------------------------------------------------------------------
7593 double precision function eello5(i,j,k,l,jj,kk)
7594 implicit real*8 (a-h,o-z)
7595 include 'DIMENSIONS'
7596 include 'COMMON.IOUNITS'
7597 include 'COMMON.CHAIN'
7598 include 'COMMON.DERIV'
7599 include 'COMMON.INTERACT'
7600 include 'COMMON.CONTACTS'
7601 include 'COMMON.TORSION'
7602 include 'COMMON.VAR'
7603 include 'COMMON.GEO'
7604 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7605 double precision ggg1(3),ggg2(3)
7606 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7611 C /l\ / \ \ / \ / \ / C
7612 C / \ / \ \ / \ / \ / C
7613 C j| o |l1 | o | o| o | | o |o C
7614 C \ |/k\| |/ \| / |/ \| |/ \| C
7615 C \i/ \ / \ / / \ / \ C
7617 C (I) (II) (III) (IV) C
7619 C eello5_1 eello5_2 eello5_3 eello5_4 C
7621 C Antiparallel chains C
7624 C /j\ / \ \ / \ / \ / C
7625 C / \ / \ \ / \ / \ / C
7626 C j1| o |l | o | o| o | | o |o C
7627 C \ |/k\| |/ \| / |/ \| |/ \| C
7628 C \i/ \ / \ / / \ / \ C
7630 C (I) (II) (III) (IV) C
7632 C eello5_1 eello5_2 eello5_3 eello5_4 C
7634 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7636 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7637 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7642 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7644 itk=itortyp(itype(k))
7645 itl=itortyp(itype(l))
7646 itj=itortyp(itype(j))
7651 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7652 cd & eel5_3_num,eel5_4_num)
7656 derx(lll,kkk,iii)=0.0d0
7660 cd eij=facont_hb(jj,i)
7661 cd ekl=facont_hb(kk,k)
7663 cd write (iout,*)'Contacts have occurred for peptide groups',
7664 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7666 C Contribution from the graph I.
7667 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7668 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7669 call transpose2(EUg(1,1,k),auxmat(1,1))
7670 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7671 vv(1)=pizda(1,1)-pizda(2,2)
7672 vv(2)=pizda(1,2)+pizda(2,1)
7673 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7674 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7675 C Explicit gradient in virtual-dihedral angles.
7676 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7677 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7678 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7679 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7680 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7681 vv(1)=pizda(1,1)-pizda(2,2)
7682 vv(2)=pizda(1,2)+pizda(2,1)
7683 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7684 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7685 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7686 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7687 vv(1)=pizda(1,1)-pizda(2,2)
7688 vv(2)=pizda(1,2)+pizda(2,1)
7690 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7691 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7692 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7694 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7695 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7696 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7698 C Cartesian gradient
7702 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7704 vv(1)=pizda(1,1)-pizda(2,2)
7705 vv(2)=pizda(1,2)+pizda(2,1)
7706 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7707 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7708 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7714 C Contribution from graph II
7715 call transpose2(EE(1,1,itk),auxmat(1,1))
7716 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7717 vv(1)=pizda(1,1)+pizda(2,2)
7718 vv(2)=pizda(2,1)-pizda(1,2)
7719 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
7720 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7721 C Explicit gradient in virtual-dihedral angles.
7722 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7723 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7724 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7725 vv(1)=pizda(1,1)+pizda(2,2)
7726 vv(2)=pizda(2,1)-pizda(1,2)
7728 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7729 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7730 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7732 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7733 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7734 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7736 C Cartesian gradient
7740 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7742 vv(1)=pizda(1,1)+pizda(2,2)
7743 vv(2)=pizda(2,1)-pizda(1,2)
7744 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7745 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
7746 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7754 C Parallel orientation
7755 C Contribution from graph III
7756 call transpose2(EUg(1,1,l),auxmat(1,1))
7757 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7758 vv(1)=pizda(1,1)-pizda(2,2)
7759 vv(2)=pizda(1,2)+pizda(2,1)
7760 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7761 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7762 C Explicit gradient in virtual-dihedral angles.
7763 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7764 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7765 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7766 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7767 vv(1)=pizda(1,1)-pizda(2,2)
7768 vv(2)=pizda(1,2)+pizda(2,1)
7769 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7770 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7771 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7772 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7773 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7774 vv(1)=pizda(1,1)-pizda(2,2)
7775 vv(2)=pizda(1,2)+pizda(2,1)
7776 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7777 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7778 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7779 C Cartesian gradient
7783 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7785 vv(1)=pizda(1,1)-pizda(2,2)
7786 vv(2)=pizda(1,2)+pizda(2,1)
7787 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7788 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7789 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7794 C Contribution from graph IV
7796 call transpose2(EE(1,1,itl),auxmat(1,1))
7797 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7798 vv(1)=pizda(1,1)+pizda(2,2)
7799 vv(2)=pizda(2,1)-pizda(1,2)
7800 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
7801 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7802 C Explicit gradient in virtual-dihedral angles.
7803 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7804 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7805 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7806 vv(1)=pizda(1,1)+pizda(2,2)
7807 vv(2)=pizda(2,1)-pizda(1,2)
7808 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7809 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
7810 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7811 C Cartesian gradient
7815 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7817 vv(1)=pizda(1,1)+pizda(2,2)
7818 vv(2)=pizda(2,1)-pizda(1,2)
7819 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7820 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
7821 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7826 C Antiparallel orientation
7827 C Contribution from graph III
7829 call transpose2(EUg(1,1,j),auxmat(1,1))
7830 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7831 vv(1)=pizda(1,1)-pizda(2,2)
7832 vv(2)=pizda(1,2)+pizda(2,1)
7833 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7834 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7835 C Explicit gradient in virtual-dihedral angles.
7836 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7837 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7838 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7839 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7840 vv(1)=pizda(1,1)-pizda(2,2)
7841 vv(2)=pizda(1,2)+pizda(2,1)
7842 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7843 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7844 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7845 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7846 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7847 vv(1)=pizda(1,1)-pizda(2,2)
7848 vv(2)=pizda(1,2)+pizda(2,1)
7849 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7850 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7851 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7852 C Cartesian gradient
7856 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7858 vv(1)=pizda(1,1)-pizda(2,2)
7859 vv(2)=pizda(1,2)+pizda(2,1)
7860 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7861 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7862 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7867 C Contribution from graph IV
7869 call transpose2(EE(1,1,itj),auxmat(1,1))
7870 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7871 vv(1)=pizda(1,1)+pizda(2,2)
7872 vv(2)=pizda(2,1)-pizda(1,2)
7873 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
7874 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7875 C Explicit gradient in virtual-dihedral angles.
7876 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7877 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7878 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7879 vv(1)=pizda(1,1)+pizda(2,2)
7880 vv(2)=pizda(2,1)-pizda(1,2)
7881 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7882 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
7883 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7884 C Cartesian gradient
7888 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7890 vv(1)=pizda(1,1)+pizda(2,2)
7891 vv(2)=pizda(2,1)-pizda(1,2)
7892 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7893 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
7894 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7900 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7901 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7902 cd write (2,*) 'ijkl',i,j,k,l
7903 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7904 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7906 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7907 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7908 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7909 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7910 if (j.lt.nres-1) then
7917 if (l.lt.nres-1) then
7927 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7928 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7929 C summed up outside the subrouine as for the other subroutines
7930 C handling long-range interactions. The old code is commented out
7931 C with "cgrad" to keep track of changes.
7933 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7934 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7935 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7936 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7937 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7938 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7939 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7940 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7941 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7942 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7944 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7945 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7946 cgrad ghalf=0.5d0*ggg1(ll)
7948 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7949 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7950 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7951 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7952 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7953 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7954 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7955 cgrad ghalf=0.5d0*ggg2(ll)
7957 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7958 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7959 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7960 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7961 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7962 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7967 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7968 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7973 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7974 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7980 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7985 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7989 cd write (2,*) iii,g_corr5_loc(iii)
7992 cd write (2,*) 'ekont',ekont
7993 cd write (iout,*) 'eello5',ekont*eel5
7996 c--------------------------------------------------------------------------
7997 double precision function eello6(i,j,k,l,jj,kk)
7998 implicit real*8 (a-h,o-z)
7999 include 'DIMENSIONS'
8000 include 'COMMON.IOUNITS'
8001 include 'COMMON.CHAIN'
8002 include 'COMMON.DERIV'
8003 include 'COMMON.INTERACT'
8004 include 'COMMON.CONTACTS'
8005 include 'COMMON.TORSION'
8006 include 'COMMON.VAR'
8007 include 'COMMON.GEO'
8008 include 'COMMON.FFIELD'
8009 double precision ggg1(3),ggg2(3)
8010 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8015 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8023 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8024 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8028 derx(lll,kkk,iii)=0.0d0
8032 cd eij=facont_hb(jj,i)
8033 cd ekl=facont_hb(kk,k)
8039 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8040 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8041 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8042 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8043 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8044 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8046 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8047 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8048 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8049 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8050 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8051 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8055 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8057 C If turn contributions are considered, they will be handled separately.
8058 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8059 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8060 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8061 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8062 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8063 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8064 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8066 if (j.lt.nres-1) then
8073 if (l.lt.nres-1) then
8081 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8082 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8083 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8084 cgrad ghalf=0.5d0*ggg1(ll)
8086 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8087 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8088 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8089 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8090 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8091 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8092 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8093 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8094 cgrad ghalf=0.5d0*ggg2(ll)
8095 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8097 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8098 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8099 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8100 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8101 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8102 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8107 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8108 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8113 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8114 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8120 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8125 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8129 cd write (2,*) iii,g_corr6_loc(iii)
8132 cd write (2,*) 'ekont',ekont
8133 cd write (iout,*) 'eello6',ekont*eel6
8136 c--------------------------------------------------------------------------
8137 double precision function eello6_graph1(i,j,k,l,imat,swap)
8138 implicit real*8 (a-h,o-z)
8139 include 'DIMENSIONS'
8140 include 'COMMON.IOUNITS'
8141 include 'COMMON.CHAIN'
8142 include 'COMMON.DERIV'
8143 include 'COMMON.INTERACT'
8144 include 'COMMON.CONTACTS'
8145 include 'COMMON.TORSION'
8146 include 'COMMON.VAR'
8147 include 'COMMON.GEO'
8148 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8152 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8154 C Parallel Antiparallel C
8160 C \ j|/k\| / \ |/k\|l / C
8165 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8166 itk=itortyp(itype(k))
8167 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8168 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8169 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8170 call transpose2(EUgC(1,1,k),auxmat(1,1))
8171 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8172 vv1(1)=pizda1(1,1)-pizda1(2,2)
8173 vv1(2)=pizda1(1,2)+pizda1(2,1)
8174 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8175 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8176 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8177 s5=scalar2(vv(1),Dtobr2(1,i))
8178 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8179 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8180 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8181 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8182 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8183 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8184 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8185 & +scalar2(vv(1),Dtobr2der(1,i)))
8186 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8187 vv1(1)=pizda1(1,1)-pizda1(2,2)
8188 vv1(2)=pizda1(1,2)+pizda1(2,1)
8189 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8190 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8192 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8193 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8194 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8195 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8196 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8198 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8199 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8200 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8201 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8202 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8204 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8205 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8206 vv1(1)=pizda1(1,1)-pizda1(2,2)
8207 vv1(2)=pizda1(1,2)+pizda1(2,1)
8208 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8209 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8210 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8211 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8220 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8221 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8222 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8223 call transpose2(EUgC(1,1,k),auxmat(1,1))
8224 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8226 vv1(1)=pizda1(1,1)-pizda1(2,2)
8227 vv1(2)=pizda1(1,2)+pizda1(2,1)
8228 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8229 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8230 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8231 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8232 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8233 s5=scalar2(vv(1),Dtobr2(1,i))
8234 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8240 c----------------------------------------------------------------------------
8241 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8242 implicit real*8 (a-h,o-z)
8243 include 'DIMENSIONS'
8244 include 'COMMON.IOUNITS'
8245 include 'COMMON.CHAIN'
8246 include 'COMMON.DERIV'
8247 include 'COMMON.INTERACT'
8248 include 'COMMON.CONTACTS'
8249 include 'COMMON.TORSION'
8250 include 'COMMON.VAR'
8251 include 'COMMON.GEO'
8253 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8254 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8257 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8259 C Parallel Antiparallel C
8265 C \ j|/k\| \ |/k\|l C
8270 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8271 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8272 C AL 7/4/01 s1 would occur in the sixth-order moment,
8273 C but not in a cluster cumulant
8275 s1=dip(1,jj,i)*dip(1,kk,k)
8277 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8278 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8279 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8280 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8281 call transpose2(EUg(1,1,k),auxmat(1,1))
8282 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8283 vv(1)=pizda(1,1)-pizda(2,2)
8284 vv(2)=pizda(1,2)+pizda(2,1)
8285 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8286 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8288 eello6_graph2=-(s1+s2+s3+s4)
8290 eello6_graph2=-(s2+s3+s4)
8293 C Derivatives in gamma(i-1)
8296 s1=dipderg(1,jj,i)*dip(1,kk,k)
8298 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8299 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8300 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8301 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8303 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8305 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8307 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8309 C Derivatives in gamma(k-1)
8311 s1=dip(1,jj,i)*dipderg(1,kk,k)
8313 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8314 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8315 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8316 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8317 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8318 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8319 vv(1)=pizda(1,1)-pizda(2,2)
8320 vv(2)=pizda(1,2)+pizda(2,1)
8321 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8323 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8325 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8327 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8328 C Derivatives in gamma(j-1) or gamma(l-1)
8331 s1=dipderg(3,jj,i)*dip(1,kk,k)
8333 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8334 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8335 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8336 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8337 vv(1)=pizda(1,1)-pizda(2,2)
8338 vv(2)=pizda(1,2)+pizda(2,1)
8339 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8342 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8344 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8347 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8348 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8350 C Derivatives in gamma(l-1) or gamma(j-1)
8353 s1=dip(1,jj,i)*dipderg(3,kk,k)
8355 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8356 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8357 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8358 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8359 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8360 vv(1)=pizda(1,1)-pizda(2,2)
8361 vv(2)=pizda(1,2)+pizda(2,1)
8362 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8365 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8367 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8370 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8371 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8373 C Cartesian derivatives.
8375 write (2,*) 'In eello6_graph2'
8377 write (2,*) 'iii=',iii
8379 write (2,*) 'kkk=',kkk
8381 write (2,'(3(2f10.5),5x)')
8382 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8392 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8394 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8397 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8399 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8400 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8402 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8403 call transpose2(EUg(1,1,k),auxmat(1,1))
8404 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8406 vv(1)=pizda(1,1)-pizda(2,2)
8407 vv(2)=pizda(1,2)+pizda(2,1)
8408 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8409 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8411 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8413 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8416 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8418 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8425 c----------------------------------------------------------------------------
8426 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8427 implicit real*8 (a-h,o-z)
8428 include 'DIMENSIONS'
8429 include 'COMMON.IOUNITS'
8430 include 'COMMON.CHAIN'
8431 include 'COMMON.DERIV'
8432 include 'COMMON.INTERACT'
8433 include 'COMMON.CONTACTS'
8434 include 'COMMON.TORSION'
8435 include 'COMMON.VAR'
8436 include 'COMMON.GEO'
8437 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8439 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8441 C Parallel Antiparallel C
8447 C j|/k\| / |/k\|l / C
8452 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8454 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8455 C energy moment and not to the cluster cumulant.
8456 iti=itortyp(itype(i))
8457 if (j.lt.nres-1) then
8458 itj1=itortyp(itype(j+1))
8462 itk=itortyp(itype(k))
8463 itk1=itortyp(itype(k+1))
8464 if (l.lt.nres-1) then
8465 itl1=itortyp(itype(l+1))
8470 s1=dip(4,jj,i)*dip(4,kk,k)
8472 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8473 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8474 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8475 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8476 call transpose2(EE(1,1,itk),auxmat(1,1))
8477 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8478 vv(1)=pizda(1,1)+pizda(2,2)
8479 vv(2)=pizda(2,1)-pizda(1,2)
8480 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8481 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8482 cd & "sum",-(s2+s3+s4)
8484 eello6_graph3=-(s1+s2+s3+s4)
8486 eello6_graph3=-(s2+s3+s4)
8489 C Derivatives in gamma(k-1)
8490 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8491 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8492 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8493 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8494 C Derivatives in gamma(l-1)
8495 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8496 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8497 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8498 vv(1)=pizda(1,1)+pizda(2,2)
8499 vv(2)=pizda(2,1)-pizda(1,2)
8500 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8501 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8502 C Cartesian derivatives.
8508 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8510 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8513 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8515 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8516 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8518 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8519 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8521 vv(1)=pizda(1,1)+pizda(2,2)
8522 vv(2)=pizda(2,1)-pizda(1,2)
8523 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8525 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8527 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8530 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8532 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8534 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8540 c----------------------------------------------------------------------------
8541 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8542 implicit real*8 (a-h,o-z)
8543 include 'DIMENSIONS'
8544 include 'COMMON.IOUNITS'
8545 include 'COMMON.CHAIN'
8546 include 'COMMON.DERIV'
8547 include 'COMMON.INTERACT'
8548 include 'COMMON.CONTACTS'
8549 include 'COMMON.TORSION'
8550 include 'COMMON.VAR'
8551 include 'COMMON.GEO'
8552 include 'COMMON.FFIELD'
8553 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8554 & auxvec1(2),auxmat1(2,2)
8556 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8558 C Parallel Antiparallel C
8564 C \ j|/k\| \ |/k\|l C
8569 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8571 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8572 C energy moment and not to the cluster cumulant.
8573 cd write (2,*) 'eello_graph4: wturn6',wturn6
8574 iti=itortyp(itype(i))
8575 itj=itortyp(itype(j))
8576 if (j.lt.nres-1) then
8577 itj1=itortyp(itype(j+1))
8581 itk=itortyp(itype(k))
8582 if (k.lt.nres-1) then
8583 itk1=itortyp(itype(k+1))
8587 itl=itortyp(itype(l))
8588 if (l.lt.nres-1) then
8589 itl1=itortyp(itype(l+1))
8593 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8594 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8595 cd & ' itl',itl,' itl1',itl1
8598 s1=dip(3,jj,i)*dip(3,kk,k)
8600 s1=dip(2,jj,j)*dip(2,kk,l)
8603 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8604 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8606 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
8607 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8609 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
8610 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8612 call transpose2(EUg(1,1,k),auxmat(1,1))
8613 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8614 vv(1)=pizda(1,1)-pizda(2,2)
8615 vv(2)=pizda(2,1)+pizda(1,2)
8616 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8617 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8619 eello6_graph4=-(s1+s2+s3+s4)
8621 eello6_graph4=-(s2+s3+s4)
8623 C Derivatives in gamma(i-1)
8627 s1=dipderg(2,jj,i)*dip(3,kk,k)
8629 s1=dipderg(4,jj,j)*dip(2,kk,l)
8632 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8634 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
8635 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8637 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
8638 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8640 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8641 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8642 cd write (2,*) 'turn6 derivatives'
8644 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8646 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8650 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8652 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8656 C Derivatives in gamma(k-1)
8659 s1=dip(3,jj,i)*dipderg(2,kk,k)
8661 s1=dip(2,jj,j)*dipderg(4,kk,l)
8664 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8665 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8667 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
8668 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8670 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
8671 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8673 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8674 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8675 vv(1)=pizda(1,1)-pizda(2,2)
8676 vv(2)=pizda(2,1)+pizda(1,2)
8677 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8678 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8680 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8682 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8686 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8688 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8691 C Derivatives in gamma(j-1) or gamma(l-1)
8692 if (l.eq.j+1 .and. l.gt.1) then
8693 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8694 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8695 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8696 vv(1)=pizda(1,1)-pizda(2,2)
8697 vv(2)=pizda(2,1)+pizda(1,2)
8698 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8699 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8700 else if (j.gt.1) then
8701 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8702 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8703 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8704 vv(1)=pizda(1,1)-pizda(2,2)
8705 vv(2)=pizda(2,1)+pizda(1,2)
8706 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8707 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8708 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8710 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8713 C Cartesian derivatives.
8720 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8722 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8726 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8728 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8732 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8734 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8736 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8737 & b1(1,j+1),auxvec(1))
8738 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
8740 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8741 & b1(1,l+1),auxvec(1))
8742 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
8744 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8746 vv(1)=pizda(1,1)-pizda(2,2)
8747 vv(2)=pizda(2,1)+pizda(1,2)
8748 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8750 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8752 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8755 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8758 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8761 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8763 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8765 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8769 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8771 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8774 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8776 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8784 c----------------------------------------------------------------------------
8785 double precision function eello_turn6(i,jj,kk)
8786 implicit real*8 (a-h,o-z)
8787 include 'DIMENSIONS'
8788 include 'COMMON.IOUNITS'
8789 include 'COMMON.CHAIN'
8790 include 'COMMON.DERIV'
8791 include 'COMMON.INTERACT'
8792 include 'COMMON.CONTACTS'
8793 include 'COMMON.TORSION'
8794 include 'COMMON.VAR'
8795 include 'COMMON.GEO'
8796 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8797 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8799 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8800 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8801 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8802 C the respective energy moment and not to the cluster cumulant.
8811 iti=itortyp(itype(i))
8812 itk=itortyp(itype(k))
8813 itk1=itortyp(itype(k+1))
8814 itl=itortyp(itype(l))
8815 itj=itortyp(itype(j))
8816 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8817 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8818 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8823 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8825 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8829 derx_turn(lll,kkk,iii)=0.0d0
8836 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8838 cd write (2,*) 'eello6_5',eello6_5
8840 call transpose2(AEA(1,1,1),auxmat(1,1))
8841 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8842 ss1=scalar2(Ub2(1,i+2),b1(1,l))
8843 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8845 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8846 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8847 s2 = scalar2(b1(1,k),vtemp1(1))
8849 call transpose2(AEA(1,1,2),atemp(1,1))
8850 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8851 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8852 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8854 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8855 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8856 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8858 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8859 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8860 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8861 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8862 ss13 = scalar2(b1(1,k),vtemp4(1))
8863 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8865 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8871 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8872 C Derivatives in gamma(i+2)
8876 call transpose2(AEA(1,1,1),auxmatd(1,1))
8877 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8878 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8879 call transpose2(AEAderg(1,1,2),atempd(1,1))
8880 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8881 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8883 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8884 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8885 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8891 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8892 C Derivatives in gamma(i+3)
8894 call transpose2(AEA(1,1,1),auxmatd(1,1))
8895 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8896 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
8897 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8899 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
8900 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8901 s2d = scalar2(b1(1,k),vtemp1d(1))
8903 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8904 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8906 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8908 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8909 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8910 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8918 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8919 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8921 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8922 & -0.5d0*ekont*(s2d+s12d)
8924 C Derivatives in gamma(i+4)
8925 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8926 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8927 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8929 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8930 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8931 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8939 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8941 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8943 C Derivatives in gamma(i+5)
8945 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8946 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8947 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8949 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
8950 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8951 s2d = scalar2(b1(1,k),vtemp1d(1))
8953 call transpose2(AEA(1,1,2),atempd(1,1))
8954 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8955 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8957 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8958 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8960 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8961 ss13d = scalar2(b1(1,k),vtemp4d(1))
8962 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8970 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8971 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8973 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8974 & -0.5d0*ekont*(s2d+s12d)
8976 C Cartesian derivatives
8981 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8982 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8983 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8985 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8986 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8988 s2d = scalar2(b1(1,k),vtemp1d(1))
8990 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8991 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8992 s8d = -(atempd(1,1)+atempd(2,2))*
8993 & scalar2(cc(1,1,itl),vtemp2(1))
8995 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8997 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8998 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9005 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9008 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9012 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9013 & - 0.5d0*(s8d+s12d)
9015 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9024 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9026 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9027 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9028 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9029 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9030 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9032 ss13d = scalar2(b1(1,k),vtemp4d(1))
9033 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9034 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9038 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9039 cd & 16*eel_turn6_num
9041 if (j.lt.nres-1) then
9048 if (l.lt.nres-1) then
9056 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9057 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9058 cgrad ghalf=0.5d0*ggg1(ll)
9060 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9061 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9062 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9063 & +ekont*derx_turn(ll,2,1)
9064 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9065 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9066 & +ekont*derx_turn(ll,4,1)
9067 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9068 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9069 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9070 cgrad ghalf=0.5d0*ggg2(ll)
9072 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9073 & +ekont*derx_turn(ll,2,2)
9074 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9075 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9076 & +ekont*derx_turn(ll,4,2)
9077 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9078 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9079 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9084 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9089 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9095 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9100 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9104 cd write (2,*) iii,g_corr6_loc(iii)
9106 eello_turn6=ekont*eel_turn6
9107 cd write (2,*) 'ekont',ekont
9108 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9112 C-----------------------------------------------------------------------------
9113 double precision function scalar(u,v)
9114 !DIR$ INLINEALWAYS scalar
9116 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9119 double precision u(3),v(3)
9120 cd double precision sc
9128 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9131 crc-------------------------------------------------
9132 SUBROUTINE MATVEC2(A1,V1,V2)
9133 !DIR$ INLINEALWAYS MATVEC2
9135 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9137 implicit real*8 (a-h,o-z)
9138 include 'DIMENSIONS'
9139 DIMENSION A1(2,2),V1(2),V2(2)
9143 c 3 VI=VI+A1(I,K)*V1(K)
9147 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9148 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9153 C---------------------------------------
9154 SUBROUTINE MATMAT2(A1,A2,A3)
9156 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9158 implicit real*8 (a-h,o-z)
9159 include 'DIMENSIONS'
9160 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9161 c DIMENSION AI3(2,2)
9165 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9171 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9172 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9173 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9174 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9182 c-------------------------------------------------------------------------
9183 double precision function scalar2(u,v)
9184 !DIR$ INLINEALWAYS scalar2
9186 double precision u(2),v(2)
9189 scalar2=u(1)*v(1)+u(2)*v(2)
9193 C-----------------------------------------------------------------------------
9195 subroutine transpose2(a,at)
9196 !DIR$ INLINEALWAYS transpose2
9198 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9201 double precision a(2,2),at(2,2)
9208 c--------------------------------------------------------------------------
9209 subroutine transpose(n,a,at)
9212 double precision a(n,n),at(n,n)
9220 C---------------------------------------------------------------------------
9221 subroutine prodmat3(a1,a2,kk,transp,prod)
9222 !DIR$ INLINEALWAYS prodmat3
9224 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9228 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9230 crc double precision auxmat(2,2),prod_(2,2)
9233 crc call transpose2(kk(1,1),auxmat(1,1))
9234 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9235 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9237 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9238 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9239 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9240 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9241 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9242 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9243 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9244 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9247 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9248 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9250 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9251 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9252 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9253 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9254 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9255 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9256 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9257 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9260 c call transpose2(a2(1,1),a2t(1,1))
9263 crc print *,((prod_(i,j),i=1,2),j=1,2)
9264 crc print *,((prod(i,j),i=1,2),j=1,2)