1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
30 if (nfgtasks.gt.1) then
32 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
33 if (fg_rank.eq.0) then
34 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
35 c print *,"Processor",myrank," BROADCAST iorder"
36 C FG master sets up the WEIGHTS_ array which will be broadcast to the
37 C FG slaves as WEIGHTS array.
57 C FG Master broadcasts the WEIGHTS_ array
58 call MPI_Bcast(weights_(1),n_ene,
59 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
61 C FG slaves receive the WEIGHTS array
62 call MPI_Bcast(weights(1),n_ene,
63 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
84 time_Bcast=time_Bcast+MPI_Wtime()-time00
85 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
86 c call chainbuild_cart
88 c print *,'Processor',myrank,' calling etotal ipot=',ipot
89 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
91 c if (modecalc.eq.12.or.modecalc.eq.14) then
92 c call int_from_cart1(.false.)
99 C Compute the side-chain and electrostatic interaction energy
101 goto (101,102,103,104,105,106) ipot
102 C Lennard-Jones potential.
104 cd print '(a)','Exit ELJ'
106 C Lennard-Jones-Kihara potential (shifted).
109 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 C Gay-Berne potential (shifted LJ, angular dependence).
115 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 C Soft-sphere potential
119 106 call e_softsphere(evdw)
121 C Calculate electrostatic (H-bonding) energy of the main chain.
124 c print *,"Processor",myrank," computed USCSC"
130 time_vec=time_vec+MPI_Wtime()-time01
132 c print *,"Processor",myrank," left VEC_AND_DERIV"
135 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
136 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
137 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
138 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
140 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
141 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
142 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
143 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
145 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
154 c write (iout,*) "Soft-spheer ELEC potential"
155 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
158 c print *,"Processor",myrank," computed UELEC"
160 C Calculate excluded-volume interaction energy between peptide groups
165 call escp(evdw2,evdw2_14)
171 c write (iout,*) "Soft-sphere SCP potential"
172 call escp_soft_sphere(evdw2,evdw2_14)
175 c Calculate the bond-stretching energy
179 C Calculate the disulfide-bridge and other energy and the contributions
180 C from other distance constraints.
181 cd print *,'Calling EHPB'
183 cd print *,'EHPB exitted succesfully.'
185 C Calculate the virtual-bond-angle energy.
187 if (wang.gt.0d0) then
192 c print *,"Processor",myrank," computed UB"
194 C Calculate the SC local energy.
197 c print *,"Processor",myrank," computed USC"
199 C Calculate the virtual-bond torsional energy.
201 cd print *,'nterm=',nterm
203 call etor(etors,edihcnstr)
208 c print *,"Processor",myrank," computed Utor"
210 C 6/23/01 Calculate double-torsional energy
212 if (wtor_d.gt.0) then
217 c print *,"Processor",myrank," computed Utord"
219 C 21/5/07 Calculate local sicdechain correlation energy
221 if (wsccor.gt.0.0d0) then
222 call eback_sc_corr(esccor)
226 c print *,"Processor",myrank," computed Usccorr"
228 C 12/1/95 Multi-body terms
232 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
233 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
234 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
235 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
236 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
243 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
244 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
245 cd write (iout,*) "multibody_hb ecorr",ecorr
247 c print *,"Processor",myrank," computed Ucorr"
249 C If performing constraint dynamics, call the constraint energy
250 C after the equilibration time
251 if(usampl.and.totT.gt.eq_time) then
259 time_enecalc=time_enecalc+MPI_Wtime()-time00
261 c print *,"Processor",myrank," computed Uconstr"
270 energia(2)=evdw2-evdw2_14
287 energia(8)=eello_turn3
288 energia(9)=eello_turn4
295 energia(19)=edihcnstr
297 energia(20)=Uconst+Uconst_back
299 c print *," Processor",myrank," calls SUM_ENERGY"
300 call sum_energy(energia,.true.)
301 c print *," Processor",myrank," left SUM_ENERGY"
303 time_sumene=time_sumene+MPI_Wtime()-time00
307 c-------------------------------------------------------------------------------
308 subroutine sum_energy(energia,reduce)
309 implicit real*8 (a-h,o-z)
314 cMS$ATTRIBUTES C :: proc_proc
320 include 'COMMON.SETUP'
321 include 'COMMON.IOUNITS'
322 double precision energia(0:n_ene),enebuff(0:n_ene+1)
323 include 'COMMON.FFIELD'
324 include 'COMMON.DERIV'
325 include 'COMMON.INTERACT'
326 include 'COMMON.SBRIDGE'
327 include 'COMMON.CHAIN'
329 include 'COMMON.CONTROL'
330 include 'COMMON.TIME1'
333 if (nfgtasks.gt.1 .and. reduce) then
335 write (iout,*) "energies before REDUCE"
336 call enerprint(energia)
340 enebuff(i)=energia(i)
343 call MPI_Barrier(FG_COMM,IERR)
344 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
346 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
347 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
349 write (iout,*) "energies after REDUCE"
350 call enerprint(energia)
353 time_Reduce=time_Reduce+MPI_Wtime()-time00
355 if (fg_rank.eq.0) then
359 evdw2=energia(2)+energia(18)
375 eello_turn3=energia(8)
376 eello_turn4=energia(9)
383 edihcnstr=energia(19)
388 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
389 & +wang*ebe+wtor*etors+wscloc*escloc
390 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
391 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
392 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
393 & +wbond*estr+Uconst+wsccor*esccor
395 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
396 & +wang*ebe+wtor*etors+wscloc*escloc
397 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
398 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
399 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
400 & +wbond*estr+Uconst+wsccor*esccor
406 if (isnan(etot).ne.0) energia(0)=1.0d+99
408 if (isnan(etot)) energia(0)=1.0d+99
413 idumm=proc_proc(etot,i)
415 call proc_proc(etot,i)
417 if(i.eq.1)energia(0)=1.0d+99
424 c-------------------------------------------------------------------------------
425 subroutine sum_gradient
426 implicit real*8 (a-h,o-z)
431 cMS$ATTRIBUTES C :: proc_proc
436 double precision gradbufc(3,maxres),gradbufx(3,maxres),
437 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
439 include 'COMMON.SETUP'
440 include 'COMMON.IOUNITS'
441 include 'COMMON.FFIELD'
442 include 'COMMON.DERIV'
443 include 'COMMON.INTERACT'
444 include 'COMMON.SBRIDGE'
445 include 'COMMON.CHAIN'
447 include 'COMMON.CONTROL'
448 include 'COMMON.TIME1'
449 include 'COMMON.MAXGRAD'
454 write (iout,*) "sum_gradient gvdwc, gvdwx"
456 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
457 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
462 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
463 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
464 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
467 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
468 C in virtual-bond-vector coordinates
471 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
473 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
474 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
476 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
478 c write (iout,'(i5,3f10.5,2x,f10.5)')
479 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
481 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
483 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
484 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
492 gradbufc(j,i)=wsc*gvdwc(j,i)+
493 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
494 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
495 & wel_loc*gel_loc_long(j,i)+
496 & wcorr*gradcorr_long(j,i)+
497 & wcorr5*gradcorr5_long(j,i)+
498 & wcorr6*gradcorr6_long(j,i)+
499 & wturn6*gcorr6_turn_long(j,i)+
506 gradbufc(j,i)=wsc*gvdwc(j,i)+
507 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
508 & welec*gelc_long(j,i)+
510 & wel_loc*gel_loc_long(j,i)+
511 & wcorr*gradcorr_long(j,i)+
512 & wcorr5*gradcorr5_long(j,i)+
513 & wcorr6*gradcorr6_long(j,i)+
514 & wturn6*gcorr6_turn_long(j,i)+
520 if (nfgtasks.gt.1) then
523 write (iout,*) "gradbufc before allreduce"
525 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
529 call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
530 & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
531 time_reduce=time_reduce+MPI_Wtime()-time00
533 write (iout,*) "gradbufc_sum after allreduce"
535 write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
540 time_allreduce=time_allreduce+MPI_Wtime()-time00
547 do i=igrad_start,igrad_end
548 do j=jgrad_start(i),jgrad_end(i)
550 gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
557 write (iout,*) "gradbufc"
559 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
569 gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
577 gradbufc(k,nres)=0.0d0
582 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
583 & wel_loc*gel_loc(j,i)+
584 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
585 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
586 & wel_loc*gel_loc_long(j,i)+
587 & wcorr*gradcorr_long(j,i)+
588 & wcorr5*gradcorr5_long(j,i)+
589 & wcorr6*gradcorr6_long(j,i)+
590 & wturn6*gcorr6_turn_long(j,i))+
592 & wcorr*gradcorr(j,i)+
593 & wturn3*gcorr3_turn(j,i)+
594 & wturn4*gcorr4_turn(j,i)+
595 & wcorr5*gradcorr5(j,i)+
596 & wcorr6*gradcorr6(j,i)+
597 & wturn6*gcorr6_turn(j,i)+
598 & wsccor*gsccorc(j,i)
599 & +wscloc*gscloc(j,i)
601 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
602 & wel_loc*gel_loc(j,i)+
603 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
604 & welec*gelc_long(j,i)
605 & wel_loc*gel_loc_long(j,i)+
606 & wcorr*gcorr_long(j,i)+
607 & wcorr5*gradcorr5_long(j,i)+
608 & wcorr6*gradcorr6_long(j,i)+
609 & wturn6*gcorr6_turn_long(j,i))+
611 & wcorr*gradcorr(j,i)+
612 & wturn3*gcorr3_turn(j,i)+
613 & wturn4*gcorr4_turn(j,i)+
614 & wcorr5*gradcorr5(j,i)+
615 & wcorr6*gradcorr6(j,i)+
616 & wturn6*gcorr6_turn(j,i)+
617 & wsccor*gsccorc(j,i)
618 & +wscloc*gscloc(j,i)
620 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
622 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
623 & wsccor*gsccorx(j,i)
624 & +wscloc*gsclocx(j,i)
628 write (iout,*) "gloc before adding corr"
630 write (iout,*) i,gloc(i,icg)
634 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
635 & +wcorr5*g_corr5_loc(i)
636 & +wcorr6*g_corr6_loc(i)
637 & +wturn4*gel_loc_turn4(i)
638 & +wturn3*gel_loc_turn3(i)
639 & +wturn6*gel_loc_turn6(i)
640 & +wel_loc*gel_loc_loc(i)
641 & +wsccor*gsccor_loc(i)
644 write (iout,*) "gloc after adding corr"
646 write (iout,*) i,gloc(i,icg)
650 if (nfgtasks.gt.1) then
653 gradbufc(j,i)=gradc(j,i,icg)
654 gradbufx(j,i)=gradx(j,i,icg)
658 glocbuf(i)=gloc(i,icg)
661 call MPI_Barrier(FG_COMM,IERR)
662 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
664 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
665 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
666 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
667 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
668 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
669 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
670 time_reduce=time_reduce+MPI_Wtime()-time00
672 write (iout,*) "gloc after reduce"
674 write (iout,*) i,gloc(i,icg)
679 if (gnorm_check) then
681 c Compute the maximum elements of the gradient
691 gcorr3_turn_max=0.0d0
692 gcorr4_turn_max=0.0d0
695 gcorr6_turn_max=0.0d0
705 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
706 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
707 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
708 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
709 & gvdwc_scp_max=gvdwc_scp_norm
710 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
711 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
712 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
713 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
714 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
715 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
716 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
717 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
718 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
719 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
720 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
721 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
722 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
724 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
725 & gcorr3_turn_max=gcorr3_turn_norm
726 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
728 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
729 & gcorr4_turn_max=gcorr4_turn_norm
730 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
731 if (gradcorr5_norm.gt.gradcorr5_max)
732 & gradcorr5_max=gradcorr5_norm
733 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
734 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
735 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
737 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
738 & gcorr6_turn_max=gcorr6_turn_norm
739 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
740 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
741 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
742 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
743 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
744 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
745 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
746 if (gradx_scp_norm.gt.gradx_scp_max)
747 & gradx_scp_max=gradx_scp_norm
748 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
749 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
750 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
751 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
752 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
753 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
754 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
755 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
759 open(istat,file=statname,position="append")
761 open(istat,file=statname,access="append")
763 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
764 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
765 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
766 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
767 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
768 & gsccorx_max,gsclocx_max
770 if (gvdwc_max.gt.1.0d4) then
771 write (iout,*) "gvdwc gvdwx gradb gradbx"
773 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
774 & gradb(j,i),gradbx(j,i),j=1,3)
776 call pdbout(0.0d0,'cipiszcze',iout)
782 write (iout,*) "gradc gradx gloc"
784 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
785 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
789 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
793 c-------------------------------------------------------------------------------
794 subroutine rescale_weights(t_bath)
795 implicit real*8 (a-h,o-z)
797 include 'COMMON.IOUNITS'
798 include 'COMMON.FFIELD'
799 include 'COMMON.SBRIDGE'
800 double precision kfac /2.4d0/
801 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
803 c facT=2*temp0/(t_bath+temp0)
804 if (rescale_mode.eq.0) then
810 else if (rescale_mode.eq.1) then
811 facT=kfac/(kfac-1.0d0+t_bath/temp0)
812 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
813 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
814 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
815 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
816 else if (rescale_mode.eq.2) then
822 facT=licznik/dlog(dexp(x)+dexp(-x))
823 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
824 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
825 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
826 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
828 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
829 write (*,*) "Wrong RESCALE_MODE",rescale_mode
831 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
835 welec=weights(3)*fact
836 wcorr=weights(4)*fact3
837 wcorr5=weights(5)*fact4
838 wcorr6=weights(6)*fact5
839 wel_loc=weights(7)*fact2
840 wturn3=weights(8)*fact2
841 wturn4=weights(9)*fact3
842 wturn6=weights(10)*fact5
843 wtor=weights(13)*fact
844 wtor_d=weights(14)*fact2
845 wsccor=weights(21)*fact
849 C------------------------------------------------------------------------
850 subroutine enerprint(energia)
851 implicit real*8 (a-h,o-z)
853 include 'COMMON.IOUNITS'
854 include 'COMMON.FFIELD'
855 include 'COMMON.SBRIDGE'
857 double precision energia(0:n_ene)
862 evdw2=energia(2)+energia(18)
874 eello_turn3=energia(8)
875 eello_turn4=energia(9)
876 eello_turn6=energia(10)
882 edihcnstr=energia(19)
887 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
888 & estr,wbond,ebe,wang,
889 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
891 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
892 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
895 10 format (/'Virtual-chain energies:'//
896 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
897 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
898 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
899 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
900 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
901 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
902 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
903 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
904 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
905 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
906 & ' (SS bridges & dist. cnstr.)'/
907 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
908 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
909 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
910 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
911 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
912 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
913 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
914 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
915 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
916 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
917 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
918 & 'ETOT= ',1pE16.6,' (total)')
920 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
921 & estr,wbond,ebe,wang,
922 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
924 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
925 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
926 & ebr*nss,Uconst,etot
927 10 format (/'Virtual-chain energies:'//
928 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
929 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
930 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
931 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
932 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
933 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
934 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
935 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
936 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
937 & ' (SS bridges & dist. cnstr.)'/
938 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
939 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
940 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
941 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
942 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
943 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
944 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
945 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
946 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
947 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
948 & 'UCONST=',1pE16.6,' (Constraint energy)'/
949 & 'ETOT= ',1pE16.6,' (total)')
953 C-----------------------------------------------------------------------
956 C This subroutine calculates the interaction energy of nonbonded side chains
957 C assuming the LJ potential of interaction.
959 implicit real*8 (a-h,o-z)
961 parameter (accur=1.0d-10)
964 include 'COMMON.LOCAL'
965 include 'COMMON.CHAIN'
966 include 'COMMON.DERIV'
967 include 'COMMON.INTERACT'
968 include 'COMMON.TORSION'
969 include 'COMMON.SBRIDGE'
970 include 'COMMON.NAMES'
971 include 'COMMON.IOUNITS'
972 include 'COMMON.CONTACTS'
974 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
985 C Calculate SC interaction energy.
988 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
989 cd & 'iend=',iend(i,iint)
990 do j=istart(i,iint),iend(i,iint)
995 C Change 12/1/95 to calculate four-body interactions
996 rij=xj*xj+yj*yj+zj*zj
998 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
999 eps0ij=eps(itypi,itypj)
1001 e1=fac*fac*aa(itypi,itypj)
1002 e2=fac*bb(itypi,itypj)
1004 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1005 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1006 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1007 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1008 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1009 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1012 C Calculate the components of the gradient in DC and X
1014 fac=-rrij*(e1+evdwij)
1019 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1020 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1021 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1022 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1026 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1030 C 12/1/95, revised on 5/20/97
1032 C Calculate the contact function. The ith column of the array JCONT will
1033 C contain the numbers of atoms that make contacts with the atom I (of numbers
1034 C greater than I). The arrays FACONT and GACONT will contain the values of
1035 C the contact function and its derivative.
1037 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1038 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1039 C Uncomment next line, if the correlation interactions are contact function only
1040 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1042 sigij=sigma(itypi,itypj)
1043 r0ij=rs0(itypi,itypj)
1045 C Check whether the SC's are not too far to make a contact.
1048 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1049 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1051 if (fcont.gt.0.0D0) then
1052 C If the SC-SC distance if close to sigma, apply spline.
1053 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1054 cAdam & fcont1,fprimcont1)
1055 cAdam fcont1=1.0d0-fcont1
1056 cAdam if (fcont1.gt.0.0d0) then
1057 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1058 cAdam fcont=fcont*fcont1
1060 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1061 cga eps0ij=1.0d0/dsqrt(eps0ij)
1063 cga gg(k)=gg(k)*eps0ij
1065 cga eps0ij=-evdwij*eps0ij
1066 C Uncomment for AL's type of SC correlation interactions.
1067 cadam eps0ij=-evdwij
1068 num_conti=num_conti+1
1069 jcont(num_conti,i)=j
1070 facont(num_conti,i)=fcont*eps0ij
1071 fprimcont=eps0ij*fprimcont/rij
1073 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1074 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1075 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1076 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1077 gacont(1,num_conti,i)=-fprimcont*xj
1078 gacont(2,num_conti,i)=-fprimcont*yj
1079 gacont(3,num_conti,i)=-fprimcont*zj
1080 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1081 cd write (iout,'(2i3,3f10.5)')
1082 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1088 num_cont(i)=num_conti
1092 gvdwc(j,i)=expon*gvdwc(j,i)
1093 gvdwx(j,i)=expon*gvdwx(j,i)
1096 C******************************************************************************
1100 C To save time, the factor of EXPON has been extracted from ALL components
1101 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1104 C******************************************************************************
1107 C-----------------------------------------------------------------------------
1108 subroutine eljk(evdw)
1110 C This subroutine calculates the interaction energy of nonbonded side chains
1111 C assuming the LJK potential of interaction.
1113 implicit real*8 (a-h,o-z)
1114 include 'DIMENSIONS'
1115 include 'COMMON.GEO'
1116 include 'COMMON.VAR'
1117 include 'COMMON.LOCAL'
1118 include 'COMMON.CHAIN'
1119 include 'COMMON.DERIV'
1120 include 'COMMON.INTERACT'
1121 include 'COMMON.IOUNITS'
1122 include 'COMMON.NAMES'
1125 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1127 do i=iatsc_s,iatsc_e
1134 C Calculate SC interaction energy.
1136 do iint=1,nint_gr(i)
1137 do j=istart(i,iint),iend(i,iint)
1142 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1143 fac_augm=rrij**expon
1144 e_augm=augm(itypi,itypj)*fac_augm
1145 r_inv_ij=dsqrt(rrij)
1147 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1148 fac=r_shift_inv**expon
1149 e1=fac*fac*aa(itypi,itypj)
1150 e2=fac*bb(itypi,itypj)
1152 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1153 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1154 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1155 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1156 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1157 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1158 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1161 C Calculate the components of the gradient in DC and X
1163 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1168 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1169 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1170 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1171 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1175 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1183 gvdwc(j,i)=expon*gvdwc(j,i)
1184 gvdwx(j,i)=expon*gvdwx(j,i)
1189 C-----------------------------------------------------------------------------
1190 subroutine ebp(evdw)
1192 C This subroutine calculates the interaction energy of nonbonded side chains
1193 C assuming the Berne-Pechukas potential of interaction.
1195 implicit real*8 (a-h,o-z)
1196 include 'DIMENSIONS'
1197 include 'COMMON.GEO'
1198 include 'COMMON.VAR'
1199 include 'COMMON.LOCAL'
1200 include 'COMMON.CHAIN'
1201 include 'COMMON.DERIV'
1202 include 'COMMON.NAMES'
1203 include 'COMMON.INTERACT'
1204 include 'COMMON.IOUNITS'
1205 include 'COMMON.CALC'
1206 common /srutu/ icall
1207 c double precision rrsave(maxdim)
1210 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1212 c if (icall.eq.0) then
1218 do i=iatsc_s,iatsc_e
1224 dxi=dc_norm(1,nres+i)
1225 dyi=dc_norm(2,nres+i)
1226 dzi=dc_norm(3,nres+i)
1227 c dsci_inv=dsc_inv(itypi)
1228 dsci_inv=vbld_inv(i+nres)
1230 C Calculate SC interaction energy.
1232 do iint=1,nint_gr(i)
1233 do j=istart(i,iint),iend(i,iint)
1236 c dscj_inv=dsc_inv(itypj)
1237 dscj_inv=vbld_inv(j+nres)
1238 chi1=chi(itypi,itypj)
1239 chi2=chi(itypj,itypi)
1246 alf12=0.5D0*(alf1+alf2)
1247 C For diagnostics only!!!
1260 dxj=dc_norm(1,nres+j)
1261 dyj=dc_norm(2,nres+j)
1262 dzj=dc_norm(3,nres+j)
1263 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1264 cd if (icall.eq.0) then
1270 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1272 C Calculate whole angle-dependent part of epsilon and contributions
1273 C to its derivatives
1274 fac=(rrij*sigsq)**expon2
1275 e1=fac*fac*aa(itypi,itypj)
1276 e2=fac*bb(itypi,itypj)
1277 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1278 eps2der=evdwij*eps3rt
1279 eps3der=evdwij*eps2rt
1280 evdwij=evdwij*eps2rt*eps3rt
1283 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1284 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1285 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1286 cd & restyp(itypi),i,restyp(itypj),j,
1287 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1288 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1289 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1292 C Calculate gradient components.
1293 e1=e1*eps1*eps2rt**2*eps3rt**2
1294 fac=-expon*(e1+evdwij)
1297 C Calculate radial part of the gradient
1301 C Calculate the angular part of the gradient and sum add the contributions
1302 C to the appropriate components of the Cartesian gradient.
1310 C-----------------------------------------------------------------------------
1311 subroutine egb(evdw)
1313 C This subroutine calculates the interaction energy of nonbonded side chains
1314 C assuming the Gay-Berne potential of interaction.
1316 implicit real*8 (a-h,o-z)
1317 include 'DIMENSIONS'
1318 include 'COMMON.GEO'
1319 include 'COMMON.VAR'
1320 include 'COMMON.LOCAL'
1321 include 'COMMON.CHAIN'
1322 include 'COMMON.DERIV'
1323 include 'COMMON.NAMES'
1324 include 'COMMON.INTERACT'
1325 include 'COMMON.IOUNITS'
1326 include 'COMMON.CALC'
1327 include 'COMMON.CONTROL'
1330 ccccc energy_dec=.false.
1331 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1334 c if (icall.eq.0) lprn=.false.
1336 do i=iatsc_s,iatsc_e
1342 dxi=dc_norm(1,nres+i)
1343 dyi=dc_norm(2,nres+i)
1344 dzi=dc_norm(3,nres+i)
1345 c dsci_inv=dsc_inv(itypi)
1346 dsci_inv=vbld_inv(i+nres)
1347 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1348 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1350 C Calculate SC interaction energy.
1352 do iint=1,nint_gr(i)
1353 do j=istart(i,iint),iend(i,iint)
1356 c dscj_inv=dsc_inv(itypj)
1357 dscj_inv=vbld_inv(j+nres)
1358 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1359 c & 1.0d0/vbld(j+nres)
1360 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1361 sig0ij=sigma(itypi,itypj)
1362 chi1=chi(itypi,itypj)
1363 chi2=chi(itypj,itypi)
1370 alf12=0.5D0*(alf1+alf2)
1371 C For diagnostics only!!!
1384 dxj=dc_norm(1,nres+j)
1385 dyj=dc_norm(2,nres+j)
1386 dzj=dc_norm(3,nres+j)
1387 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1388 c write (iout,*) "j",j," dc_norm",
1389 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1390 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1392 C Calculate angle-dependent terms of energy and contributions to their
1396 sig=sig0ij*dsqrt(sigsq)
1397 rij_shift=1.0D0/rij-sig+sig0ij
1398 c for diagnostics; uncomment
1399 c rij_shift=1.2*sig0ij
1400 C I hate to put IF's in the loops, but here don't have another choice!!!!
1401 if (rij_shift.le.0.0D0) then
1403 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1404 cd & restyp(itypi),i,restyp(itypj),j,
1405 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1409 c---------------------------------------------------------------
1410 rij_shift=1.0D0/rij_shift
1411 fac=rij_shift**expon
1412 e1=fac*fac*aa(itypi,itypj)
1413 e2=fac*bb(itypi,itypj)
1414 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1415 eps2der=evdwij*eps3rt
1416 eps3der=evdwij*eps2rt
1417 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1418 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1419 evdwij=evdwij*eps2rt*eps3rt
1422 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1423 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1424 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1425 & restyp(itypi),i,restyp(itypj),j,
1426 & epsi,sigm,chi1,chi2,chip1,chip2,
1427 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1428 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1432 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1435 C Calculate gradient components.
1436 e1=e1*eps1*eps2rt**2*eps3rt**2
1437 fac=-expon*(e1+evdwij)*rij_shift
1441 C Calculate the radial part of the gradient
1445 C Calculate angular part of the gradient.
1450 c write (iout,*) "Number of loop steps in EGB:",ind
1451 cccc energy_dec=.false.
1454 C-----------------------------------------------------------------------------
1455 subroutine egbv(evdw)
1457 C This subroutine calculates the interaction energy of nonbonded side chains
1458 C assuming the Gay-Berne-Vorobjev potential of interaction.
1460 implicit real*8 (a-h,o-z)
1461 include 'DIMENSIONS'
1462 include 'COMMON.GEO'
1463 include 'COMMON.VAR'
1464 include 'COMMON.LOCAL'
1465 include 'COMMON.CHAIN'
1466 include 'COMMON.DERIV'
1467 include 'COMMON.NAMES'
1468 include 'COMMON.INTERACT'
1469 include 'COMMON.IOUNITS'
1470 include 'COMMON.CALC'
1471 common /srutu/ icall
1474 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1477 c if (icall.eq.0) lprn=.true.
1479 do i=iatsc_s,iatsc_e
1485 dxi=dc_norm(1,nres+i)
1486 dyi=dc_norm(2,nres+i)
1487 dzi=dc_norm(3,nres+i)
1488 c dsci_inv=dsc_inv(itypi)
1489 dsci_inv=vbld_inv(i+nres)
1491 C Calculate SC interaction energy.
1493 do iint=1,nint_gr(i)
1494 do j=istart(i,iint),iend(i,iint)
1497 c dscj_inv=dsc_inv(itypj)
1498 dscj_inv=vbld_inv(j+nres)
1499 sig0ij=sigma(itypi,itypj)
1500 r0ij=r0(itypi,itypj)
1501 chi1=chi(itypi,itypj)
1502 chi2=chi(itypj,itypi)
1509 alf12=0.5D0*(alf1+alf2)
1510 C For diagnostics only!!!
1523 dxj=dc_norm(1,nres+j)
1524 dyj=dc_norm(2,nres+j)
1525 dzj=dc_norm(3,nres+j)
1526 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1528 C Calculate angle-dependent terms of energy and contributions to their
1532 sig=sig0ij*dsqrt(sigsq)
1533 rij_shift=1.0D0/rij-sig+r0ij
1534 C I hate to put IF's in the loops, but here don't have another choice!!!!
1535 if (rij_shift.le.0.0D0) then
1540 c---------------------------------------------------------------
1541 rij_shift=1.0D0/rij_shift
1542 fac=rij_shift**expon
1543 e1=fac*fac*aa(itypi,itypj)
1544 e2=fac*bb(itypi,itypj)
1545 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1546 eps2der=evdwij*eps3rt
1547 eps3der=evdwij*eps2rt
1548 fac_augm=rrij**expon
1549 e_augm=augm(itypi,itypj)*fac_augm
1550 evdwij=evdwij*eps2rt*eps3rt
1551 evdw=evdw+evdwij+e_augm
1553 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1554 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1555 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1556 & restyp(itypi),i,restyp(itypj),j,
1557 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1558 & chi1,chi2,chip1,chip2,
1559 & eps1,eps2rt**2,eps3rt**2,
1560 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1563 C Calculate gradient components.
1564 e1=e1*eps1*eps2rt**2*eps3rt**2
1565 fac=-expon*(e1+evdwij)*rij_shift
1567 fac=rij*fac-2*expon*rrij*e_augm
1568 C Calculate the radial part of the gradient
1572 C Calculate angular part of the gradient.
1578 C-----------------------------------------------------------------------------
1579 subroutine sc_angular
1580 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1581 C om12. Called by ebp, egb, and egbv.
1583 include 'COMMON.CALC'
1584 include 'COMMON.IOUNITS'
1588 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1589 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1590 om12=dxi*dxj+dyi*dyj+dzi*dzj
1592 C Calculate eps1(om12) and its derivative in om12
1593 faceps1=1.0D0-om12*chiom12
1594 faceps1_inv=1.0D0/faceps1
1595 eps1=dsqrt(faceps1_inv)
1596 C Following variable is eps1*deps1/dom12
1597 eps1_om12=faceps1_inv*chiom12
1602 c write (iout,*) "om12",om12," eps1",eps1
1603 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1608 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1609 sigsq=1.0D0-facsig*faceps1_inv
1610 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1611 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1612 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1618 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1619 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1621 C Calculate eps2 and its derivatives in om1, om2, and om12.
1624 chipom12=chip12*om12
1625 facp=1.0D0-om12*chipom12
1627 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1628 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1629 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1630 C Following variable is the square root of eps2
1631 eps2rt=1.0D0-facp1*facp_inv
1632 C Following three variables are the derivatives of the square root of eps
1633 C in om1, om2, and om12.
1634 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1635 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1636 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1637 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1638 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1639 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1640 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1641 c & " eps2rt_om12",eps2rt_om12
1642 C Calculate whole angle-dependent part of epsilon and contributions
1643 C to its derivatives
1646 C----------------------------------------------------------------------------
1648 implicit real*8 (a-h,o-z)
1649 include 'DIMENSIONS'
1650 include 'COMMON.CHAIN'
1651 include 'COMMON.DERIV'
1652 include 'COMMON.CALC'
1653 include 'COMMON.IOUNITS'
1654 double precision dcosom1(3),dcosom2(3)
1655 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1656 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1657 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1658 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1662 c eom12=evdwij*eps1_om12
1664 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1665 c & " sigder",sigder
1666 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1667 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1669 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1670 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1673 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1675 c write (iout,*) "gg",(gg(k),k=1,3)
1677 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1678 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1679 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1680 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1681 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1682 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1683 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1684 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1685 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1686 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1689 C Calculate the components of the gradient in DC and X
1693 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1697 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1698 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1702 C-----------------------------------------------------------------------
1703 subroutine e_softsphere(evdw)
1705 C This subroutine calculates the interaction energy of nonbonded side chains
1706 C assuming the LJ potential of interaction.
1708 implicit real*8 (a-h,o-z)
1709 include 'DIMENSIONS'
1710 parameter (accur=1.0d-10)
1711 include 'COMMON.GEO'
1712 include 'COMMON.VAR'
1713 include 'COMMON.LOCAL'
1714 include 'COMMON.CHAIN'
1715 include 'COMMON.DERIV'
1716 include 'COMMON.INTERACT'
1717 include 'COMMON.TORSION'
1718 include 'COMMON.SBRIDGE'
1719 include 'COMMON.NAMES'
1720 include 'COMMON.IOUNITS'
1721 include 'COMMON.CONTACTS'
1723 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1725 do i=iatsc_s,iatsc_e
1732 C Calculate SC interaction energy.
1734 do iint=1,nint_gr(i)
1735 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1736 cd & 'iend=',iend(i,iint)
1737 do j=istart(i,iint),iend(i,iint)
1742 rij=xj*xj+yj*yj+zj*zj
1743 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1744 r0ij=r0(itypi,itypj)
1746 c print *,i,j,r0ij,dsqrt(rij)
1747 if (rij.lt.r0ijsq) then
1748 evdwij=0.25d0*(rij-r0ijsq)**2
1756 C Calculate the components of the gradient in DC and X
1762 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1763 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1764 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1765 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1769 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1777 C--------------------------------------------------------------------------
1778 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1781 C Soft-sphere potential of p-p interaction
1783 implicit real*8 (a-h,o-z)
1784 include 'DIMENSIONS'
1785 include 'COMMON.CONTROL'
1786 include 'COMMON.IOUNITS'
1787 include 'COMMON.GEO'
1788 include 'COMMON.VAR'
1789 include 'COMMON.LOCAL'
1790 include 'COMMON.CHAIN'
1791 include 'COMMON.DERIV'
1792 include 'COMMON.INTERACT'
1793 include 'COMMON.CONTACTS'
1794 include 'COMMON.TORSION'
1795 include 'COMMON.VECTORS'
1796 include 'COMMON.FFIELD'
1798 cd write(iout,*) 'In EELEC_soft_sphere'
1805 do i=iatel_s,iatel_e
1809 xmedi=c(1,i)+0.5d0*dxi
1810 ymedi=c(2,i)+0.5d0*dyi
1811 zmedi=c(3,i)+0.5d0*dzi
1813 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1814 do j=ielstart(i),ielend(i)
1818 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1819 r0ij=rpp(iteli,itelj)
1824 xj=c(1,j)+0.5D0*dxj-xmedi
1825 yj=c(2,j)+0.5D0*dyj-ymedi
1826 zj=c(3,j)+0.5D0*dzj-zmedi
1827 rij=xj*xj+yj*yj+zj*zj
1828 if (rij.lt.r0ijsq) then
1829 evdw1ij=0.25d0*(rij-r0ijsq)**2
1837 C Calculate contributions to the Cartesian gradient.
1843 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1844 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1847 * Loop over residues i+1 thru j-1.
1851 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1856 cgrad do i=nnt,nct-1
1858 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1860 cgrad do j=i+1,nct-1
1862 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
1868 c------------------------------------------------------------------------------
1869 subroutine vec_and_deriv
1870 implicit real*8 (a-h,o-z)
1871 include 'DIMENSIONS'
1875 include 'COMMON.IOUNITS'
1876 include 'COMMON.GEO'
1877 include 'COMMON.VAR'
1878 include 'COMMON.LOCAL'
1879 include 'COMMON.CHAIN'
1880 include 'COMMON.VECTORS'
1881 include 'COMMON.SETUP'
1882 include 'COMMON.TIME1'
1883 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1884 C Compute the local reference systems. For reference system (i), the
1885 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1886 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1888 do i=ivec_start,ivec_end
1892 if (i.eq.nres-1) then
1893 C Case of the last full residue
1894 C Compute the Z-axis
1895 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1896 costh=dcos(pi-theta(nres))
1897 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1901 C Compute the derivatives of uz
1903 uzder(2,1,1)=-dc_norm(3,i-1)
1904 uzder(3,1,1)= dc_norm(2,i-1)
1905 uzder(1,2,1)= dc_norm(3,i-1)
1907 uzder(3,2,1)=-dc_norm(1,i-1)
1908 uzder(1,3,1)=-dc_norm(2,i-1)
1909 uzder(2,3,1)= dc_norm(1,i-1)
1912 uzder(2,1,2)= dc_norm(3,i)
1913 uzder(3,1,2)=-dc_norm(2,i)
1914 uzder(1,2,2)=-dc_norm(3,i)
1916 uzder(3,2,2)= dc_norm(1,i)
1917 uzder(1,3,2)= dc_norm(2,i)
1918 uzder(2,3,2)=-dc_norm(1,i)
1920 C Compute the Y-axis
1923 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1925 C Compute the derivatives of uy
1928 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1929 & -dc_norm(k,i)*dc_norm(j,i-1)
1930 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1932 uyder(j,j,1)=uyder(j,j,1)-costh
1933 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1938 uygrad(l,k,j,i)=uyder(l,k,j)
1939 uzgrad(l,k,j,i)=uzder(l,k,j)
1943 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1944 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1945 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1946 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1949 C Compute the Z-axis
1950 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1951 costh=dcos(pi-theta(i+2))
1952 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1956 C Compute the derivatives of uz
1958 uzder(2,1,1)=-dc_norm(3,i+1)
1959 uzder(3,1,1)= dc_norm(2,i+1)
1960 uzder(1,2,1)= dc_norm(3,i+1)
1962 uzder(3,2,1)=-dc_norm(1,i+1)
1963 uzder(1,3,1)=-dc_norm(2,i+1)
1964 uzder(2,3,1)= dc_norm(1,i+1)
1967 uzder(2,1,2)= dc_norm(3,i)
1968 uzder(3,1,2)=-dc_norm(2,i)
1969 uzder(1,2,2)=-dc_norm(3,i)
1971 uzder(3,2,2)= dc_norm(1,i)
1972 uzder(1,3,2)= dc_norm(2,i)
1973 uzder(2,3,2)=-dc_norm(1,i)
1975 C Compute the Y-axis
1978 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1980 C Compute the derivatives of uy
1983 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1984 & -dc_norm(k,i)*dc_norm(j,i+1)
1985 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1987 uyder(j,j,1)=uyder(j,j,1)-costh
1988 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1993 uygrad(l,k,j,i)=uyder(l,k,j)
1994 uzgrad(l,k,j,i)=uzder(l,k,j)
1998 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1999 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2000 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2001 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2005 vbld_inv_temp(1)=vbld_inv(i+1)
2006 if (i.lt.nres-1) then
2007 vbld_inv_temp(2)=vbld_inv(i+2)
2009 vbld_inv_temp(2)=vbld_inv(i)
2014 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2015 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2020 #if defined(PARVEC) && defined(MPI)
2021 if (nfgtasks1.gt.1) then
2023 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2024 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2025 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2026 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2027 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2029 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2030 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2032 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2033 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2034 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2035 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2036 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2037 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2038 time_gather=time_gather+MPI_Wtime()-time00
2040 c if (fg_rank.eq.0) then
2041 c write (iout,*) "Arrays UY and UZ"
2043 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2050 C-----------------------------------------------------------------------------
2051 subroutine check_vecgrad
2052 implicit real*8 (a-h,o-z)
2053 include 'DIMENSIONS'
2054 include 'COMMON.IOUNITS'
2055 include 'COMMON.GEO'
2056 include 'COMMON.VAR'
2057 include 'COMMON.LOCAL'
2058 include 'COMMON.CHAIN'
2059 include 'COMMON.VECTORS'
2060 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2061 dimension uyt(3,maxres),uzt(3,maxres)
2062 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2063 double precision delta /1.0d-7/
2066 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2067 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2068 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2069 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2070 cd & (dc_norm(if90,i),if90=1,3)
2071 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2072 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2073 cd write(iout,'(a)')
2079 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2080 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2093 cd write (iout,*) 'i=',i
2095 erij(k)=dc_norm(k,i)
2099 dc_norm(k,i)=erij(k)
2101 dc_norm(j,i)=dc_norm(j,i)+delta
2102 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2104 c dc_norm(k,i)=dc_norm(k,i)/fac
2106 c write (iout,*) (dc_norm(k,i),k=1,3)
2107 c write (iout,*) (erij(k),k=1,3)
2110 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2111 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2112 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2113 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2115 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2116 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2117 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2120 dc_norm(k,i)=erij(k)
2123 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2124 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2125 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2126 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2127 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2128 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2129 cd write (iout,'(a)')
2134 C--------------------------------------------------------------------------
2135 subroutine set_matrices
2136 implicit real*8 (a-h,o-z)
2137 include 'DIMENSIONS'
2140 include "COMMON.SETUP"
2142 integer status(MPI_STATUS_SIZE)
2144 include 'COMMON.IOUNITS'
2145 include 'COMMON.GEO'
2146 include 'COMMON.VAR'
2147 include 'COMMON.LOCAL'
2148 include 'COMMON.CHAIN'
2149 include 'COMMON.DERIV'
2150 include 'COMMON.INTERACT'
2151 include 'COMMON.CONTACTS'
2152 include 'COMMON.TORSION'
2153 include 'COMMON.VECTORS'
2154 include 'COMMON.FFIELD'
2155 double precision auxvec(2),auxmat(2,2)
2157 C Compute the virtual-bond-torsional-angle dependent quantities needed
2158 C to calculate the el-loc multibody terms of various order.
2161 do i=ivec_start+2,ivec_end+2
2165 if (i .lt. nres+1) then
2202 if (i .gt. 3 .and. i .lt. nres+1) then
2203 obrot_der(1,i-2)=-sin1
2204 obrot_der(2,i-2)= cos1
2205 Ugder(1,1,i-2)= sin1
2206 Ugder(1,2,i-2)=-cos1
2207 Ugder(2,1,i-2)=-cos1
2208 Ugder(2,2,i-2)=-sin1
2211 obrot2_der(1,i-2)=-dwasin2
2212 obrot2_der(2,i-2)= dwacos2
2213 Ug2der(1,1,i-2)= dwasin2
2214 Ug2der(1,2,i-2)=-dwacos2
2215 Ug2der(2,1,i-2)=-dwacos2
2216 Ug2der(2,2,i-2)=-dwasin2
2218 obrot_der(1,i-2)=0.0d0
2219 obrot_der(2,i-2)=0.0d0
2220 Ugder(1,1,i-2)=0.0d0
2221 Ugder(1,2,i-2)=0.0d0
2222 Ugder(2,1,i-2)=0.0d0
2223 Ugder(2,2,i-2)=0.0d0
2224 obrot2_der(1,i-2)=0.0d0
2225 obrot2_der(2,i-2)=0.0d0
2226 Ug2der(1,1,i-2)=0.0d0
2227 Ug2der(1,2,i-2)=0.0d0
2228 Ug2der(2,1,i-2)=0.0d0
2229 Ug2der(2,2,i-2)=0.0d0
2231 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2232 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2233 iti = itortyp(itype(i-2))
2237 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2238 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2239 iti1 = itortyp(itype(i-1))
2243 cd write (iout,*) '*******i',i,' iti1',iti
2244 cd write (iout,*) 'b1',b1(:,iti)
2245 cd write (iout,*) 'b2',b2(:,iti)
2246 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2247 c if (i .gt. iatel_s+2) then
2248 if (i .gt. nnt+2) then
2249 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2250 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2251 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2253 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2254 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2255 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2256 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2257 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2268 DtUg2(l,k,i-2)=0.0d0
2272 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2273 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2275 muder(k,i-2)=Ub2der(k,i-2)
2277 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2278 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2279 iti1 = itortyp(itype(i-1))
2284 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2286 cd write (iout,*) 'mu ',mu(:,i-2)
2287 cd write (iout,*) 'mu1',mu1(:,i-2)
2288 cd write (iout,*) 'mu2',mu2(:,i-2)
2289 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2291 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2292 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2293 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2294 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2295 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2296 C Vectors and matrices dependent on a single virtual-bond dihedral.
2297 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2298 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2299 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2300 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2301 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2302 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2303 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2304 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2305 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2308 C Matrices dependent on two consecutive virtual-bond dihedrals.
2309 C The order of matrices is from left to right.
2310 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2312 c do i=max0(ivec_start,2),ivec_end
2314 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2315 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2316 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2317 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2318 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2319 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2320 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2321 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2324 #if defined(MPI) && defined(PARMAT)
2326 c if (fg_rank.eq.0) then
2327 write (iout,*) "Arrays UG and UGDER before GATHER"
2329 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2330 & ((ug(l,k,i),l=1,2),k=1,2),
2331 & ((ugder(l,k,i),l=1,2),k=1,2)
2333 write (iout,*) "Arrays UG2 and UG2DER"
2335 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2336 & ((ug2(l,k,i),l=1,2),k=1,2),
2337 & ((ug2der(l,k,i),l=1,2),k=1,2)
2339 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2341 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2342 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2343 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2345 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2347 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2348 & costab(i),sintab(i),costab2(i),sintab2(i)
2350 write (iout,*) "Array MUDER"
2352 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2356 if (nfgtasks.gt.1) then
2358 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2359 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2360 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2362 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2363 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2365 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2366 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2368 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2369 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2371 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2372 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2374 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2375 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2377 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2378 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2380 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2381 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2382 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2383 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2384 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2385 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2386 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2387 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2388 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2389 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2390 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2391 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2392 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2394 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2395 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2397 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2398 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2400 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2401 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2403 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2404 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2406 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2407 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2409 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2410 & ivec_count(fg_rank1),
2411 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2413 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2414 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2416 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2417 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2419 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2420 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2422 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2423 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2425 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2426 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2428 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2429 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2431 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2432 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2434 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2435 & ivec_count(fg_rank1),
2436 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2438 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2439 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2441 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2442 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2444 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2445 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2447 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2448 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2450 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2451 & ivec_count(fg_rank1),
2452 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2454 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2455 & ivec_count(fg_rank1),
2456 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2458 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2459 & ivec_count(fg_rank1),
2460 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2461 & MPI_MAT2,FG_COMM1,IERR)
2462 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2463 & ivec_count(fg_rank1),
2464 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2465 & MPI_MAT2,FG_COMM1,IERR)
2468 c Passes matrix info through the ring
2471 if (irecv.lt.0) irecv=nfgtasks1-1
2474 if (inext.ge.nfgtasks1) inext=0
2476 c write (iout,*) "isend",isend," irecv",irecv
2478 lensend=lentyp(isend)
2479 lenrecv=lentyp(irecv)
2480 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2481 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2482 c & MPI_ROTAT1(lensend),inext,2200+isend,
2483 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2484 c & iprev,2200+irecv,FG_COMM,status,IERR)
2485 c write (iout,*) "Gather ROTAT1"
2487 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2488 c & MPI_ROTAT2(lensend),inext,3300+isend,
2489 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2490 c & iprev,3300+irecv,FG_COMM,status,IERR)
2491 c write (iout,*) "Gather ROTAT2"
2493 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2494 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2495 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2496 & iprev,4400+irecv,FG_COMM,status,IERR)
2497 c write (iout,*) "Gather ROTAT_OLD"
2499 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2500 & MPI_PRECOMP11(lensend),inext,5500+isend,
2501 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2502 & iprev,5500+irecv,FG_COMM,status,IERR)
2503 c write (iout,*) "Gather PRECOMP11"
2505 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2506 & MPI_PRECOMP12(lensend),inext,6600+isend,
2507 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2508 & iprev,6600+irecv,FG_COMM,status,IERR)
2509 c write (iout,*) "Gather PRECOMP12"
2511 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2513 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2514 & MPI_ROTAT2(lensend),inext,7700+isend,
2515 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2516 & iprev,7700+irecv,FG_COMM,status,IERR)
2517 c write (iout,*) "Gather PRECOMP21"
2519 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2520 & MPI_PRECOMP22(lensend),inext,8800+isend,
2521 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2522 & iprev,8800+irecv,FG_COMM,status,IERR)
2523 c write (iout,*) "Gather PRECOMP22"
2525 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2526 & MPI_PRECOMP23(lensend),inext,9900+isend,
2527 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2528 & MPI_PRECOMP23(lenrecv),
2529 & iprev,9900+irecv,FG_COMM,status,IERR)
2530 c write (iout,*) "Gather PRECOMP23"
2535 if (irecv.lt.0) irecv=nfgtasks1-1
2538 time_gather=time_gather+MPI_Wtime()-time00
2541 c if (fg_rank.eq.0) then
2542 write (iout,*) "Arrays UG and UGDER"
2544 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2545 & ((ug(l,k,i),l=1,2),k=1,2),
2546 & ((ugder(l,k,i),l=1,2),k=1,2)
2548 write (iout,*) "Arrays UG2 and UG2DER"
2550 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2551 & ((ug2(l,k,i),l=1,2),k=1,2),
2552 & ((ug2der(l,k,i),l=1,2),k=1,2)
2554 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2556 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2557 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2558 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2560 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2562 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2563 & costab(i),sintab(i),costab2(i),sintab2(i)
2565 write (iout,*) "Array MUDER"
2567 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2573 cd iti = itortyp(itype(i))
2576 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2577 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2582 C--------------------------------------------------------------------------
2583 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2585 C This subroutine calculates the average interaction energy and its gradient
2586 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2587 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2588 C The potential depends both on the distance of peptide-group centers and on
2589 C the orientation of the CA-CA virtual bonds.
2591 implicit real*8 (a-h,o-z)
2595 include 'DIMENSIONS'
2596 include 'COMMON.CONTROL'
2597 include 'COMMON.SETUP'
2598 include 'COMMON.IOUNITS'
2599 include 'COMMON.GEO'
2600 include 'COMMON.VAR'
2601 include 'COMMON.LOCAL'
2602 include 'COMMON.CHAIN'
2603 include 'COMMON.DERIV'
2604 include 'COMMON.INTERACT'
2605 include 'COMMON.CONTACTS'
2606 include 'COMMON.TORSION'
2607 include 'COMMON.VECTORS'
2608 include 'COMMON.FFIELD'
2609 include 'COMMON.TIME1'
2610 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2611 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2612 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2613 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2614 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2615 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2617 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2619 double precision scal_el /1.0d0/
2621 double precision scal_el /0.5d0/
2624 C 13-go grudnia roku pamietnego...
2625 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2626 & 0.0d0,1.0d0,0.0d0,
2627 & 0.0d0,0.0d0,1.0d0/
2628 cd write(iout,*) 'In EELEC'
2630 cd write(iout,*) 'Type',i
2631 cd write(iout,*) 'B1',B1(:,i)
2632 cd write(iout,*) 'B2',B2(:,i)
2633 cd write(iout,*) 'CC',CC(:,:,i)
2634 cd write(iout,*) 'DD',DD(:,:,i)
2635 cd write(iout,*) 'EE',EE(:,:,i)
2637 cd call check_vecgrad
2639 if (icheckgrad.eq.1) then
2641 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2643 dc_norm(k,i)=dc(k,i)*fac
2645 c write (iout,*) 'i',i,' fac',fac
2648 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2649 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2650 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2651 c call vec_and_deriv
2657 time_mat=time_mat+MPI_Wtime()-time01
2661 cd write (iout,*) 'i=',i
2663 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2666 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2667 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2680 cd print '(a)','Enter EELEC'
2681 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2683 gel_loc_loc(i)=0.0d0
2688 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2690 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2692 do i=iturn3_start,iturn3_end
2696 dx_normi=dc_norm(1,i)
2697 dy_normi=dc_norm(2,i)
2698 dz_normi=dc_norm(3,i)
2699 xmedi=c(1,i)+0.5d0*dxi
2700 ymedi=c(2,i)+0.5d0*dyi
2701 zmedi=c(3,i)+0.5d0*dzi
2703 call eelecij(i,i+2,ees,evdw1,eel_loc)
2704 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2705 num_cont_hb(i)=num_conti
2707 do i=iturn4_start,iturn4_end
2711 dx_normi=dc_norm(1,i)
2712 dy_normi=dc_norm(2,i)
2713 dz_normi=dc_norm(3,i)
2714 xmedi=c(1,i)+0.5d0*dxi
2715 ymedi=c(2,i)+0.5d0*dyi
2716 zmedi=c(3,i)+0.5d0*dzi
2717 num_conti=num_cont_hb(i)
2718 call eelecij(i,i+3,ees,evdw1,eel_loc)
2719 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
2720 num_cont_hb(i)=num_conti
2723 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2725 do i=iatel_s,iatel_e
2729 dx_normi=dc_norm(1,i)
2730 dy_normi=dc_norm(2,i)
2731 dz_normi=dc_norm(3,i)
2732 xmedi=c(1,i)+0.5d0*dxi
2733 ymedi=c(2,i)+0.5d0*dyi
2734 zmedi=c(3,i)+0.5d0*dzi
2735 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2736 num_conti=num_cont_hb(i)
2737 do j=ielstart(i),ielend(i)
2738 call eelecij(i,j,ees,evdw1,eel_loc)
2740 num_cont_hb(i)=num_conti
2742 c write (iout,*) "Number of loop steps in EELEC:",ind
2744 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2745 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2747 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2748 ccc eel_loc=eel_loc+eello_turn3
2749 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2752 C-------------------------------------------------------------------------------
2753 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2754 implicit real*8 (a-h,o-z)
2755 include 'DIMENSIONS'
2759 include 'COMMON.CONTROL'
2760 include 'COMMON.IOUNITS'
2761 include 'COMMON.GEO'
2762 include 'COMMON.VAR'
2763 include 'COMMON.LOCAL'
2764 include 'COMMON.CHAIN'
2765 include 'COMMON.DERIV'
2766 include 'COMMON.INTERACT'
2767 include 'COMMON.CONTACTS'
2768 include 'COMMON.TORSION'
2769 include 'COMMON.VECTORS'
2770 include 'COMMON.FFIELD'
2771 include 'COMMON.TIME1'
2772 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2773 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2774 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2775 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2776 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2777 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2779 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2781 double precision scal_el /1.0d0/
2783 double precision scal_el /0.5d0/
2786 C 13-go grudnia roku pamietnego...
2787 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2788 & 0.0d0,1.0d0,0.0d0,
2789 & 0.0d0,0.0d0,1.0d0/
2790 c time00=MPI_Wtime()
2791 cd write (iout,*) "eelecij",i,j
2795 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2796 aaa=app(iteli,itelj)
2797 bbb=bpp(iteli,itelj)
2798 ael6i=ael6(iteli,itelj)
2799 ael3i=ael3(iteli,itelj)
2803 dx_normj=dc_norm(1,j)
2804 dy_normj=dc_norm(2,j)
2805 dz_normj=dc_norm(3,j)
2806 xj=c(1,j)+0.5D0*dxj-xmedi
2807 yj=c(2,j)+0.5D0*dyj-ymedi
2808 zj=c(3,j)+0.5D0*dzj-zmedi
2809 rij=xj*xj+yj*yj+zj*zj
2815 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2816 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2817 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2818 fac=cosa-3.0D0*cosb*cosg
2820 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2821 if (j.eq.i+2) ev1=scal_el*ev1
2826 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2829 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2830 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2833 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2834 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2835 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2836 cd & xmedi,ymedi,zmedi,xj,yj,zj
2838 if (energy_dec) then
2839 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
2840 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2844 C Calculate contributions to the Cartesian gradient.
2847 facvdw=-6*rrmij*(ev1+evdwij)
2848 facel=-3*rrmij*(el1+eesij)
2854 * Radial derivatives. First process both termini of the fragment (i,j)
2860 c ghalf=0.5D0*ggg(k)
2861 c gelc(k,i)=gelc(k,i)+ghalf
2862 c gelc(k,j)=gelc(k,j)+ghalf
2864 c 9/28/08 AL Gradient compotents will be summed only at the end
2866 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2867 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2870 * Loop over residues i+1 thru j-1.
2874 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2881 c ghalf=0.5D0*ggg(k)
2882 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2883 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2885 c 9/28/08 AL Gradient compotents will be summed only at the end
2887 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2888 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2891 * Loop over residues i+1 thru j-1.
2895 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2902 fac=-3*rrmij*(facvdw+facvdw+facel)
2907 * Radial derivatives. First process both termini of the fragment (i,j)
2913 c ghalf=0.5D0*ggg(k)
2914 c gelc(k,i)=gelc(k,i)+ghalf
2915 c gelc(k,j)=gelc(k,j)+ghalf
2917 c 9/28/08 AL Gradient compotents will be summed only at the end
2919 gelc_long(k,j)=gelc(k,j)+ggg(k)
2920 gelc_long(k,i)=gelc(k,i)-ggg(k)
2923 * Loop over residues i+1 thru j-1.
2927 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2930 c 9/28/08 AL Gradient compotents will be summed only at the end
2935 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2936 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2942 ecosa=2.0D0*fac3*fac1+fac4
2945 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2946 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2948 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2949 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2951 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2952 cd & (dcosg(k),k=1,3)
2954 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2957 c ghalf=0.5D0*ggg(k)
2958 c gelc(k,i)=gelc(k,i)+ghalf
2959 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2960 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2961 c gelc(k,j)=gelc(k,j)+ghalf
2962 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2963 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2967 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2972 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2973 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2975 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2976 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2977 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2978 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2980 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2981 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2982 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2984 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2985 C energy of a peptide unit is assumed in the form of a second-order
2986 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2987 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2988 C are computed for EVERY pair of non-contiguous peptide groups.
2990 if (j.lt.nres-1) then
3001 muij(kkk)=mu(k,i)*mu(l,j)
3004 cd write (iout,*) 'EELEC: i',i,' j',j
3005 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3006 cd write(iout,*) 'muij',muij
3007 ury=scalar(uy(1,i),erij)
3008 urz=scalar(uz(1,i),erij)
3009 vry=scalar(uy(1,j),erij)
3010 vrz=scalar(uz(1,j),erij)
3011 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3012 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3013 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3014 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3015 fac=dsqrt(-ael6i)*r3ij
3020 cd write (iout,'(4i5,4f10.5)')
3021 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3022 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3023 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3024 cd & uy(:,j),uz(:,j)
3025 cd write (iout,'(4f10.5)')
3026 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3027 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3028 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3029 cd write (iout,'(9f10.5/)')
3030 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3031 C Derivatives of the elements of A in virtual-bond vectors
3032 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3034 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3035 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3036 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3037 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3038 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3039 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3040 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3041 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3042 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3043 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3044 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3045 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3047 C Compute radial contributions to the gradient
3065 C Add the contributions coming from er
3068 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3069 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3070 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3071 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3074 C Derivatives in DC(i)
3075 cgrad ghalf1=0.5d0*agg(k,1)
3076 cgrad ghalf2=0.5d0*agg(k,2)
3077 cgrad ghalf3=0.5d0*agg(k,3)
3078 cgrad ghalf4=0.5d0*agg(k,4)
3079 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3080 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3081 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3082 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3083 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3084 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3085 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3086 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3087 C Derivatives in DC(i+1)
3088 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3089 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3090 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3091 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3092 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3093 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3094 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3095 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3096 C Derivatives in DC(j)
3097 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3098 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3099 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3100 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3101 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3102 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3103 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3104 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3105 C Derivatives in DC(j+1) or DC(nres-1)
3106 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3107 & -3.0d0*vryg(k,3)*ury)
3108 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3109 & -3.0d0*vrzg(k,3)*ury)
3110 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3111 & -3.0d0*vryg(k,3)*urz)
3112 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3113 & -3.0d0*vrzg(k,3)*urz)
3114 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3116 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3129 aggi(k,l)=-aggi(k,l)
3130 aggi1(k,l)=-aggi1(k,l)
3131 aggj(k,l)=-aggj(k,l)
3132 aggj1(k,l)=-aggj1(k,l)
3135 if (j.lt.nres-1) then
3141 aggi(k,l)=-aggi(k,l)
3142 aggi1(k,l)=-aggi1(k,l)
3143 aggj(k,l)=-aggj(k,l)
3144 aggj1(k,l)=-aggj1(k,l)
3155 aggi(k,l)=-aggi(k,l)
3156 aggi1(k,l)=-aggi1(k,l)
3157 aggj(k,l)=-aggj(k,l)
3158 aggj1(k,l)=-aggj1(k,l)
3163 IF (wel_loc.gt.0.0d0) THEN
3164 C Contribution to the local-electrostatic energy coming from the i-j pair
3165 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3167 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3169 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3170 & 'eelloc',i,j,eel_loc_ij
3172 eel_loc=eel_loc+eel_loc_ij
3173 C Partial derivatives in virtual-bond dihedral angles gamma
3175 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3176 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3177 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3178 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3179 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3180 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3181 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3183 ggg(l)=agg(l,1)*muij(1)+
3184 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3185 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3186 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3187 cgrad ghalf=0.5d0*ggg(l)
3188 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3189 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3193 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3196 C Remaining derivatives of eello
3198 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3199 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3200 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3201 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3202 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3203 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3204 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3205 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3208 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3209 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3210 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3211 & .and. num_conti.le.maxconts) then
3212 c write (iout,*) i,j," entered corr"
3214 C Calculate the contact function. The ith column of the array JCONT will
3215 C contain the numbers of atoms that make contacts with the atom I (of numbers
3216 C greater than I). The arrays FACONT and GACONT will contain the values of
3217 C the contact function and its derivative.
3218 c r0ij=1.02D0*rpp(iteli,itelj)
3219 c r0ij=1.11D0*rpp(iteli,itelj)
3220 r0ij=2.20D0*rpp(iteli,itelj)
3221 c r0ij=1.55D0*rpp(iteli,itelj)
3222 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3223 if (fcont.gt.0.0D0) then
3224 num_conti=num_conti+1
3225 if (num_conti.gt.maxconts) then
3226 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3227 & ' will skip next contacts for this conf.'
3229 jcont_hb(num_conti,i)=j
3230 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3231 cd & " jcont_hb",jcont_hb(num_conti,i)
3232 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3233 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3234 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3236 d_cont(num_conti,i)=rij
3237 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3238 C --- Electrostatic-interaction matrix ---
3239 a_chuj(1,1,num_conti,i)=a22
3240 a_chuj(1,2,num_conti,i)=a23
3241 a_chuj(2,1,num_conti,i)=a32
3242 a_chuj(2,2,num_conti,i)=a33
3243 C --- Gradient of rij
3245 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3252 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3253 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3254 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3255 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3256 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3261 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3262 C Calculate contact energies
3264 wij=cosa-3.0D0*cosb*cosg
3267 c fac3=dsqrt(-ael6i)/r0ij**3
3268 fac3=dsqrt(-ael6i)*r3ij
3269 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3270 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3271 if (ees0tmp.gt.0) then
3272 ees0pij=dsqrt(ees0tmp)
3276 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3277 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3278 if (ees0tmp.gt.0) then
3279 ees0mij=dsqrt(ees0tmp)
3284 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3285 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3286 C Diagnostics. Comment out or remove after debugging!
3287 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3288 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3289 c ees0m(num_conti,i)=0.0D0
3291 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3292 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3293 C Angular derivatives of the contact function
3294 ees0pij1=fac3/ees0pij
3295 ees0mij1=fac3/ees0mij
3296 fac3p=-3.0D0*fac3*rrmij
3297 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3298 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3300 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3301 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3302 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3303 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3304 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3305 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3306 ecosap=ecosa1+ecosa2
3307 ecosbp=ecosb1+ecosb2
3308 ecosgp=ecosg1+ecosg2
3309 ecosam=ecosa1-ecosa2
3310 ecosbm=ecosb1-ecosb2
3311 ecosgm=ecosg1-ecosg2
3320 facont_hb(num_conti,i)=fcont
3321 fprimcont=fprimcont/rij
3322 cd facont_hb(num_conti,i)=1.0D0
3323 C Following line is for diagnostics.
3326 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3327 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3330 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3331 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3333 gggp(1)=gggp(1)+ees0pijp*xj
3334 gggp(2)=gggp(2)+ees0pijp*yj
3335 gggp(3)=gggp(3)+ees0pijp*zj
3336 gggm(1)=gggm(1)+ees0mijp*xj
3337 gggm(2)=gggm(2)+ees0mijp*yj
3338 gggm(3)=gggm(3)+ees0mijp*zj
3339 C Derivatives due to the contact function
3340 gacont_hbr(1,num_conti,i)=fprimcont*xj
3341 gacont_hbr(2,num_conti,i)=fprimcont*yj
3342 gacont_hbr(3,num_conti,i)=fprimcont*zj
3345 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3346 c following the change of gradient-summation algorithm.
3348 cgrad ghalfp=0.5D0*gggp(k)
3349 cgrad ghalfm=0.5D0*gggm(k)
3350 gacontp_hb1(k,num_conti,i)=!ghalfp
3351 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3352 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3353 gacontp_hb2(k,num_conti,i)=!ghalfp
3354 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3355 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3356 gacontp_hb3(k,num_conti,i)=gggp(k)
3357 gacontm_hb1(k,num_conti,i)=!ghalfm
3358 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3359 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3360 gacontm_hb2(k,num_conti,i)=!ghalfm
3361 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3362 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3363 gacontm_hb3(k,num_conti,i)=gggm(k)
3365 C Diagnostics. Comment out or remove after debugging!
3367 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3368 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3369 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3370 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3371 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3372 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3375 endif ! num_conti.le.maxconts
3378 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3381 ghalf=0.5d0*agg(l,k)
3382 aggi(l,k)=aggi(l,k)+ghalf
3383 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3384 aggj(l,k)=aggj(l,k)+ghalf
3387 if (j.eq.nres-1 .and. i.lt.j-2) then
3390 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3395 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3398 C-----------------------------------------------------------------------------
3399 subroutine eturn3(i,eello_turn3)
3400 C Third- and fourth-order contributions from turns
3401 implicit real*8 (a-h,o-z)
3402 include 'DIMENSIONS'
3403 include 'COMMON.IOUNITS'
3404 include 'COMMON.GEO'
3405 include 'COMMON.VAR'
3406 include 'COMMON.LOCAL'
3407 include 'COMMON.CHAIN'
3408 include 'COMMON.DERIV'
3409 include 'COMMON.INTERACT'
3410 include 'COMMON.CONTACTS'
3411 include 'COMMON.TORSION'
3412 include 'COMMON.VECTORS'
3413 include 'COMMON.FFIELD'
3414 include 'COMMON.CONTROL'
3416 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3417 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3418 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3419 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3420 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3421 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3422 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3425 c write (iout,*) "eturn3",i,j,j1,j2
3430 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3432 C Third-order contributions
3439 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3440 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3441 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3442 call transpose2(auxmat(1,1),auxmat1(1,1))
3443 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3444 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3445 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3446 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3447 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3448 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3449 cd & ' eello_turn3_num',4*eello_turn3_num
3450 C Derivatives in gamma(i)
3451 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3452 call transpose2(auxmat2(1,1),auxmat3(1,1))
3453 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3454 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3455 C Derivatives in gamma(i+1)
3456 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3457 call transpose2(auxmat2(1,1),auxmat3(1,1))
3458 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3459 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3460 & +0.5d0*(pizda(1,1)+pizda(2,2))
3461 C Cartesian derivatives
3463 c ghalf1=0.5d0*agg(l,1)
3464 c ghalf2=0.5d0*agg(l,2)
3465 c ghalf3=0.5d0*agg(l,3)
3466 c ghalf4=0.5d0*agg(l,4)
3467 a_temp(1,1)=aggi(l,1)!+ghalf1
3468 a_temp(1,2)=aggi(l,2)!+ghalf2
3469 a_temp(2,1)=aggi(l,3)!+ghalf3
3470 a_temp(2,2)=aggi(l,4)!+ghalf4
3471 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3472 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3473 & +0.5d0*(pizda(1,1)+pizda(2,2))
3474 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3475 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3476 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3477 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3478 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3479 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3480 & +0.5d0*(pizda(1,1)+pizda(2,2))
3481 a_temp(1,1)=aggj(l,1)!+ghalf1
3482 a_temp(1,2)=aggj(l,2)!+ghalf2
3483 a_temp(2,1)=aggj(l,3)!+ghalf3
3484 a_temp(2,2)=aggj(l,4)!+ghalf4
3485 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3486 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3487 & +0.5d0*(pizda(1,1)+pizda(2,2))
3488 a_temp(1,1)=aggj1(l,1)
3489 a_temp(1,2)=aggj1(l,2)
3490 a_temp(2,1)=aggj1(l,3)
3491 a_temp(2,2)=aggj1(l,4)
3492 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3493 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3494 & +0.5d0*(pizda(1,1)+pizda(2,2))
3498 C-------------------------------------------------------------------------------
3499 subroutine eturn4(i,eello_turn4)
3500 C Third- and fourth-order contributions from turns
3501 implicit real*8 (a-h,o-z)
3502 include 'DIMENSIONS'
3503 include 'COMMON.IOUNITS'
3504 include 'COMMON.GEO'
3505 include 'COMMON.VAR'
3506 include 'COMMON.LOCAL'
3507 include 'COMMON.CHAIN'
3508 include 'COMMON.DERIV'
3509 include 'COMMON.INTERACT'
3510 include 'COMMON.CONTACTS'
3511 include 'COMMON.TORSION'
3512 include 'COMMON.VECTORS'
3513 include 'COMMON.FFIELD'
3514 include 'COMMON.CONTROL'
3516 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3517 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3518 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3519 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3520 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3521 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3522 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3525 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3527 C Fourth-order contributions
3535 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3536 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3537 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3542 iti1=itortyp(itype(i+1))
3543 iti2=itortyp(itype(i+2))
3544 iti3=itortyp(itype(i+3))
3545 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3546 call transpose2(EUg(1,1,i+1),e1t(1,1))
3547 call transpose2(Eug(1,1,i+2),e2t(1,1))
3548 call transpose2(Eug(1,1,i+3),e3t(1,1))
3549 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3550 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3551 s1=scalar2(b1(1,iti2),auxvec(1))
3552 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3553 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3554 s2=scalar2(b1(1,iti1),auxvec(1))
3555 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3556 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3557 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3558 eello_turn4=eello_turn4-(s1+s2+s3)
3559 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3560 & 'eturn4',i,j,-(s1+s2+s3)
3561 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3562 cd & ' eello_turn4_num',8*eello_turn4_num
3563 C Derivatives in gamma(i)
3564 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3565 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3566 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3567 s1=scalar2(b1(1,iti2),auxvec(1))
3568 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3569 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3570 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3571 C Derivatives in gamma(i+1)
3572 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3573 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3574 s2=scalar2(b1(1,iti1),auxvec(1))
3575 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3576 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3577 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3578 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3579 C Derivatives in gamma(i+2)
3580 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3581 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3582 s1=scalar2(b1(1,iti2),auxvec(1))
3583 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3584 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3585 s2=scalar2(b1(1,iti1),auxvec(1))
3586 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3587 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3588 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3589 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3590 C Cartesian derivatives
3591 C Derivatives of this turn contributions in DC(i+2)
3592 if (j.lt.nres-1) then
3594 a_temp(1,1)=agg(l,1)
3595 a_temp(1,2)=agg(l,2)
3596 a_temp(2,1)=agg(l,3)
3597 a_temp(2,2)=agg(l,4)
3598 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3599 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3600 s1=scalar2(b1(1,iti2),auxvec(1))
3601 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3602 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3603 s2=scalar2(b1(1,iti1),auxvec(1))
3604 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3605 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3606 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3608 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3611 C Remaining derivatives of this turn contribution
3613 a_temp(1,1)=aggi(l,1)
3614 a_temp(1,2)=aggi(l,2)
3615 a_temp(2,1)=aggi(l,3)
3616 a_temp(2,2)=aggi(l,4)
3617 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3618 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3619 s1=scalar2(b1(1,iti2),auxvec(1))
3620 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3621 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3622 s2=scalar2(b1(1,iti1),auxvec(1))
3623 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3624 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3625 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3626 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3627 a_temp(1,1)=aggi1(l,1)
3628 a_temp(1,2)=aggi1(l,2)
3629 a_temp(2,1)=aggi1(l,3)
3630 a_temp(2,2)=aggi1(l,4)
3631 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3632 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3633 s1=scalar2(b1(1,iti2),auxvec(1))
3634 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3635 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3636 s2=scalar2(b1(1,iti1),auxvec(1))
3637 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3638 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3639 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3640 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3641 a_temp(1,1)=aggj(l,1)
3642 a_temp(1,2)=aggj(l,2)
3643 a_temp(2,1)=aggj(l,3)
3644 a_temp(2,2)=aggj(l,4)
3645 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3646 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3647 s1=scalar2(b1(1,iti2),auxvec(1))
3648 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3649 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3650 s2=scalar2(b1(1,iti1),auxvec(1))
3651 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3652 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3653 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3654 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3655 a_temp(1,1)=aggj1(l,1)
3656 a_temp(1,2)=aggj1(l,2)
3657 a_temp(2,1)=aggj1(l,3)
3658 a_temp(2,2)=aggj1(l,4)
3659 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3660 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3661 s1=scalar2(b1(1,iti2),auxvec(1))
3662 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3663 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3664 s2=scalar2(b1(1,iti1),auxvec(1))
3665 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3666 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3667 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3668 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3669 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3673 C-----------------------------------------------------------------------------
3674 subroutine vecpr(u,v,w)
3675 implicit real*8(a-h,o-z)
3676 dimension u(3),v(3),w(3)
3677 w(1)=u(2)*v(3)-u(3)*v(2)
3678 w(2)=-u(1)*v(3)+u(3)*v(1)
3679 w(3)=u(1)*v(2)-u(2)*v(1)
3682 C-----------------------------------------------------------------------------
3683 subroutine unormderiv(u,ugrad,unorm,ungrad)
3684 C This subroutine computes the derivatives of a normalized vector u, given
3685 C the derivatives computed without normalization conditions, ugrad. Returns
3688 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3689 double precision vec(3)
3690 double precision scalar
3692 c write (2,*) 'ugrad',ugrad
3695 vec(i)=scalar(ugrad(1,i),u(1))
3697 c write (2,*) 'vec',vec
3700 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3703 c write (2,*) 'ungrad',ungrad
3706 C-----------------------------------------------------------------------------
3707 subroutine escp_soft_sphere(evdw2,evdw2_14)
3709 C This subroutine calculates the excluded-volume interaction energy between
3710 C peptide-group centers and side chains and its gradient in virtual-bond and
3711 C side-chain vectors.
3713 implicit real*8 (a-h,o-z)
3714 include 'DIMENSIONS'
3715 include 'COMMON.GEO'
3716 include 'COMMON.VAR'
3717 include 'COMMON.LOCAL'
3718 include 'COMMON.CHAIN'
3719 include 'COMMON.DERIV'
3720 include 'COMMON.INTERACT'
3721 include 'COMMON.FFIELD'
3722 include 'COMMON.IOUNITS'
3723 include 'COMMON.CONTROL'
3728 cd print '(a)','Enter ESCP'
3729 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3730 do i=iatscp_s,iatscp_e
3732 xi=0.5D0*(c(1,i)+c(1,i+1))
3733 yi=0.5D0*(c(2,i)+c(2,i+1))
3734 zi=0.5D0*(c(3,i)+c(3,i+1))
3736 do iint=1,nscp_gr(i)
3738 do j=iscpstart(i,iint),iscpend(i,iint)
3740 C Uncomment following three lines for SC-p interactions
3744 C Uncomment following three lines for Ca-p interactions
3748 rij=xj*xj+yj*yj+zj*zj
3751 if (rij.lt.r0ijsq) then
3752 evdwij=0.25d0*(rij-r0ijsq)**2
3760 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3765 cgrad if (j.lt.i) then
3766 cd write (iout,*) 'j<i'
3767 C Uncomment following three lines for SC-p interactions
3769 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3772 cd write (iout,*) 'j>i'
3774 cgrad ggg(k)=-ggg(k)
3775 C Uncomment following line for SC-p interactions
3776 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3780 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3782 cgrad kstart=min0(i+1,j)
3783 cgrad kend=max0(i-1,j-1)
3784 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3785 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3786 cgrad do k=kstart,kend
3788 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3792 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3793 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3801 C-----------------------------------------------------------------------------
3802 subroutine escp(evdw2,evdw2_14)
3804 C This subroutine calculates the excluded-volume interaction energy between
3805 C peptide-group centers and side chains and its gradient in virtual-bond and
3806 C side-chain vectors.
3808 implicit real*8 (a-h,o-z)
3809 include 'DIMENSIONS'
3810 include 'COMMON.GEO'
3811 include 'COMMON.VAR'
3812 include 'COMMON.LOCAL'
3813 include 'COMMON.CHAIN'
3814 include 'COMMON.DERIV'
3815 include 'COMMON.INTERACT'
3816 include 'COMMON.FFIELD'
3817 include 'COMMON.IOUNITS'
3818 include 'COMMON.CONTROL'
3822 cd print '(a)','Enter ESCP'
3823 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3824 do i=iatscp_s,iatscp_e
3826 xi=0.5D0*(c(1,i)+c(1,i+1))
3827 yi=0.5D0*(c(2,i)+c(2,i+1))
3828 zi=0.5D0*(c(3,i)+c(3,i+1))
3830 do iint=1,nscp_gr(i)
3832 do j=iscpstart(i,iint),iscpend(i,iint)
3834 C Uncomment following three lines for SC-p interactions
3838 C Uncomment following three lines for Ca-p interactions
3842 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3844 e1=fac*fac*aad(itypj,iteli)
3845 e2=fac*bad(itypj,iteli)
3846 if (iabs(j-i) .le. 2) then
3849 evdw2_14=evdw2_14+e1+e2
3853 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3854 & 'evdw2',i,j,evdwij
3856 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3858 fac=-(evdwij+e1)*rrij
3862 cgrad if (j.lt.i) then
3863 cd write (iout,*) 'j<i'
3864 C Uncomment following three lines for SC-p interactions
3866 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3869 cd write (iout,*) 'j>i'
3871 cgrad ggg(k)=-ggg(k)
3872 C Uncomment following line for SC-p interactions
3873 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3874 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3878 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3880 cgrad kstart=min0(i+1,j)
3881 cgrad kend=max0(i-1,j-1)
3882 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3883 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3884 cgrad do k=kstart,kend
3886 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3890 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3891 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3899 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3900 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
3901 gradx_scp(j,i)=expon*gradx_scp(j,i)
3904 C******************************************************************************
3908 C To save time the factor EXPON has been extracted from ALL components
3909 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3912 C******************************************************************************
3915 C--------------------------------------------------------------------------
3916 subroutine edis(ehpb)
3918 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3920 implicit real*8 (a-h,o-z)
3921 include 'DIMENSIONS'
3922 include 'COMMON.SBRIDGE'
3923 include 'COMMON.CHAIN'
3924 include 'COMMON.DERIV'
3925 include 'COMMON.VAR'
3926 include 'COMMON.INTERACT'
3927 include 'COMMON.IOUNITS'
3930 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
3931 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
3932 if (link_end.eq.0) return
3933 do i=link_start,link_end
3934 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3935 C CA-CA distance used in regularization of structure.
3938 C iii and jjj point to the residues for which the distance is assigned.
3939 if (ii.gt.nres) then
3946 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
3947 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3948 C distance and angle dependent SS bond potential.
3949 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
3950 call ssbond_ene(iii,jjj,eij)
3952 cd write (iout,*) "eij",eij
3954 C Calculate the distance between the two points and its difference from the
3958 C Get the force constant corresponding to this distance.
3960 C Calculate the contribution to energy.
3961 ehpb=ehpb+waga*rdis*rdis
3963 C Evaluate gradient.
3966 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3967 cd & ' waga=',waga,' fac=',fac
3969 ggg(j)=fac*(c(j,jj)-c(j,ii))
3971 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3972 C If this is a SC-SC distance, we need to calculate the contributions to the
3973 C Cartesian gradient in the SC vectors (ghpbx).
3976 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3977 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3980 cgrad do j=iii,jjj-1
3982 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3986 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3987 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3994 C--------------------------------------------------------------------------
3995 subroutine ssbond_ene(i,j,eij)
3997 C Calculate the distance and angle dependent SS-bond potential energy
3998 C using a free-energy function derived based on RHF/6-31G** ab initio
3999 C calculations of diethyl disulfide.
4001 C A. Liwo and U. Kozlowska, 11/24/03
4003 implicit real*8 (a-h,o-z)
4004 include 'DIMENSIONS'
4005 include 'COMMON.SBRIDGE'
4006 include 'COMMON.CHAIN'
4007 include 'COMMON.DERIV'
4008 include 'COMMON.LOCAL'
4009 include 'COMMON.INTERACT'
4010 include 'COMMON.VAR'
4011 include 'COMMON.IOUNITS'
4012 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4017 dxi=dc_norm(1,nres+i)
4018 dyi=dc_norm(2,nres+i)
4019 dzi=dc_norm(3,nres+i)
4020 c dsci_inv=dsc_inv(itypi)
4021 dsci_inv=vbld_inv(nres+i)
4023 c dscj_inv=dsc_inv(itypj)
4024 dscj_inv=vbld_inv(nres+j)
4028 dxj=dc_norm(1,nres+j)
4029 dyj=dc_norm(2,nres+j)
4030 dzj=dc_norm(3,nres+j)
4031 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4036 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4037 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4038 om12=dxi*dxj+dyi*dyj+dzi*dzj
4040 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4041 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4047 deltat12=om2-om1+2.0d0
4049 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4050 & +akct*deltad*deltat12
4051 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4052 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4053 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4054 c & " deltat12",deltat12," eij",eij
4055 ed=2*akcm*deltad+akct*deltat12
4057 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4058 eom1=-2*akth*deltat1-pom1-om2*pom2
4059 eom2= 2*akth*deltat2+pom1-om1*pom2
4062 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4063 ghpbx(k,i)=ghpbx(k,i)-ggk
4064 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4065 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4066 ghpbx(k,j)=ghpbx(k,j)+ggk
4067 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4068 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4069 ghpbc(k,i)=ghpbc(k,i)-ggk
4070 ghpbc(k,j)=ghpbc(k,j)+ggk
4073 C Calculate the components of the gradient in DC and X
4077 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4082 C--------------------------------------------------------------------------
4083 subroutine ebond(estr)
4085 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4087 implicit real*8 (a-h,o-z)
4088 include 'DIMENSIONS'
4089 include 'COMMON.LOCAL'
4090 include 'COMMON.GEO'
4091 include 'COMMON.INTERACT'
4092 include 'COMMON.DERIV'
4093 include 'COMMON.VAR'
4094 include 'COMMON.CHAIN'
4095 include 'COMMON.IOUNITS'
4096 include 'COMMON.NAMES'
4097 include 'COMMON.FFIELD'
4098 include 'COMMON.CONTROL'
4099 include 'COMMON.SETUP'
4100 double precision u(3),ud(3)
4102 do i=ibondp_start,ibondp_end
4103 diff = vbld(i)-vbldp0
4104 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4107 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4109 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4113 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4115 do i=ibond_start,ibond_end
4120 diff=vbld(i+nres)-vbldsc0(1,iti)
4121 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4122 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4123 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4125 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4129 diff=vbld(i+nres)-vbldsc0(j,iti)
4130 ud(j)=aksc(j,iti)*diff
4131 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4145 uprod2=uprod2*u(k)*u(k)
4149 usumsqder=usumsqder+ud(j)*uprod2
4151 estr=estr+uprod/usum
4153 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4161 C--------------------------------------------------------------------------
4162 subroutine ebend(etheta)
4164 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4165 C angles gamma and its derivatives in consecutive thetas and gammas.
4167 implicit real*8 (a-h,o-z)
4168 include 'DIMENSIONS'
4169 include 'COMMON.LOCAL'
4170 include 'COMMON.GEO'
4171 include 'COMMON.INTERACT'
4172 include 'COMMON.DERIV'
4173 include 'COMMON.VAR'
4174 include 'COMMON.CHAIN'
4175 include 'COMMON.IOUNITS'
4176 include 'COMMON.NAMES'
4177 include 'COMMON.FFIELD'
4178 include 'COMMON.CONTROL'
4179 common /calcthet/ term1,term2,termm,diffak,ratak,
4180 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4181 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4182 double precision y(2),z(2)
4184 c time11=dexp(-2*time)
4187 c write (*,'(a,i2)') 'EBEND ICG=',icg
4188 do i=ithet_start,ithet_end
4189 C Zero the energy function and its derivative at 0 or pi.
4190 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4195 if (phii.ne.phii) phii=150.0
4208 if (phii1.ne.phii1) phii1=150.0
4220 C Calculate the "mean" value of theta from the part of the distribution
4221 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4222 C In following comments this theta will be referred to as t_c.
4223 thet_pred_mean=0.0d0
4227 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4229 dthett=thet_pred_mean*ssd
4230 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4231 C Derivatives of the "mean" values in gamma1 and gamma2.
4232 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4233 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4234 if (theta(i).gt.pi-delta) then
4235 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4237 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4238 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4239 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4241 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4243 else if (theta(i).lt.delta) then
4244 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4245 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4246 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4248 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4249 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4252 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4255 etheta=etheta+ethetai
4256 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4258 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4259 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4260 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4262 C Ufff.... We've done all this!!!
4265 C---------------------------------------------------------------------------
4266 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4268 implicit real*8 (a-h,o-z)
4269 include 'DIMENSIONS'
4270 include 'COMMON.LOCAL'
4271 include 'COMMON.IOUNITS'
4272 common /calcthet/ term1,term2,termm,diffak,ratak,
4273 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4274 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4275 C Calculate the contributions to both Gaussian lobes.
4276 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4277 C The "polynomial part" of the "standard deviation" of this part of
4281 sig=sig*thet_pred_mean+polthet(j,it)
4283 C Derivative of the "interior part" of the "standard deviation of the"
4284 C gamma-dependent Gaussian lobe in t_c.
4285 sigtc=3*polthet(3,it)
4287 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4290 C Set the parameters of both Gaussian lobes of the distribution.
4291 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4292 fac=sig*sig+sigc0(it)
4295 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4296 sigsqtc=-4.0D0*sigcsq*sigtc
4297 c print *,i,sig,sigtc,sigsqtc
4298 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4299 sigtc=-sigtc/(fac*fac)
4300 C Following variable is sigma(t_c)**(-2)
4301 sigcsq=sigcsq*sigcsq
4303 sig0inv=1.0D0/sig0i**2
4304 delthec=thetai-thet_pred_mean
4305 delthe0=thetai-theta0i
4306 term1=-0.5D0*sigcsq*delthec*delthec
4307 term2=-0.5D0*sig0inv*delthe0*delthe0
4308 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4309 C NaNs in taking the logarithm. We extract the largest exponent which is added
4310 C to the energy (this being the log of the distribution) at the end of energy
4311 C term evaluation for this virtual-bond angle.
4312 if (term1.gt.term2) then
4314 term2=dexp(term2-termm)
4318 term1=dexp(term1-termm)
4321 C The ratio between the gamma-independent and gamma-dependent lobes of
4322 C the distribution is a Gaussian function of thet_pred_mean too.
4323 diffak=gthet(2,it)-thet_pred_mean
4324 ratak=diffak/gthet(3,it)**2
4325 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4326 C Let's differentiate it in thet_pred_mean NOW.
4328 C Now put together the distribution terms to make complete distribution.
4329 termexp=term1+ak*term2
4330 termpre=sigc+ak*sig0i
4331 C Contribution of the bending energy from this theta is just the -log of
4332 C the sum of the contributions from the two lobes and the pre-exponential
4333 C factor. Simple enough, isn't it?
4334 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4335 C NOW the derivatives!!!
4336 C 6/6/97 Take into account the deformation.
4337 E_theta=(delthec*sigcsq*term1
4338 & +ak*delthe0*sig0inv*term2)/termexp
4339 E_tc=((sigtc+aktc*sig0i)/termpre
4340 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4341 & aktc*term2)/termexp)
4344 c-----------------------------------------------------------------------------
4345 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4346 implicit real*8 (a-h,o-z)
4347 include 'DIMENSIONS'
4348 include 'COMMON.LOCAL'
4349 include 'COMMON.IOUNITS'
4350 common /calcthet/ term1,term2,termm,diffak,ratak,
4351 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4352 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4353 delthec=thetai-thet_pred_mean
4354 delthe0=thetai-theta0i
4355 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4356 t3 = thetai-thet_pred_mean
4360 t14 = t12+t6*sigsqtc
4362 t21 = thetai-theta0i
4368 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4369 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4370 & *(-t12*t9-ak*sig0inv*t27)
4374 C--------------------------------------------------------------------------
4375 subroutine ebend(etheta)
4377 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4378 C angles gamma and its derivatives in consecutive thetas and gammas.
4379 C ab initio-derived potentials from
4380 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4382 implicit real*8 (a-h,o-z)
4383 include 'DIMENSIONS'
4384 include 'COMMON.LOCAL'
4385 include 'COMMON.GEO'
4386 include 'COMMON.INTERACT'
4387 include 'COMMON.DERIV'
4388 include 'COMMON.VAR'
4389 include 'COMMON.CHAIN'
4390 include 'COMMON.IOUNITS'
4391 include 'COMMON.NAMES'
4392 include 'COMMON.FFIELD'
4393 include 'COMMON.CONTROL'
4394 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4395 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4396 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4397 & sinph1ph2(maxdouble,maxdouble)
4398 logical lprn /.false./, lprn1 /.false./
4400 do i=ithet_start,ithet_end
4404 theti2=0.5d0*theta(i)
4405 ityp2=ithetyp(itype(i-1))
4407 coskt(k)=dcos(k*theti2)
4408 sinkt(k)=dsin(k*theti2)
4413 if (phii.ne.phii) phii=150.0
4417 ityp1=ithetyp(itype(i-2))
4419 cosph1(k)=dcos(k*phii)
4420 sinph1(k)=dsin(k*phii)
4433 if (phii1.ne.phii1) phii1=150.0
4438 ityp3=ithetyp(itype(i))
4440 cosph2(k)=dcos(k*phii1)
4441 sinph2(k)=dsin(k*phii1)
4451 ethetai=aa0thet(ityp1,ityp2,ityp3)
4454 ccl=cosph1(l)*cosph2(k-l)
4455 ssl=sinph1(l)*sinph2(k-l)
4456 scl=sinph1(l)*cosph2(k-l)
4457 csl=cosph1(l)*sinph2(k-l)
4458 cosph1ph2(l,k)=ccl-ssl
4459 cosph1ph2(k,l)=ccl+ssl
4460 sinph1ph2(l,k)=scl+csl
4461 sinph1ph2(k,l)=scl-csl
4465 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4466 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4467 write (iout,*) "coskt and sinkt"
4469 write (iout,*) k,coskt(k),sinkt(k)
4473 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4474 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4477 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4478 & " ethetai",ethetai
4481 write (iout,*) "cosph and sinph"
4483 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4485 write (iout,*) "cosph1ph2 and sinph2ph2"
4488 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4489 & sinph1ph2(l,k),sinph1ph2(k,l)
4492 write(iout,*) "ethetai",ethetai
4496 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4497 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4498 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4499 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4500 ethetai=ethetai+sinkt(m)*aux
4501 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4502 dephii=dephii+k*sinkt(m)*(
4503 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4504 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4505 dephii1=dephii1+k*sinkt(m)*(
4506 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4507 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4509 & write (iout,*) "m",m," k",k," bbthet",
4510 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4511 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4512 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4513 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4517 & write(iout,*) "ethetai",ethetai
4521 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4522 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4523 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4524 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4525 ethetai=ethetai+sinkt(m)*aux
4526 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4527 dephii=dephii+l*sinkt(m)*(
4528 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4529 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4530 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4531 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4532 dephii1=dephii1+(k-l)*sinkt(m)*(
4533 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4534 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4535 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4536 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4538 write (iout,*) "m",m," k",k," l",l," ffthet",
4539 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4540 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4541 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4542 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4543 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4544 & cosph1ph2(k,l)*sinkt(m),
4545 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4551 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4552 & i,theta(i)*rad2deg,phii*rad2deg,
4553 & phii1*rad2deg,ethetai
4554 etheta=etheta+ethetai
4555 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4556 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4557 gloc(nphi+i-2,icg)=wang*dethetai
4563 c-----------------------------------------------------------------------------
4564 subroutine esc(escloc)
4565 C Calculate the local energy of a side chain and its derivatives in the
4566 C corresponding virtual-bond valence angles THETA and the spherical angles
4568 implicit real*8 (a-h,o-z)
4569 include 'DIMENSIONS'
4570 include 'COMMON.GEO'
4571 include 'COMMON.LOCAL'
4572 include 'COMMON.VAR'
4573 include 'COMMON.INTERACT'
4574 include 'COMMON.DERIV'
4575 include 'COMMON.CHAIN'
4576 include 'COMMON.IOUNITS'
4577 include 'COMMON.NAMES'
4578 include 'COMMON.FFIELD'
4579 include 'COMMON.CONTROL'
4580 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4581 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4582 common /sccalc/ time11,time12,time112,theti,it,nlobit
4585 c write (iout,'(a)') 'ESC'
4586 do i=loc_start,loc_end
4588 if (it.eq.10) goto 1
4590 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4591 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4592 theti=theta(i+1)-pipol
4597 if (x(2).gt.pi-delta) then
4601 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4603 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4604 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4606 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4607 & ddersc0(1),dersc(1))
4608 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4609 & ddersc0(3),dersc(3))
4611 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4613 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4614 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4615 & dersc0(2),esclocbi,dersc02)
4616 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4618 call splinthet(x(2),0.5d0*delta,ss,ssd)
4623 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4625 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4626 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4628 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4630 c write (iout,*) escloci
4631 else if (x(2).lt.delta) then
4635 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4637 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4638 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4640 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4641 & ddersc0(1),dersc(1))
4642 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4643 & ddersc0(3),dersc(3))
4645 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4647 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4648 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4649 & dersc0(2),esclocbi,dersc02)
4650 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4655 call splinthet(x(2),0.5d0*delta,ss,ssd)
4657 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4659 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4660 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4662 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4663 c write (iout,*) escloci
4665 call enesc(x,escloci,dersc,ddummy,.false.)
4668 escloc=escloc+escloci
4669 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4670 & 'escloc',i,escloci
4671 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4673 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4675 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4676 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4681 C---------------------------------------------------------------------------
4682 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4683 implicit real*8 (a-h,o-z)
4684 include 'DIMENSIONS'
4685 include 'COMMON.GEO'
4686 include 'COMMON.LOCAL'
4687 include 'COMMON.IOUNITS'
4688 common /sccalc/ time11,time12,time112,theti,it,nlobit
4689 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4690 double precision contr(maxlob,-1:1)
4692 c write (iout,*) 'it=',it,' nlobit=',nlobit
4696 if (mixed) ddersc(j)=0.0d0
4700 C Because of periodicity of the dependence of the SC energy in omega we have
4701 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4702 C To avoid underflows, first compute & store the exponents.
4710 z(k)=x(k)-censc(k,j,it)
4715 Axk=Axk+gaussc(l,k,j,it)*z(l)
4721 expfac=expfac+Ax(k,j,iii)*z(k)
4729 C As in the case of ebend, we want to avoid underflows in exponentiation and
4730 C subsequent NaNs and INFs in energy calculation.
4731 C Find the largest exponent
4735 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4739 cd print *,'it=',it,' emin=',emin
4741 C Compute the contribution to SC energy and derivatives
4746 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
4747 if(adexp.ne.adexp) adexp=1.0
4750 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4752 cd print *,'j=',j,' expfac=',expfac
4753 escloc_i=escloc_i+expfac
4755 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4759 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4760 & +gaussc(k,2,j,it))*expfac
4767 dersc(1)=dersc(1)/cos(theti)**2
4768 ddersc(1)=ddersc(1)/cos(theti)**2
4771 escloci=-(dlog(escloc_i)-emin)
4773 dersc(j)=dersc(j)/escloc_i
4777 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4782 C------------------------------------------------------------------------------
4783 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4784 implicit real*8 (a-h,o-z)
4785 include 'DIMENSIONS'
4786 include 'COMMON.GEO'
4787 include 'COMMON.LOCAL'
4788 include 'COMMON.IOUNITS'
4789 common /sccalc/ time11,time12,time112,theti,it,nlobit
4790 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4791 double precision contr(maxlob)
4802 z(k)=x(k)-censc(k,j,it)
4808 Axk=Axk+gaussc(l,k,j,it)*z(l)
4814 expfac=expfac+Ax(k,j)*z(k)
4819 C As in the case of ebend, we want to avoid underflows in exponentiation and
4820 C subsequent NaNs and INFs in energy calculation.
4821 C Find the largest exponent
4824 if (emin.gt.contr(j)) emin=contr(j)
4828 C Compute the contribution to SC energy and derivatives
4832 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4833 escloc_i=escloc_i+expfac
4835 dersc(k)=dersc(k)+Ax(k,j)*expfac
4837 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4838 & +gaussc(1,2,j,it))*expfac
4842 dersc(1)=dersc(1)/cos(theti)**2
4843 dersc12=dersc12/cos(theti)**2
4844 escloci=-(dlog(escloc_i)-emin)
4846 dersc(j)=dersc(j)/escloc_i
4848 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4852 c----------------------------------------------------------------------------------
4853 subroutine esc(escloc)
4854 C Calculate the local energy of a side chain and its derivatives in the
4855 C corresponding virtual-bond valence angles THETA and the spherical angles
4856 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4857 C added by Urszula Kozlowska. 07/11/2007
4859 implicit real*8 (a-h,o-z)
4860 include 'DIMENSIONS'
4861 include 'COMMON.GEO'
4862 include 'COMMON.LOCAL'
4863 include 'COMMON.VAR'
4864 include 'COMMON.SCROT'
4865 include 'COMMON.INTERACT'
4866 include 'COMMON.DERIV'
4867 include 'COMMON.CHAIN'
4868 include 'COMMON.IOUNITS'
4869 include 'COMMON.NAMES'
4870 include 'COMMON.FFIELD'
4871 include 'COMMON.CONTROL'
4872 include 'COMMON.VECTORS'
4873 double precision x_prime(3),y_prime(3),z_prime(3)
4874 & , sumene,dsc_i,dp2_i,x(65),
4875 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4876 & de_dxx,de_dyy,de_dzz,de_dt
4877 double precision s1_t,s1_6_t,s2_t,s2_6_t
4879 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4880 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4881 & dt_dCi(3),dt_dCi1(3)
4882 common /sccalc/ time11,time12,time112,theti,it,nlobit
4885 do i=loc_start,loc_end
4886 costtab(i+1) =dcos(theta(i+1))
4887 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4888 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4889 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4890 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4891 cosfac=dsqrt(cosfac2)
4892 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4893 sinfac=dsqrt(sinfac2)
4895 if (it.eq.10) goto 1
4897 C Compute the axes of tghe local cartesian coordinates system; store in
4898 c x_prime, y_prime and z_prime
4905 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4906 C & dc_norm(3,i+nres)
4908 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4909 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4912 z_prime(j) = -uz(j,i-1)
4915 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4916 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4917 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4918 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4919 c & " xy",scalar(x_prime(1),y_prime(1)),
4920 c & " xz",scalar(x_prime(1),z_prime(1)),
4921 c & " yy",scalar(y_prime(1),y_prime(1)),
4922 c & " yz",scalar(y_prime(1),z_prime(1)),
4923 c & " zz",scalar(z_prime(1),z_prime(1))
4925 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4926 C to local coordinate system. Store in xx, yy, zz.
4932 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4933 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4934 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4941 C Compute the energy of the ith side cbain
4943 c write (2,*) "xx",xx," yy",yy," zz",zz
4946 x(j) = sc_parmin(j,it)
4949 Cc diagnostics - remove later
4951 yy1 = dsin(alph(2))*dcos(omeg(2))
4952 zz1 = -dsin(alph(2))*dsin(omeg(2))
4953 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4954 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4956 C," --- ", xx_w,yy_w,zz_w
4959 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4960 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4962 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4963 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4965 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4966 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4967 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4968 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4969 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4971 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4972 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4973 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4974 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4975 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4977 dsc_i = 0.743d0+x(61)
4979 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4980 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4981 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4982 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4983 s1=(1+x(63))/(0.1d0 + dscp1)
4984 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4985 s2=(1+x(65))/(0.1d0 + dscp2)
4986 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4987 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4988 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4989 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4991 c & dscp1,dscp2,sumene
4992 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4993 escloc = escloc + sumene
4994 c write (2,*) "i",i," escloc",sumene,escloc
4997 C This section to check the numerical derivatives of the energy of ith side
4998 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4999 C #define DEBUG in the code to turn it on.
5001 write (2,*) "sumene =",sumene
5005 write (2,*) xx,yy,zz
5006 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5007 de_dxx_num=(sumenep-sumene)/aincr
5009 write (2,*) "xx+ sumene from enesc=",sumenep
5012 write (2,*) xx,yy,zz
5013 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5014 de_dyy_num=(sumenep-sumene)/aincr
5016 write (2,*) "yy+ sumene from enesc=",sumenep
5019 write (2,*) xx,yy,zz
5020 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5021 de_dzz_num=(sumenep-sumene)/aincr
5023 write (2,*) "zz+ sumene from enesc=",sumenep
5024 costsave=cost2tab(i+1)
5025 sintsave=sint2tab(i+1)
5026 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5027 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5028 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5029 de_dt_num=(sumenep-sumene)/aincr
5030 write (2,*) " t+ sumene from enesc=",sumenep
5031 cost2tab(i+1)=costsave
5032 sint2tab(i+1)=sintsave
5033 C End of diagnostics section.
5036 C Compute the gradient of esc
5038 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5039 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5040 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5041 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5042 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5043 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5044 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5045 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5046 pom1=(sumene3*sint2tab(i+1)+sumene1)
5047 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5048 pom2=(sumene4*cost2tab(i+1)+sumene2)
5049 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5050 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5051 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5052 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5054 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5055 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5056 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5058 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5059 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5060 & +(pom1+pom2)*pom_dx
5062 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5065 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5066 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5067 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5069 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5070 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5071 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5072 & +x(59)*zz**2 +x(60)*xx*zz
5073 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5074 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5075 & +(pom1-pom2)*pom_dy
5077 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5080 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5081 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5082 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5083 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5084 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5085 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5086 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5087 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5089 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5092 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5093 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5094 & +pom1*pom_dt1+pom2*pom_dt2
5096 write(2,*), "de_dt = ", de_dt,de_dt_num
5100 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5101 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5102 cosfac2xx=cosfac2*xx
5103 sinfac2yy=sinfac2*yy
5105 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5107 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5109 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5110 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5111 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5112 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5113 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5114 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5115 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5116 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5117 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5118 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5122 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5123 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5126 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5127 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5128 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5130 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5131 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5135 dXX_Ctab(k,i)=dXX_Ci(k)
5136 dXX_C1tab(k,i)=dXX_Ci1(k)
5137 dYY_Ctab(k,i)=dYY_Ci(k)
5138 dYY_C1tab(k,i)=dYY_Ci1(k)
5139 dZZ_Ctab(k,i)=dZZ_Ci(k)
5140 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5141 dXX_XYZtab(k,i)=dXX_XYZ(k)
5142 dYY_XYZtab(k,i)=dYY_XYZ(k)
5143 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5147 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5148 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5149 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5150 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5151 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5153 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5154 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5155 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5156 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5157 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5158 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5159 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5160 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5162 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5163 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5165 C to check gradient call subroutine check_grad
5171 c------------------------------------------------------------------------------
5172 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5174 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5175 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5176 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5177 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5179 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5180 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5182 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5183 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5184 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5185 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5186 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5188 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5189 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5190 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5191 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5192 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5194 dsc_i = 0.743d0+x(61)
5196 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5197 & *(xx*cost2+yy*sint2))
5198 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5199 & *(xx*cost2-yy*sint2))
5200 s1=(1+x(63))/(0.1d0 + dscp1)
5201 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5202 s2=(1+x(65))/(0.1d0 + dscp2)
5203 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5204 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5205 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5210 c------------------------------------------------------------------------------
5211 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5213 C This procedure calculates two-body contact function g(rij) and its derivative:
5216 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5219 C where x=(rij-r0ij)/delta
5221 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5224 double precision rij,r0ij,eps0ij,fcont,fprimcont
5225 double precision x,x2,x4,delta
5229 if (x.lt.-1.0D0) then
5232 else if (x.le.1.0D0) then
5235 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5236 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5243 c------------------------------------------------------------------------------
5244 subroutine splinthet(theti,delta,ss,ssder)
5245 implicit real*8 (a-h,o-z)
5246 include 'DIMENSIONS'
5247 include 'COMMON.VAR'
5248 include 'COMMON.GEO'
5251 if (theti.gt.pipol) then
5252 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5254 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5259 c------------------------------------------------------------------------------
5260 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5262 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5263 double precision ksi,ksi2,ksi3,a1,a2,a3
5264 a1=fprim0*delta/(f1-f0)
5270 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5271 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5274 c------------------------------------------------------------------------------
5275 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5277 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5278 double precision ksi,ksi2,ksi3,a1,a2,a3
5283 a2=3*(f1x-f0x)-2*fprim0x*delta
5284 a3=fprim0x*delta-2*(f1x-f0x)
5285 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5288 C-----------------------------------------------------------------------------
5290 C-----------------------------------------------------------------------------
5291 subroutine etor(etors,edihcnstr)
5292 implicit real*8 (a-h,o-z)
5293 include 'DIMENSIONS'
5294 include 'COMMON.VAR'
5295 include 'COMMON.GEO'
5296 include 'COMMON.LOCAL'
5297 include 'COMMON.TORSION'
5298 include 'COMMON.INTERACT'
5299 include 'COMMON.DERIV'
5300 include 'COMMON.CHAIN'
5301 include 'COMMON.NAMES'
5302 include 'COMMON.IOUNITS'
5303 include 'COMMON.FFIELD'
5304 include 'COMMON.TORCNSTR'
5305 include 'COMMON.CONTROL'
5307 C Set lprn=.true. for debugging
5311 do i=iphi_start,iphi_end
5313 itori=itortyp(itype(i-2))
5314 itori1=itortyp(itype(i-1))
5317 C Proline-Proline pair is a special case...
5318 if (itori.eq.3 .and. itori1.eq.3) then
5319 if (phii.gt.-dwapi3) then
5321 fac=1.0D0/(1.0D0-cosphi)
5322 etorsi=v1(1,3,3)*fac
5323 etorsi=etorsi+etorsi
5324 etors=etors+etorsi-v1(1,3,3)
5325 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5326 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5329 v1ij=v1(j+1,itori,itori1)
5330 v2ij=v2(j+1,itori,itori1)
5333 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5334 if (energy_dec) etors_ii=etors_ii+
5335 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5336 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5340 v1ij=v1(j,itori,itori1)
5341 v2ij=v2(j,itori,itori1)
5344 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5345 if (energy_dec) etors_ii=etors_ii+
5346 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5347 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5350 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5353 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5354 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5355 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5356 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5357 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5359 ! 6/20/98 - dihedral angle constraints
5362 itori=idih_constr(i)
5365 if (difi.gt.drange(i)) then
5367 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5368 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5369 else if (difi.lt.-drange(i)) then
5371 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5372 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5374 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5375 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5377 ! write (iout,*) 'edihcnstr',edihcnstr
5380 c------------------------------------------------------------------------------
5381 subroutine etor_d(etors_d)
5385 c----------------------------------------------------------------------------
5387 subroutine etor(etors,edihcnstr)
5388 implicit real*8 (a-h,o-z)
5389 include 'DIMENSIONS'
5390 include 'COMMON.VAR'
5391 include 'COMMON.GEO'
5392 include 'COMMON.LOCAL'
5393 include 'COMMON.TORSION'
5394 include 'COMMON.INTERACT'
5395 include 'COMMON.DERIV'
5396 include 'COMMON.CHAIN'
5397 include 'COMMON.NAMES'
5398 include 'COMMON.IOUNITS'
5399 include 'COMMON.FFIELD'
5400 include 'COMMON.TORCNSTR'
5401 include 'COMMON.CONTROL'
5403 C Set lprn=.true. for debugging
5407 do i=iphi_start,iphi_end
5409 itori=itortyp(itype(i-2))
5410 itori1=itortyp(itype(i-1))
5413 C Regular cosine and sine terms
5414 do j=1,nterm(itori,itori1)
5415 v1ij=v1(j,itori,itori1)
5416 v2ij=v2(j,itori,itori1)
5419 etors=etors+v1ij*cosphi+v2ij*sinphi
5420 if (energy_dec) etors_ii=etors_ii+
5421 & v1ij*cosphi+v2ij*sinphi
5422 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5426 C E = SUM ----------------------------------- - v1
5427 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5429 cosphi=dcos(0.5d0*phii)
5430 sinphi=dsin(0.5d0*phii)
5431 do j=1,nlor(itori,itori1)
5432 vl1ij=vlor1(j,itori,itori1)
5433 vl2ij=vlor2(j,itori,itori1)
5434 vl3ij=vlor3(j,itori,itori1)
5435 pom=vl2ij*cosphi+vl3ij*sinphi
5436 pom1=1.0d0/(pom*pom+1.0d0)
5437 etors=etors+vl1ij*pom1
5438 if (energy_dec) etors_ii=etors_ii+
5441 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5443 C Subtract the constant term
5444 etors=etors-v0(itori,itori1)
5445 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5446 & 'etor',i,etors_ii-v0(itori,itori1)
5448 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5449 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5450 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5451 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5452 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5454 ! 6/20/98 - dihedral angle constraints
5456 c do i=1,ndih_constr
5457 do i=idihconstr_start,idihconstr_end
5458 itori=idih_constr(i)
5460 difi=pinorm(phii-phi0(i))
5461 if (difi.gt.drange(i)) then
5463 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5464 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5465 else if (difi.lt.-drange(i)) then
5467 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5468 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5472 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5473 cd & rad2deg*phi0(i), rad2deg*drange(i),
5474 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5476 cd write (iout,*) 'edihcnstr',edihcnstr
5479 c----------------------------------------------------------------------------
5480 subroutine etor_d(etors_d)
5481 C 6/23/01 Compute double torsional energy
5482 implicit real*8 (a-h,o-z)
5483 include 'DIMENSIONS'
5484 include 'COMMON.VAR'
5485 include 'COMMON.GEO'
5486 include 'COMMON.LOCAL'
5487 include 'COMMON.TORSION'
5488 include 'COMMON.INTERACT'
5489 include 'COMMON.DERIV'
5490 include 'COMMON.CHAIN'
5491 include 'COMMON.NAMES'
5492 include 'COMMON.IOUNITS'
5493 include 'COMMON.FFIELD'
5494 include 'COMMON.TORCNSTR'
5496 C Set lprn=.true. for debugging
5500 do i=iphid_start,iphid_end
5501 itori=itortyp(itype(i-2))
5502 itori1=itortyp(itype(i-1))
5503 itori2=itortyp(itype(i))
5508 C Regular cosine and sine terms
5509 do j=1,ntermd_1(itori,itori1,itori2)
5510 v1cij=v1c(1,j,itori,itori1,itori2)
5511 v1sij=v1s(1,j,itori,itori1,itori2)
5512 v2cij=v1c(2,j,itori,itori1,itori2)
5513 v2sij=v1s(2,j,itori,itori1,itori2)
5514 cosphi1=dcos(j*phii)
5515 sinphi1=dsin(j*phii)
5516 cosphi2=dcos(j*phii1)
5517 sinphi2=dsin(j*phii1)
5518 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5519 & v2cij*cosphi2+v2sij*sinphi2
5520 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5521 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5523 do k=2,ntermd_2(itori,itori1,itori2)
5525 v1cdij = v2c(k,l,itori,itori1,itori2)
5526 v2cdij = v2c(l,k,itori,itori1,itori2)
5527 v1sdij = v2s(k,l,itori,itori1,itori2)
5528 v2sdij = v2s(l,k,itori,itori1,itori2)
5529 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5530 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5531 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5532 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5533 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5534 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5535 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5536 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5537 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5538 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5541 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5542 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5547 c------------------------------------------------------------------------------
5548 subroutine eback_sc_corr(esccor)
5549 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5550 c conformational states; temporarily implemented as differences
5551 c between UNRES torsional potentials (dependent on three types of
5552 c residues) and the torsional potentials dependent on all 20 types
5553 c of residues computed from AM1 energy surfaces of terminally-blocked
5554 c amino-acid residues.
5555 implicit real*8 (a-h,o-z)
5556 include 'DIMENSIONS'
5557 include 'COMMON.VAR'
5558 include 'COMMON.GEO'
5559 include 'COMMON.LOCAL'
5560 include 'COMMON.TORSION'
5561 include 'COMMON.SCCOR'
5562 include 'COMMON.INTERACT'
5563 include 'COMMON.DERIV'
5564 include 'COMMON.CHAIN'
5565 include 'COMMON.NAMES'
5566 include 'COMMON.IOUNITS'
5567 include 'COMMON.FFIELD'
5568 include 'COMMON.CONTROL'
5570 C Set lprn=.true. for debugging
5573 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5575 do i=iphi_start,iphi_end
5582 v1ij=v1sccor(j,itori,itori1)
5583 v2ij=v2sccor(j,itori,itori1)
5586 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5587 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5590 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5591 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5592 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5593 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5597 c----------------------------------------------------------------------------
5598 subroutine multibody(ecorr)
5599 C This subroutine calculates multi-body contributions to energy following
5600 C the idea of Skolnick et al. If side chains I and J make a contact and
5601 C at the same time side chains I+1 and J+1 make a contact, an extra
5602 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5603 implicit real*8 (a-h,o-z)
5604 include 'DIMENSIONS'
5605 include 'COMMON.IOUNITS'
5606 include 'COMMON.DERIV'
5607 include 'COMMON.INTERACT'
5608 include 'COMMON.CONTACTS'
5609 double precision gx(3),gx1(3)
5612 C Set lprn=.true. for debugging
5616 write (iout,'(a)') 'Contact function values:'
5618 write (iout,'(i2,20(1x,i2,f10.5))')
5619 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5634 num_conti=num_cont(i)
5635 num_conti1=num_cont(i1)
5640 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5641 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5642 cd & ' ishift=',ishift
5643 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5644 C The system gains extra energy.
5645 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5646 endif ! j1==j+-ishift
5655 c------------------------------------------------------------------------------
5656 double precision function esccorr(i,j,k,l,jj,kk)
5657 implicit real*8 (a-h,o-z)
5658 include 'DIMENSIONS'
5659 include 'COMMON.IOUNITS'
5660 include 'COMMON.DERIV'
5661 include 'COMMON.INTERACT'
5662 include 'COMMON.CONTACTS'
5663 double precision gx(3),gx1(3)
5668 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5669 C Calculate the multi-body contribution to energy.
5670 C Calculate multi-body contributions to the gradient.
5671 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5672 cd & k,l,(gacont(m,kk,k),m=1,3)
5674 gx(m) =ekl*gacont(m,jj,i)
5675 gx1(m)=eij*gacont(m,kk,k)
5676 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5677 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5678 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5679 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5683 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5688 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5694 c------------------------------------------------------------------------------
5695 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5696 C This subroutine calculates multi-body contributions to hydrogen-bonding
5697 implicit real*8 (a-h,o-z)
5698 include 'DIMENSIONS'
5699 include 'COMMON.IOUNITS'
5702 parameter (max_cont=maxconts)
5703 parameter (max_dim=26)
5704 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5705 double precision zapas(max_dim,maxconts,max_fg_procs),
5706 & zapas_recv(max_dim,maxconts,max_fg_procs)
5707 common /przechowalnia/ zapas
5708 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5709 & status_array(MPI_STATUS_SIZE,maxconts*2)
5711 include 'COMMON.SETUP'
5712 include 'COMMON.FFIELD'
5713 include 'COMMON.DERIV'
5714 include 'COMMON.INTERACT'
5715 include 'COMMON.CONTACTS'
5716 include 'COMMON.CONTROL'
5717 include 'COMMON.LOCAL'
5718 double precision gx(3),gx1(3),time00
5721 C Set lprn=.true. for debugging
5726 if (nfgtasks.le.1) goto 30
5728 write (iout,'(a)') 'Contact function values before RECEIVE:'
5730 write (iout,'(2i3,50(1x,i2,f5.2))')
5731 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5732 & j=1,num_cont_hb(i))
5736 do i=1,ntask_cont_from
5739 do i=1,ntask_cont_to
5742 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5744 C Make the list of contacts to send to send to other procesors
5745 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5747 do i=iturn3_start,iturn3_end
5748 c write (iout,*) "make contact list turn3",i," num_cont",
5750 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5752 do i=iturn4_start,iturn4_end
5753 c write (iout,*) "make contact list turn4",i," num_cont",
5755 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5759 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5761 do j=1,num_cont_hb(i)
5764 iproc=iint_sent_local(k,jjc,ii)
5765 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5766 if (iproc.gt.0) then
5767 ncont_sent(iproc)=ncont_sent(iproc)+1
5768 nn=ncont_sent(iproc)
5770 zapas(2,nn,iproc)=jjc
5771 zapas(3,nn,iproc)=facont_hb(j,i)
5772 zapas(4,nn,iproc)=ees0p(j,i)
5773 zapas(5,nn,iproc)=ees0m(j,i)
5774 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5775 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5776 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5777 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5778 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5779 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5780 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5781 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5782 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5783 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5784 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
5785 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
5786 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
5787 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
5788 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
5789 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
5790 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
5791 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
5792 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
5793 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
5794 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
5801 & "Numbers of contacts to be sent to other processors",
5802 & (ncont_sent(i),i=1,ntask_cont_to)
5803 write (iout,*) "Contacts sent"
5804 do ii=1,ntask_cont_to
5806 iproc=itask_cont_to(ii)
5807 write (iout,*) nn," contacts to processor",iproc,
5808 & " of CONT_TO_COMM group"
5810 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
5818 CorrelID1=nfgtasks+fg_rank+1
5820 C Receive the numbers of needed contacts from other processors
5821 do ii=1,ntask_cont_from
5822 iproc=itask_cont_from(ii)
5824 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
5825 & FG_COMM,req(ireq),IERR)
5827 c write (iout,*) "IRECV ended"
5829 C Send the number of contacts needed by other processors
5830 do ii=1,ntask_cont_to
5831 iproc=itask_cont_to(ii)
5833 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
5834 & FG_COMM,req(ireq),IERR)
5836 c write (iout,*) "ISEND ended"
5837 c write (iout,*) "number of requests (nn)",ireq
5840 & call MPI_Waitall(ireq,req,status_array,ierr)
5842 c & "Numbers of contacts to be received from other processors",
5843 c & (ncont_recv(i),i=1,ntask_cont_from)
5847 do ii=1,ntask_cont_from
5848 iproc=itask_cont_from(ii)
5850 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
5851 c & " of CONT_TO_COMM group"
5855 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
5856 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
5857 c write (iout,*) "ireq,req",ireq,req(ireq)
5860 C Send the contacts to processors that need them
5861 do ii=1,ntask_cont_to
5862 iproc=itask_cont_to(ii)
5864 c write (iout,*) nn," contacts to processor",iproc,
5865 c & " of CONT_TO_COMM group"
5868 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
5869 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
5870 c write (iout,*) "ireq,req",ireq,req(ireq)
5872 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
5876 c write (iout,*) "number of requests (contacts)",ireq
5877 c write (iout,*) "req",(req(i),i=1,4)
5880 & call MPI_Waitall(ireq,req,status_array,ierr)
5881 do iii=1,ntask_cont_from
5882 iproc=itask_cont_from(iii)
5885 write (iout,*) "Received",nn," contacts from processor",iproc,
5886 & " of CONT_FROM_COMM group"
5889 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
5894 ii=zapas_recv(1,i,iii)
5895 c Flag the received contacts to prevent double-counting
5896 jj=-zapas_recv(2,i,iii)
5897 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
5899 nnn=num_cont_hb(ii)+1
5902 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
5903 ees0p(nnn,ii)=zapas_recv(4,i,iii)
5904 ees0m(nnn,ii)=zapas_recv(5,i,iii)
5905 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
5906 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
5907 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
5908 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
5909 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
5910 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
5911 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
5912 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
5913 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
5914 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
5915 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
5916 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
5917 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
5918 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
5919 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
5920 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
5921 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
5922 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
5923 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
5924 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
5925 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
5930 write (iout,'(a)') 'Contact function values after receive:'
5932 write (iout,'(2i3,50(1x,i3,f5.2))')
5933 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5934 & j=1,num_cont_hb(i))
5941 write (iout,'(a)') 'Contact function values:'
5943 write (iout,'(2i3,50(1x,i3,f5.2))')
5944 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5945 & j=1,num_cont_hb(i))
5949 C Remove the loop below after debugging !!!
5956 C Calculate the local-electrostatic correlation terms
5957 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
5959 num_conti=num_cont_hb(i)
5960 num_conti1=num_cont_hb(i+1)
5967 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5968 c & ' jj=',jj,' kk=',kk
5969 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
5970 & .or. j.lt.0 .and. j1.gt.0) .and.
5971 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
5972 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5973 C The system gains extra energy.
5974 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
5975 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5976 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5978 else if (j1.eq.j) then
5979 C Contacts I-J and I-(J+1) occur simultaneously.
5980 C The system loses extra energy.
5981 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5986 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5987 c & ' jj=',jj,' kk=',kk
5989 C Contacts I-J and (I+1)-J occur simultaneously.
5990 C The system loses extra energy.
5991 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5998 c------------------------------------------------------------------------------
5999 subroutine add_hb_contact(ii,jj,itask)
6000 implicit real*8 (a-h,o-z)
6001 include "DIMENSIONS"
6002 include "COMMON.IOUNITS"
6005 parameter (max_cont=maxconts)
6006 parameter (max_dim=26)
6007 include "COMMON.CONTACTS"
6008 double precision zapas(max_dim,maxconts,max_fg_procs),
6009 & zapas_recv(max_dim,maxconts,max_fg_procs)
6010 common /przechowalnia/ zapas
6011 integer i,j,ii,jj,iproc,itask(4),nn
6012 c write (iout,*) "itask",itask
6015 if (iproc.gt.0) then
6016 do j=1,num_cont_hb(ii)
6018 c write (iout,*) "i",ii," j",jj," jjc",jjc
6020 ncont_sent(iproc)=ncont_sent(iproc)+1
6021 nn=ncont_sent(iproc)
6022 zapas(1,nn,iproc)=ii
6023 zapas(2,nn,iproc)=jjc
6024 zapas(3,nn,iproc)=facont_hb(j,ii)
6025 zapas(4,nn,iproc)=ees0p(j,ii)
6026 zapas(5,nn,iproc)=ees0m(j,ii)
6027 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6028 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6029 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6030 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6031 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6032 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6033 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6034 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6035 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6036 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6037 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6038 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6039 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6040 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6041 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6042 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6043 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6044 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6045 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6046 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6047 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6055 c------------------------------------------------------------------------------
6056 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6058 C This subroutine calculates multi-body contributions to hydrogen-bonding
6059 implicit real*8 (a-h,o-z)
6060 include 'DIMENSIONS'
6061 include 'COMMON.IOUNITS'
6064 parameter (max_cont=maxconts)
6065 parameter (max_dim=70)
6066 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6067 double precision zapas(max_dim,maxconts,max_fg_procs),
6068 & zapas_recv(max_dim,maxconts,max_fg_procs)
6069 common /przechowalnia/ zapas
6070 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6071 & status_array(MPI_STATUS_SIZE,maxconts*2)
6073 include 'COMMON.SETUP'
6074 include 'COMMON.FFIELD'
6075 include 'COMMON.DERIV'
6076 include 'COMMON.LOCAL'
6077 include 'COMMON.INTERACT'
6078 include 'COMMON.CONTACTS'
6079 include 'COMMON.CHAIN'
6080 include 'COMMON.CONTROL'
6081 double precision gx(3),gx1(3)
6082 integer num_cont_hb_old(maxres)
6084 double precision eello4,eello5,eelo6,eello_turn6
6085 external eello4,eello5,eello6,eello_turn6
6086 C Set lprn=.true. for debugging
6091 num_cont_hb_old(i)=num_cont_hb(i)
6095 if (nfgtasks.le.1) goto 30
6097 write (iout,'(a)') 'Contact function values before RECEIVE:'
6099 write (iout,'(2i3,50(1x,i2,f5.2))')
6100 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6101 & j=1,num_cont_hb(i))
6105 do i=1,ntask_cont_from
6108 do i=1,ntask_cont_to
6111 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6113 C Make the list of contacts to send to send to other procesors
6114 do i=iturn3_start,iturn3_end
6115 c write (iout,*) "make contact list turn3",i," num_cont",
6117 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6119 do i=iturn4_start,iturn4_end
6120 c write (iout,*) "make contact list turn4",i," num_cont",
6122 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6126 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6128 do j=1,num_cont_hb(i)
6131 iproc=iint_sent_local(k,jjc,ii)
6132 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6133 if (iproc.ne.0) then
6134 ncont_sent(iproc)=ncont_sent(iproc)+1
6135 nn=ncont_sent(iproc)
6137 zapas(2,nn,iproc)=jjc
6138 zapas(3,nn,iproc)=d_cont(j,i)
6142 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6147 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6155 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6166 & "Numbers of contacts to be sent to other processors",
6167 & (ncont_sent(i),i=1,ntask_cont_to)
6168 write (iout,*) "Contacts sent"
6169 do ii=1,ntask_cont_to
6171 iproc=itask_cont_to(ii)
6172 write (iout,*) nn," contacts to processor",iproc,
6173 & " of CONT_TO_COMM group"
6175 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6183 CorrelID1=nfgtasks+fg_rank+1
6185 C Receive the numbers of needed contacts from other processors
6186 do ii=1,ntask_cont_from
6187 iproc=itask_cont_from(ii)
6189 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6190 & FG_COMM,req(ireq),IERR)
6192 c write (iout,*) "IRECV ended"
6194 C Send the number of contacts needed by other processors
6195 do ii=1,ntask_cont_to
6196 iproc=itask_cont_to(ii)
6198 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6199 & FG_COMM,req(ireq),IERR)
6201 c write (iout,*) "ISEND ended"
6202 c write (iout,*) "number of requests (nn)",ireq
6205 & call MPI_Waitall(ireq,req,status_array,ierr)
6207 c & "Numbers of contacts to be received from other processors",
6208 c & (ncont_recv(i),i=1,ntask_cont_from)
6212 do ii=1,ntask_cont_from
6213 iproc=itask_cont_from(ii)
6215 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6216 c & " of CONT_TO_COMM group"
6220 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6221 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6222 c write (iout,*) "ireq,req",ireq,req(ireq)
6225 C Send the contacts to processors that need them
6226 do ii=1,ntask_cont_to
6227 iproc=itask_cont_to(ii)
6229 c write (iout,*) nn," contacts to processor",iproc,
6230 c & " of CONT_TO_COMM group"
6233 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6234 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6235 c write (iout,*) "ireq,req",ireq,req(ireq)
6237 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6241 c write (iout,*) "number of requests (contacts)",ireq
6242 c write (iout,*) "req",(req(i),i=1,4)
6245 & call MPI_Waitall(ireq,req,status_array,ierr)
6246 do iii=1,ntask_cont_from
6247 iproc=itask_cont_from(iii)
6250 write (iout,*) "Received",nn," contacts from processor",iproc,
6251 & " of CONT_FROM_COMM group"
6254 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6259 ii=zapas_recv(1,i,iii)
6260 c Flag the received contacts to prevent double-counting
6261 jj=-zapas_recv(2,i,iii)
6262 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6264 nnn=num_cont_hb(ii)+1
6267 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6271 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6276 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6284 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6293 write (iout,'(a)') 'Contact function values after receive:'
6295 write (iout,'(2i3,50(1x,i3,5f6.3))')
6296 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6297 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6304 write (iout,'(a)') 'Contact function values:'
6306 write (iout,'(2i3,50(1x,i2,5f6.3))')
6307 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6308 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6314 C Remove the loop below after debugging !!!
6321 C Calculate the dipole-dipole interaction energies
6322 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6323 do i=iatel_s,iatel_e+1
6324 num_conti=num_cont_hb(i)
6333 C Calculate the local-electrostatic correlation terms
6334 c write (iout,*) "gradcorr5 in eello5 before loop"
6336 c write (iout,'(i5,3f10.5)')
6337 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6339 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6340 c write (iout,*) "corr loop i",i
6342 num_conti=num_cont_hb(i)
6343 num_conti1=num_cont_hb(i+1)
6350 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6351 c & ' jj=',jj,' kk=',kk
6352 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6353 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6354 & .or. j.lt.0 .and. j1.gt.0) .and.
6355 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6356 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6357 C The system gains extra energy.
6359 sqd1=dsqrt(d_cont(jj,i))
6360 sqd2=dsqrt(d_cont(kk,i1))
6361 sred_geom = sqd1*sqd2
6362 IF (sred_geom.lt.cutoff_corr) THEN
6363 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6365 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6366 cd & ' jj=',jj,' kk=',kk
6367 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6368 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6370 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6371 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6374 cd write (iout,*) 'sred_geom=',sred_geom,
6375 cd & ' ekont=',ekont,' fprim=',fprimcont,
6376 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6377 cd write (iout,*) "g_contij",g_contij
6378 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6379 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6380 call calc_eello(i,jp,i+1,jp1,jj,kk)
6381 if (wcorr4.gt.0.0d0)
6382 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6383 if (energy_dec.and.wcorr4.gt.0.0d0)
6384 1 write (iout,'(a6,4i5,0pf7.3)')
6385 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6386 c write (iout,*) "gradcorr5 before eello5"
6388 c write (iout,'(i5,3f10.5)')
6389 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6391 if (wcorr5.gt.0.0d0)
6392 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6393 c write (iout,*) "gradcorr5 after eello5"
6395 c write (iout,'(i5,3f10.5)')
6396 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6398 if (energy_dec.and.wcorr5.gt.0.0d0)
6399 1 write (iout,'(a6,4i5,0pf7.3)')
6400 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6401 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6402 cd write(2,*)'ijkl',i,jp,i+1,jp1
6403 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6404 & .or. wturn6.eq.0.0d0))then
6405 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6406 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6407 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6408 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6409 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6410 cd & 'ecorr6=',ecorr6
6411 cd write (iout,'(4e15.5)') sred_geom,
6412 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6413 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6414 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6415 else if (wturn6.gt.0.0d0
6416 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6417 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6418 eturn6=eturn6+eello_turn6(i,jj,kk)
6419 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6420 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6421 cd write (2,*) 'multibody_eello:eturn6',eturn6
6430 num_cont_hb(i)=num_cont_hb_old(i)
6432 c write (iout,*) "gradcorr5 in eello5"
6434 c write (iout,'(i5,3f10.5)')
6435 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6439 c------------------------------------------------------------------------------
6440 subroutine add_hb_contact_eello(ii,jj,itask)
6441 implicit real*8 (a-h,o-z)
6442 include "DIMENSIONS"
6443 include "COMMON.IOUNITS"
6446 parameter (max_cont=maxconts)
6447 parameter (max_dim=70)
6448 include "COMMON.CONTACTS"
6449 double precision zapas(max_dim,maxconts,max_fg_procs),
6450 & zapas_recv(max_dim,maxconts,max_fg_procs)
6451 common /przechowalnia/ zapas
6452 integer i,j,ii,jj,iproc,itask(4),nn
6453 c write (iout,*) "itask",itask
6456 if (iproc.gt.0) then
6457 do j=1,num_cont_hb(ii)
6459 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6461 ncont_sent(iproc)=ncont_sent(iproc)+1
6462 nn=ncont_sent(iproc)
6463 zapas(1,nn,iproc)=ii
6464 zapas(2,nn,iproc)=jjc
6465 zapas(3,nn,iproc)=d_cont(j,ii)
6469 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6474 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6482 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6494 c------------------------------------------------------------------------------
6495 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6496 implicit real*8 (a-h,o-z)
6497 include 'DIMENSIONS'
6498 include 'COMMON.IOUNITS'
6499 include 'COMMON.DERIV'
6500 include 'COMMON.INTERACT'
6501 include 'COMMON.CONTACTS'
6502 double precision gx(3),gx1(3)
6512 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6513 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6514 C Following 4 lines for diagnostics.
6519 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6520 c & 'Contacts ',i,j,
6521 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6522 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6524 C Calculate the multi-body contribution to energy.
6525 ecorr=ecorr+ekont*ees
6526 C Calculate multi-body contributions to the gradient.
6527 coeffpees0pij=coeffp*ees0pij
6528 coeffmees0mij=coeffm*ees0mij
6529 coeffpees0pkl=coeffp*ees0pkl
6530 coeffmees0mkl=coeffm*ees0mkl
6532 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6533 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6534 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6535 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6536 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6537 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6538 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6539 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6540 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6541 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6542 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6543 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6544 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6545 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6546 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6547 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6548 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6549 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6550 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6551 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6552 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6553 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6554 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6555 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6556 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6561 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6562 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6563 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6564 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6569 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6570 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6571 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6572 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6575 c write (iout,*) "ehbcorr",ekont*ees
6580 C---------------------------------------------------------------------------
6581 subroutine dipole(i,j,jj)
6582 implicit real*8 (a-h,o-z)
6583 include 'DIMENSIONS'
6584 include 'COMMON.IOUNITS'
6585 include 'COMMON.CHAIN'
6586 include 'COMMON.FFIELD'
6587 include 'COMMON.DERIV'
6588 include 'COMMON.INTERACT'
6589 include 'COMMON.CONTACTS'
6590 include 'COMMON.TORSION'
6591 include 'COMMON.VAR'
6592 include 'COMMON.GEO'
6593 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6595 iti1 = itortyp(itype(i+1))
6596 if (j.lt.nres-1) then
6597 itj1 = itortyp(itype(j+1))
6602 dipi(iii,1)=Ub2(iii,i)
6603 dipderi(iii)=Ub2der(iii,i)
6604 dipi(iii,2)=b1(iii,iti1)
6605 dipj(iii,1)=Ub2(iii,j)
6606 dipderj(iii)=Ub2der(iii,j)
6607 dipj(iii,2)=b1(iii,itj1)
6611 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6614 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6621 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6625 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6630 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6631 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6633 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6635 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6637 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6642 C---------------------------------------------------------------------------
6643 subroutine calc_eello(i,j,k,l,jj,kk)
6645 C This subroutine computes matrices and vectors needed to calculate
6646 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6648 implicit real*8 (a-h,o-z)
6649 include 'DIMENSIONS'
6650 include 'COMMON.IOUNITS'
6651 include 'COMMON.CHAIN'
6652 include 'COMMON.DERIV'
6653 include 'COMMON.INTERACT'
6654 include 'COMMON.CONTACTS'
6655 include 'COMMON.TORSION'
6656 include 'COMMON.VAR'
6657 include 'COMMON.GEO'
6658 include 'COMMON.FFIELD'
6659 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6660 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6663 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6664 cd & ' jj=',jj,' kk=',kk
6665 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6666 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6667 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6670 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6671 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6674 call transpose2(aa1(1,1),aa1t(1,1))
6675 call transpose2(aa2(1,1),aa2t(1,1))
6678 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6679 & aa1tder(1,1,lll,kkk))
6680 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6681 & aa2tder(1,1,lll,kkk))
6685 C parallel orientation of the two CA-CA-CA frames.
6687 iti=itortyp(itype(i))
6691 itk1=itortyp(itype(k+1))
6692 itj=itortyp(itype(j))
6693 if (l.lt.nres-1) then
6694 itl1=itortyp(itype(l+1))
6698 C A1 kernel(j+1) A2T
6700 cd write (iout,'(3f10.5,5x,3f10.5)')
6701 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6703 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6704 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6705 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6706 C Following matrices are needed only for 6-th order cumulants
6707 IF (wcorr6.gt.0.0d0) THEN
6708 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6709 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6710 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6711 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6712 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6713 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6714 & ADtEAderx(1,1,1,1,1,1))
6716 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6717 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6718 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6719 & ADtEA1derx(1,1,1,1,1,1))
6721 C End 6-th order cumulants
6724 cd write (2,*) 'In calc_eello6'
6726 cd write (2,*) 'iii=',iii
6728 cd write (2,*) 'kkk=',kkk
6730 cd write (2,'(3(2f10.5),5x)')
6731 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6736 call transpose2(EUgder(1,1,k),auxmat(1,1))
6737 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6738 call transpose2(EUg(1,1,k),auxmat(1,1))
6739 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6740 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6744 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6745 & EAEAderx(1,1,lll,kkk,iii,1))
6749 C A1T kernel(i+1) A2
6750 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6751 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6752 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6753 C Following matrices are needed only for 6-th order cumulants
6754 IF (wcorr6.gt.0.0d0) THEN
6755 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6756 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6757 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6758 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6759 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6760 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6761 & ADtEAderx(1,1,1,1,1,2))
6762 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6763 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6764 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6765 & ADtEA1derx(1,1,1,1,1,2))
6767 C End 6-th order cumulants
6768 call transpose2(EUgder(1,1,l),auxmat(1,1))
6769 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6770 call transpose2(EUg(1,1,l),auxmat(1,1))
6771 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6772 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6776 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6777 & EAEAderx(1,1,lll,kkk,iii,2))
6782 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6783 C They are needed only when the fifth- or the sixth-order cumulants are
6785 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6786 call transpose2(AEA(1,1,1),auxmat(1,1))
6787 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6788 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6789 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6790 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6791 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6792 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6793 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6794 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6795 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6796 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6797 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6798 call transpose2(AEA(1,1,2),auxmat(1,1))
6799 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6800 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6801 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6802 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6803 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6804 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6805 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6806 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6807 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6808 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6809 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6810 C Calculate the Cartesian derivatives of the vectors.
6814 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6815 call matvec2(auxmat(1,1),b1(1,iti),
6816 & AEAb1derx(1,lll,kkk,iii,1,1))
6817 call matvec2(auxmat(1,1),Ub2(1,i),
6818 & AEAb2derx(1,lll,kkk,iii,1,1))
6819 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6820 & AEAb1derx(1,lll,kkk,iii,2,1))
6821 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6822 & AEAb2derx(1,lll,kkk,iii,2,1))
6823 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6824 call matvec2(auxmat(1,1),b1(1,itj),
6825 & AEAb1derx(1,lll,kkk,iii,1,2))
6826 call matvec2(auxmat(1,1),Ub2(1,j),
6827 & AEAb2derx(1,lll,kkk,iii,1,2))
6828 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6829 & AEAb1derx(1,lll,kkk,iii,2,2))
6830 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6831 & AEAb2derx(1,lll,kkk,iii,2,2))
6838 C Antiparallel orientation of the two CA-CA-CA frames.
6840 iti=itortyp(itype(i))
6844 itk1=itortyp(itype(k+1))
6845 itl=itortyp(itype(l))
6846 itj=itortyp(itype(j))
6847 if (j.lt.nres-1) then
6848 itj1=itortyp(itype(j+1))
6852 C A2 kernel(j-1)T A1T
6853 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6854 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6855 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6856 C Following matrices are needed only for 6-th order cumulants
6857 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6858 & j.eq.i+4 .and. l.eq.i+3)) THEN
6859 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6860 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6861 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6862 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6863 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6864 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6865 & ADtEAderx(1,1,1,1,1,1))
6866 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6867 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6868 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6869 & ADtEA1derx(1,1,1,1,1,1))
6871 C End 6-th order cumulants
6872 call transpose2(EUgder(1,1,k),auxmat(1,1))
6873 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6874 call transpose2(EUg(1,1,k),auxmat(1,1))
6875 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6876 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6880 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6881 & EAEAderx(1,1,lll,kkk,iii,1))
6885 C A2T kernel(i+1)T A1
6886 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6887 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6888 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6889 C Following matrices are needed only for 6-th order cumulants
6890 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6891 & j.eq.i+4 .and. l.eq.i+3)) THEN
6892 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6893 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6894 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6895 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6896 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6897 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6898 & ADtEAderx(1,1,1,1,1,2))
6899 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6900 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6901 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6902 & ADtEA1derx(1,1,1,1,1,2))
6904 C End 6-th order cumulants
6905 call transpose2(EUgder(1,1,j),auxmat(1,1))
6906 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6907 call transpose2(EUg(1,1,j),auxmat(1,1))
6908 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6909 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6913 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6914 & EAEAderx(1,1,lll,kkk,iii,2))
6919 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6920 C They are needed only when the fifth- or the sixth-order cumulants are
6922 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6923 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6924 call transpose2(AEA(1,1,1),auxmat(1,1))
6925 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6926 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6927 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6928 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6929 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6930 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6931 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6932 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6933 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6934 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6935 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6936 call transpose2(AEA(1,1,2),auxmat(1,1))
6937 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6938 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6939 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6940 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6941 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6942 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6943 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6944 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6945 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6946 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6947 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6948 C Calculate the Cartesian derivatives of the vectors.
6952 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6953 call matvec2(auxmat(1,1),b1(1,iti),
6954 & AEAb1derx(1,lll,kkk,iii,1,1))
6955 call matvec2(auxmat(1,1),Ub2(1,i),
6956 & AEAb2derx(1,lll,kkk,iii,1,1))
6957 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6958 & AEAb1derx(1,lll,kkk,iii,2,1))
6959 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6960 & AEAb2derx(1,lll,kkk,iii,2,1))
6961 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6962 call matvec2(auxmat(1,1),b1(1,itl),
6963 & AEAb1derx(1,lll,kkk,iii,1,2))
6964 call matvec2(auxmat(1,1),Ub2(1,l),
6965 & AEAb2derx(1,lll,kkk,iii,1,2))
6966 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6967 & AEAb1derx(1,lll,kkk,iii,2,2))
6968 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6969 & AEAb2derx(1,lll,kkk,iii,2,2))
6978 C---------------------------------------------------------------------------
6979 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6980 & KK,KKderg,AKA,AKAderg,AKAderx)
6984 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6985 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6986 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6991 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6993 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6996 cd if (lprn) write (2,*) 'In kernel'
6998 cd if (lprn) write (2,*) 'kkk=',kkk
7000 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7001 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7003 cd write (2,*) 'lll=',lll
7004 cd write (2,*) 'iii=1'
7006 cd write (2,'(3(2f10.5),5x)')
7007 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7010 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7011 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7013 cd write (2,*) 'lll=',lll
7014 cd write (2,*) 'iii=2'
7016 cd write (2,'(3(2f10.5),5x)')
7017 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7024 C---------------------------------------------------------------------------
7025 double precision function eello4(i,j,k,l,jj,kk)
7026 implicit real*8 (a-h,o-z)
7027 include 'DIMENSIONS'
7028 include 'COMMON.IOUNITS'
7029 include 'COMMON.CHAIN'
7030 include 'COMMON.DERIV'
7031 include 'COMMON.INTERACT'
7032 include 'COMMON.CONTACTS'
7033 include 'COMMON.TORSION'
7034 include 'COMMON.VAR'
7035 include 'COMMON.GEO'
7036 double precision pizda(2,2),ggg1(3),ggg2(3)
7037 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7041 cd print *,'eello4:',i,j,k,l,jj,kk
7042 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7043 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7044 cold eij=facont_hb(jj,i)
7045 cold ekl=facont_hb(kk,k)
7047 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7048 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7049 gcorr_loc(k-1)=gcorr_loc(k-1)
7050 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7052 gcorr_loc(l-1)=gcorr_loc(l-1)
7053 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7055 gcorr_loc(j-1)=gcorr_loc(j-1)
7056 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7061 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7062 & -EAEAderx(2,2,lll,kkk,iii,1)
7063 cd derx(lll,kkk,iii)=0.0d0
7067 cd gcorr_loc(l-1)=0.0d0
7068 cd gcorr_loc(j-1)=0.0d0
7069 cd gcorr_loc(k-1)=0.0d0
7071 cd write (iout,*)'Contacts have occurred for peptide groups',
7072 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7073 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7074 if (j.lt.nres-1) then
7081 if (l.lt.nres-1) then
7089 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7090 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7091 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7092 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7093 cgrad ghalf=0.5d0*ggg1(ll)
7094 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7095 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7096 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7097 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7098 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7099 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7100 cgrad ghalf=0.5d0*ggg2(ll)
7101 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7102 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7103 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7104 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7105 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7106 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7110 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7115 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7120 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7125 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7129 cd write (2,*) iii,gcorr_loc(iii)
7132 cd write (2,*) 'ekont',ekont
7133 cd write (iout,*) 'eello4',ekont*eel4
7136 C---------------------------------------------------------------------------
7137 double precision function eello5(i,j,k,l,jj,kk)
7138 implicit real*8 (a-h,o-z)
7139 include 'DIMENSIONS'
7140 include 'COMMON.IOUNITS'
7141 include 'COMMON.CHAIN'
7142 include 'COMMON.DERIV'
7143 include 'COMMON.INTERACT'
7144 include 'COMMON.CONTACTS'
7145 include 'COMMON.TORSION'
7146 include 'COMMON.VAR'
7147 include 'COMMON.GEO'
7148 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7149 double precision ggg1(3),ggg2(3)
7150 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7155 C /l\ / \ \ / \ / \ / C
7156 C / \ / \ \ / \ / \ / C
7157 C j| o |l1 | o | o| o | | o |o C
7158 C \ |/k\| |/ \| / |/ \| |/ \| C
7159 C \i/ \ / \ / / \ / \ C
7161 C (I) (II) (III) (IV) C
7163 C eello5_1 eello5_2 eello5_3 eello5_4 C
7165 C Antiparallel chains C
7168 C /j\ / \ \ / \ / \ / C
7169 C / \ / \ \ / \ / \ / C
7170 C j1| o |l | o | o| o | | o |o C
7171 C \ |/k\| |/ \| / |/ \| |/ \| C
7172 C \i/ \ / \ / / \ / \ C
7174 C (I) (II) (III) (IV) C
7176 C eello5_1 eello5_2 eello5_3 eello5_4 C
7178 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7180 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7181 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7186 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7188 itk=itortyp(itype(k))
7189 itl=itortyp(itype(l))
7190 itj=itortyp(itype(j))
7195 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7196 cd & eel5_3_num,eel5_4_num)
7200 derx(lll,kkk,iii)=0.0d0
7204 cd eij=facont_hb(jj,i)
7205 cd ekl=facont_hb(kk,k)
7207 cd write (iout,*)'Contacts have occurred for peptide groups',
7208 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7210 C Contribution from the graph I.
7211 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7212 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7213 call transpose2(EUg(1,1,k),auxmat(1,1))
7214 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7215 vv(1)=pizda(1,1)-pizda(2,2)
7216 vv(2)=pizda(1,2)+pizda(2,1)
7217 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7218 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7219 C Explicit gradient in virtual-dihedral angles.
7220 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7221 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7222 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7223 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7224 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7225 vv(1)=pizda(1,1)-pizda(2,2)
7226 vv(2)=pizda(1,2)+pizda(2,1)
7227 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7228 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7229 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7230 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7231 vv(1)=pizda(1,1)-pizda(2,2)
7232 vv(2)=pizda(1,2)+pizda(2,1)
7234 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7235 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7236 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7238 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7239 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7240 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7242 C Cartesian gradient
7246 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7248 vv(1)=pizda(1,1)-pizda(2,2)
7249 vv(2)=pizda(1,2)+pizda(2,1)
7250 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7251 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7252 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7258 C Contribution from graph II
7259 call transpose2(EE(1,1,itk),auxmat(1,1))
7260 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7261 vv(1)=pizda(1,1)+pizda(2,2)
7262 vv(2)=pizda(2,1)-pizda(1,2)
7263 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7264 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7265 C Explicit gradient in virtual-dihedral angles.
7266 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7267 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7268 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7269 vv(1)=pizda(1,1)+pizda(2,2)
7270 vv(2)=pizda(2,1)-pizda(1,2)
7272 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7273 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7274 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7276 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7277 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7278 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7280 C Cartesian gradient
7284 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7286 vv(1)=pizda(1,1)+pizda(2,2)
7287 vv(2)=pizda(2,1)-pizda(1,2)
7288 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7289 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7290 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7298 C Parallel orientation
7299 C Contribution from graph III
7300 call transpose2(EUg(1,1,l),auxmat(1,1))
7301 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7302 vv(1)=pizda(1,1)-pizda(2,2)
7303 vv(2)=pizda(1,2)+pizda(2,1)
7304 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7305 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7306 C Explicit gradient in virtual-dihedral angles.
7307 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7308 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7309 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7310 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7311 vv(1)=pizda(1,1)-pizda(2,2)
7312 vv(2)=pizda(1,2)+pizda(2,1)
7313 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7314 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7315 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7316 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7317 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7318 vv(1)=pizda(1,1)-pizda(2,2)
7319 vv(2)=pizda(1,2)+pizda(2,1)
7320 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7321 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7322 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7323 C Cartesian gradient
7327 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7329 vv(1)=pizda(1,1)-pizda(2,2)
7330 vv(2)=pizda(1,2)+pizda(2,1)
7331 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7332 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7333 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7338 C Contribution from graph IV
7340 call transpose2(EE(1,1,itl),auxmat(1,1))
7341 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7342 vv(1)=pizda(1,1)+pizda(2,2)
7343 vv(2)=pizda(2,1)-pizda(1,2)
7344 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7345 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7346 C Explicit gradient in virtual-dihedral angles.
7347 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7348 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7349 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7350 vv(1)=pizda(1,1)+pizda(2,2)
7351 vv(2)=pizda(2,1)-pizda(1,2)
7352 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7353 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7354 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7355 C Cartesian gradient
7359 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7361 vv(1)=pizda(1,1)+pizda(2,2)
7362 vv(2)=pizda(2,1)-pizda(1,2)
7363 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7364 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7365 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7370 C Antiparallel orientation
7371 C Contribution from graph III
7373 call transpose2(EUg(1,1,j),auxmat(1,1))
7374 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7375 vv(1)=pizda(1,1)-pizda(2,2)
7376 vv(2)=pizda(1,2)+pizda(2,1)
7377 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7378 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7379 C Explicit gradient in virtual-dihedral angles.
7380 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7381 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7382 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7383 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7384 vv(1)=pizda(1,1)-pizda(2,2)
7385 vv(2)=pizda(1,2)+pizda(2,1)
7386 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7387 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7388 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7389 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7390 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7391 vv(1)=pizda(1,1)-pizda(2,2)
7392 vv(2)=pizda(1,2)+pizda(2,1)
7393 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7394 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7395 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7396 C Cartesian gradient
7400 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7402 vv(1)=pizda(1,1)-pizda(2,2)
7403 vv(2)=pizda(1,2)+pizda(2,1)
7404 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7405 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7406 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7411 C Contribution from graph IV
7413 call transpose2(EE(1,1,itj),auxmat(1,1))
7414 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7415 vv(1)=pizda(1,1)+pizda(2,2)
7416 vv(2)=pizda(2,1)-pizda(1,2)
7417 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7418 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7419 C Explicit gradient in virtual-dihedral angles.
7420 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7421 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7422 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7423 vv(1)=pizda(1,1)+pizda(2,2)
7424 vv(2)=pizda(2,1)-pizda(1,2)
7425 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7426 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7427 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7428 C Cartesian gradient
7432 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7434 vv(1)=pizda(1,1)+pizda(2,2)
7435 vv(2)=pizda(2,1)-pizda(1,2)
7436 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7437 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7438 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7444 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7445 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7446 cd write (2,*) 'ijkl',i,j,k,l
7447 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7448 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7450 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7451 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7452 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7453 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7454 if (j.lt.nres-1) then
7461 if (l.lt.nres-1) then
7471 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7472 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7473 C summed up outside the subrouine as for the other subroutines
7474 C handling long-range interactions. The old code is commented out
7475 C with "cgrad" to keep track of changes.
7477 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7478 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7479 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7480 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7481 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7482 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7483 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7484 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7485 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7486 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7488 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7489 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7490 cgrad ghalf=0.5d0*ggg1(ll)
7492 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7493 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7494 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7495 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7496 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7497 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7498 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7499 cgrad ghalf=0.5d0*ggg2(ll)
7501 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7502 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7503 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7504 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7505 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7506 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7511 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7512 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7517 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7518 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7524 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7529 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7533 cd write (2,*) iii,g_corr5_loc(iii)
7536 cd write (2,*) 'ekont',ekont
7537 cd write (iout,*) 'eello5',ekont*eel5
7540 c--------------------------------------------------------------------------
7541 double precision function eello6(i,j,k,l,jj,kk)
7542 implicit real*8 (a-h,o-z)
7543 include 'DIMENSIONS'
7544 include 'COMMON.IOUNITS'
7545 include 'COMMON.CHAIN'
7546 include 'COMMON.DERIV'
7547 include 'COMMON.INTERACT'
7548 include 'COMMON.CONTACTS'
7549 include 'COMMON.TORSION'
7550 include 'COMMON.VAR'
7551 include 'COMMON.GEO'
7552 include 'COMMON.FFIELD'
7553 double precision ggg1(3),ggg2(3)
7554 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7559 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7567 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7568 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7572 derx(lll,kkk,iii)=0.0d0
7576 cd eij=facont_hb(jj,i)
7577 cd ekl=facont_hb(kk,k)
7583 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7584 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7585 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7586 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7587 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7588 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7590 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7591 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7592 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7593 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7594 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7595 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7599 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7601 C If turn contributions are considered, they will be handled separately.
7602 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7603 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7604 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7605 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7606 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7607 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7608 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7610 if (j.lt.nres-1) then
7617 if (l.lt.nres-1) then
7625 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7626 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7627 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7628 cgrad ghalf=0.5d0*ggg1(ll)
7630 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7631 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7632 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7633 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7634 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7635 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7636 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7637 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7638 cgrad ghalf=0.5d0*ggg2(ll)
7639 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7641 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7642 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7643 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7644 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7645 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7646 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7651 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7652 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7657 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7658 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7664 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7669 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7673 cd write (2,*) iii,g_corr6_loc(iii)
7676 cd write (2,*) 'ekont',ekont
7677 cd write (iout,*) 'eello6',ekont*eel6
7680 c--------------------------------------------------------------------------
7681 double precision function eello6_graph1(i,j,k,l,imat,swap)
7682 implicit real*8 (a-h,o-z)
7683 include 'DIMENSIONS'
7684 include 'COMMON.IOUNITS'
7685 include 'COMMON.CHAIN'
7686 include 'COMMON.DERIV'
7687 include 'COMMON.INTERACT'
7688 include 'COMMON.CONTACTS'
7689 include 'COMMON.TORSION'
7690 include 'COMMON.VAR'
7691 include 'COMMON.GEO'
7692 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7696 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7698 C Parallel Antiparallel
7704 C \ j|/k\| / \ |/k\|l /
7709 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7710 itk=itortyp(itype(k))
7711 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7712 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7713 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7714 call transpose2(EUgC(1,1,k),auxmat(1,1))
7715 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7716 vv1(1)=pizda1(1,1)-pizda1(2,2)
7717 vv1(2)=pizda1(1,2)+pizda1(2,1)
7718 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7719 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7720 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7721 s5=scalar2(vv(1),Dtobr2(1,i))
7722 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7723 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7724 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7725 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7726 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7727 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7728 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7729 & +scalar2(vv(1),Dtobr2der(1,i)))
7730 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7731 vv1(1)=pizda1(1,1)-pizda1(2,2)
7732 vv1(2)=pizda1(1,2)+pizda1(2,1)
7733 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7734 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7736 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7737 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7738 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7739 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7740 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7742 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7743 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7744 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7745 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7746 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7748 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7749 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7750 vv1(1)=pizda1(1,1)-pizda1(2,2)
7751 vv1(2)=pizda1(1,2)+pizda1(2,1)
7752 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7753 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7754 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7755 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7764 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7765 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7766 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7767 call transpose2(EUgC(1,1,k),auxmat(1,1))
7768 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7770 vv1(1)=pizda1(1,1)-pizda1(2,2)
7771 vv1(2)=pizda1(1,2)+pizda1(2,1)
7772 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7773 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7774 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7775 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7776 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7777 s5=scalar2(vv(1),Dtobr2(1,i))
7778 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7784 c----------------------------------------------------------------------------
7785 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7786 implicit real*8 (a-h,o-z)
7787 include 'DIMENSIONS'
7788 include 'COMMON.IOUNITS'
7789 include 'COMMON.CHAIN'
7790 include 'COMMON.DERIV'
7791 include 'COMMON.INTERACT'
7792 include 'COMMON.CONTACTS'
7793 include 'COMMON.TORSION'
7794 include 'COMMON.VAR'
7795 include 'COMMON.GEO'
7797 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7798 & auxvec1(2),auxvec2(1),auxmat1(2,2)
7801 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7803 C Parallel Antiparallel
7814 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7815 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7816 C AL 7/4/01 s1 would occur in the sixth-order moment,
7817 C but not in a cluster cumulant
7819 s1=dip(1,jj,i)*dip(1,kk,k)
7821 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7822 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7823 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7824 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7825 call transpose2(EUg(1,1,k),auxmat(1,1))
7826 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7827 vv(1)=pizda(1,1)-pizda(2,2)
7828 vv(2)=pizda(1,2)+pizda(2,1)
7829 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7830 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7832 eello6_graph2=-(s1+s2+s3+s4)
7834 eello6_graph2=-(s2+s3+s4)
7837 C Derivatives in gamma(i-1)
7840 s1=dipderg(1,jj,i)*dip(1,kk,k)
7842 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7843 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7844 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7845 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7847 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7849 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7851 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7853 C Derivatives in gamma(k-1)
7855 s1=dip(1,jj,i)*dipderg(1,kk,k)
7857 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7858 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7859 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7860 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7861 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7862 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7863 vv(1)=pizda(1,1)-pizda(2,2)
7864 vv(2)=pizda(1,2)+pizda(2,1)
7865 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7867 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7869 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7871 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7872 C Derivatives in gamma(j-1) or gamma(l-1)
7875 s1=dipderg(3,jj,i)*dip(1,kk,k)
7877 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7878 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7879 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7880 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7881 vv(1)=pizda(1,1)-pizda(2,2)
7882 vv(2)=pizda(1,2)+pizda(2,1)
7883 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7886 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7888 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7891 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7892 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7894 C Derivatives in gamma(l-1) or gamma(j-1)
7897 s1=dip(1,jj,i)*dipderg(3,kk,k)
7899 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7900 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7901 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7902 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7903 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7904 vv(1)=pizda(1,1)-pizda(2,2)
7905 vv(2)=pizda(1,2)+pizda(2,1)
7906 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7909 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7911 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7914 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7915 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7917 C Cartesian derivatives.
7919 write (2,*) 'In eello6_graph2'
7921 write (2,*) 'iii=',iii
7923 write (2,*) 'kkk=',kkk
7925 write (2,'(3(2f10.5),5x)')
7926 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7936 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7938 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7941 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7943 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7944 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7946 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7947 call transpose2(EUg(1,1,k),auxmat(1,1))
7948 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7950 vv(1)=pizda(1,1)-pizda(2,2)
7951 vv(2)=pizda(1,2)+pizda(2,1)
7952 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7953 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7955 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7957 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7960 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7962 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7969 c----------------------------------------------------------------------------
7970 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7971 implicit real*8 (a-h,o-z)
7972 include 'DIMENSIONS'
7973 include 'COMMON.IOUNITS'
7974 include 'COMMON.CHAIN'
7975 include 'COMMON.DERIV'
7976 include 'COMMON.INTERACT'
7977 include 'COMMON.CONTACTS'
7978 include 'COMMON.TORSION'
7979 include 'COMMON.VAR'
7980 include 'COMMON.GEO'
7981 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7983 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7985 C Parallel Antiparallel
7996 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7998 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7999 C energy moment and not to the cluster cumulant.
8000 iti=itortyp(itype(i))
8001 if (j.lt.nres-1) then
8002 itj1=itortyp(itype(j+1))
8006 itk=itortyp(itype(k))
8007 itk1=itortyp(itype(k+1))
8008 if (l.lt.nres-1) then
8009 itl1=itortyp(itype(l+1))
8014 s1=dip(4,jj,i)*dip(4,kk,k)
8016 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8017 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8018 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8019 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8020 call transpose2(EE(1,1,itk),auxmat(1,1))
8021 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8022 vv(1)=pizda(1,1)+pizda(2,2)
8023 vv(2)=pizda(2,1)-pizda(1,2)
8024 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8025 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8026 cd & "sum",-(s2+s3+s4)
8028 eello6_graph3=-(s1+s2+s3+s4)
8030 eello6_graph3=-(s2+s3+s4)
8033 C Derivatives in gamma(k-1)
8034 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8035 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8036 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8037 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8038 C Derivatives in gamma(l-1)
8039 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8040 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8041 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8042 vv(1)=pizda(1,1)+pizda(2,2)
8043 vv(2)=pizda(2,1)-pizda(1,2)
8044 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8045 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8046 C Cartesian derivatives.
8052 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8054 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8057 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8059 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8060 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8062 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8063 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8065 vv(1)=pizda(1,1)+pizda(2,2)
8066 vv(2)=pizda(2,1)-pizda(1,2)
8067 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8069 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8071 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8074 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8076 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8078 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8084 c----------------------------------------------------------------------------
8085 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8086 implicit real*8 (a-h,o-z)
8087 include 'DIMENSIONS'
8088 include 'COMMON.IOUNITS'
8089 include 'COMMON.CHAIN'
8090 include 'COMMON.DERIV'
8091 include 'COMMON.INTERACT'
8092 include 'COMMON.CONTACTS'
8093 include 'COMMON.TORSION'
8094 include 'COMMON.VAR'
8095 include 'COMMON.GEO'
8096 include 'COMMON.FFIELD'
8097 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8098 & auxvec1(2),auxmat1(2,2)
8100 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8102 C Parallel Antiparallel
8113 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8115 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8116 C energy moment and not to the cluster cumulant.
8117 cd write (2,*) 'eello_graph4: wturn6',wturn6
8118 iti=itortyp(itype(i))
8119 itj=itortyp(itype(j))
8120 if (j.lt.nres-1) then
8121 itj1=itortyp(itype(j+1))
8125 itk=itortyp(itype(k))
8126 if (k.lt.nres-1) then
8127 itk1=itortyp(itype(k+1))
8131 itl=itortyp(itype(l))
8132 if (l.lt.nres-1) then
8133 itl1=itortyp(itype(l+1))
8137 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8138 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8139 cd & ' itl',itl,' itl1',itl1
8142 s1=dip(3,jj,i)*dip(3,kk,k)
8144 s1=dip(2,jj,j)*dip(2,kk,l)
8147 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8148 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8150 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8151 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8153 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8154 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8156 call transpose2(EUg(1,1,k),auxmat(1,1))
8157 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8158 vv(1)=pizda(1,1)-pizda(2,2)
8159 vv(2)=pizda(2,1)+pizda(1,2)
8160 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8161 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8163 eello6_graph4=-(s1+s2+s3+s4)
8165 eello6_graph4=-(s2+s3+s4)
8167 C Derivatives in gamma(i-1)
8171 s1=dipderg(2,jj,i)*dip(3,kk,k)
8173 s1=dipderg(4,jj,j)*dip(2,kk,l)
8176 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8178 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8179 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8181 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8182 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8184 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8185 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8186 cd write (2,*) 'turn6 derivatives'
8188 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8190 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8194 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8196 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8200 C Derivatives in gamma(k-1)
8203 s1=dip(3,jj,i)*dipderg(2,kk,k)
8205 s1=dip(2,jj,j)*dipderg(4,kk,l)
8208 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8209 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8211 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8212 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8214 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8215 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8217 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8218 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8219 vv(1)=pizda(1,1)-pizda(2,2)
8220 vv(2)=pizda(2,1)+pizda(1,2)
8221 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8222 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8224 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8226 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8230 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8232 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8235 C Derivatives in gamma(j-1) or gamma(l-1)
8236 if (l.eq.j+1 .and. l.gt.1) then
8237 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8238 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8239 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8240 vv(1)=pizda(1,1)-pizda(2,2)
8241 vv(2)=pizda(2,1)+pizda(1,2)
8242 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8243 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8244 else if (j.gt.1) then
8245 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8246 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8247 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8248 vv(1)=pizda(1,1)-pizda(2,2)
8249 vv(2)=pizda(2,1)+pizda(1,2)
8250 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8251 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8252 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8254 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8257 C Cartesian derivatives.
8264 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8266 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8270 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8272 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8276 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8278 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8280 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8281 & b1(1,itj1),auxvec(1))
8282 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8284 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8285 & b1(1,itl1),auxvec(1))
8286 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8288 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8290 vv(1)=pizda(1,1)-pizda(2,2)
8291 vv(2)=pizda(2,1)+pizda(1,2)
8292 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8294 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8296 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8299 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8302 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8305 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8307 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8309 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8313 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8315 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8318 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8320 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8328 c----------------------------------------------------------------------------
8329 double precision function eello_turn6(i,jj,kk)
8330 implicit real*8 (a-h,o-z)
8331 include 'DIMENSIONS'
8332 include 'COMMON.IOUNITS'
8333 include 'COMMON.CHAIN'
8334 include 'COMMON.DERIV'
8335 include 'COMMON.INTERACT'
8336 include 'COMMON.CONTACTS'
8337 include 'COMMON.TORSION'
8338 include 'COMMON.VAR'
8339 include 'COMMON.GEO'
8340 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8341 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8343 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8344 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8345 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8346 C the respective energy moment and not to the cluster cumulant.
8355 iti=itortyp(itype(i))
8356 itk=itortyp(itype(k))
8357 itk1=itortyp(itype(k+1))
8358 itl=itortyp(itype(l))
8359 itj=itortyp(itype(j))
8360 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8361 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8362 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8367 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8369 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8373 derx_turn(lll,kkk,iii)=0.0d0
8380 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8382 cd write (2,*) 'eello6_5',eello6_5
8384 call transpose2(AEA(1,1,1),auxmat(1,1))
8385 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8386 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8387 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8389 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8390 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8391 s2 = scalar2(b1(1,itk),vtemp1(1))
8393 call transpose2(AEA(1,1,2),atemp(1,1))
8394 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8395 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8396 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8398 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8399 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8400 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8402 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8403 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8404 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8405 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8406 ss13 = scalar2(b1(1,itk),vtemp4(1))
8407 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8409 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8415 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8416 C Derivatives in gamma(i+2)
8420 call transpose2(AEA(1,1,1),auxmatd(1,1))
8421 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8422 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8423 call transpose2(AEAderg(1,1,2),atempd(1,1))
8424 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8425 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8427 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8428 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8429 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8435 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8436 C Derivatives in gamma(i+3)
8438 call transpose2(AEA(1,1,1),auxmatd(1,1))
8439 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8440 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8441 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8443 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8444 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8445 s2d = scalar2(b1(1,itk),vtemp1d(1))
8447 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8448 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8450 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8452 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8453 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8454 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8462 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8463 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8465 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8466 & -0.5d0*ekont*(s2d+s12d)
8468 C Derivatives in gamma(i+4)
8469 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8470 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8471 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8473 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8474 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8475 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8483 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8485 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8487 C Derivatives in gamma(i+5)
8489 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8490 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8491 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8493 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8494 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8495 s2d = scalar2(b1(1,itk),vtemp1d(1))
8497 call transpose2(AEA(1,1,2),atempd(1,1))
8498 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8499 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8501 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8502 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8504 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8505 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8506 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8514 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8515 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8517 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8518 & -0.5d0*ekont*(s2d+s12d)
8520 C Cartesian derivatives
8525 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8526 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8527 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8529 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8530 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8532 s2d = scalar2(b1(1,itk),vtemp1d(1))
8534 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8535 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8536 s8d = -(atempd(1,1)+atempd(2,2))*
8537 & scalar2(cc(1,1,itl),vtemp2(1))
8539 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8541 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8542 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8549 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8552 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8556 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8557 & - 0.5d0*(s8d+s12d)
8559 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8568 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8570 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8571 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8572 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8573 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8574 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8576 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8577 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8578 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8582 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8583 cd & 16*eel_turn6_num
8585 if (j.lt.nres-1) then
8592 if (l.lt.nres-1) then
8600 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8601 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8602 cgrad ghalf=0.5d0*ggg1(ll)
8604 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8605 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8606 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8607 & +ekont*derx_turn(ll,2,1)
8608 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8609 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8610 & +ekont*derx_turn(ll,4,1)
8611 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8612 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8613 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8614 cgrad ghalf=0.5d0*ggg2(ll)
8616 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8617 & +ekont*derx_turn(ll,2,2)
8618 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8619 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8620 & +ekont*derx_turn(ll,4,2)
8621 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8622 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8623 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8628 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8633 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8639 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8644 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8648 cd write (2,*) iii,g_corr6_loc(iii)
8650 eello_turn6=ekont*eel_turn6
8651 cd write (2,*) 'ekont',ekont
8652 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8656 C-----------------------------------------------------------------------------
8657 double precision function scalar(u,v)
8658 !DIR$ INLINEALWAYS scalar
8660 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8663 double precision u(3),v(3)
8664 cd double precision sc
8672 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8675 crc-------------------------------------------------
8676 SUBROUTINE MATVEC2(A1,V1,V2)
8677 !DIR$ INLINEALWAYS MATVEC2
8679 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8681 implicit real*8 (a-h,o-z)
8682 include 'DIMENSIONS'
8683 DIMENSION A1(2,2),V1(2),V2(2)
8687 c 3 VI=VI+A1(I,K)*V1(K)
8691 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8692 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8697 C---------------------------------------
8698 SUBROUTINE MATMAT2(A1,A2,A3)
8700 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8702 implicit real*8 (a-h,o-z)
8703 include 'DIMENSIONS'
8704 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8705 c DIMENSION AI3(2,2)
8709 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8715 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8716 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8717 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8718 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8726 c-------------------------------------------------------------------------
8727 double precision function scalar2(u,v)
8728 !DIR$ INLINEALWAYS scalar2
8730 double precision u(2),v(2)
8733 scalar2=u(1)*v(1)+u(2)*v(2)
8737 C-----------------------------------------------------------------------------
8739 subroutine transpose2(a,at)
8740 !DIR$ INLINEALWAYS transpose2
8742 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8745 double precision a(2,2),at(2,2)
8752 c--------------------------------------------------------------------------
8753 subroutine transpose(n,a,at)
8756 double precision a(n,n),at(n,n)
8764 C---------------------------------------------------------------------------
8765 subroutine prodmat3(a1,a2,kk,transp,prod)
8766 !DIR$ INLINEALWAYS prodmat3
8768 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8772 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8774 crc double precision auxmat(2,2),prod_(2,2)
8777 crc call transpose2(kk(1,1),auxmat(1,1))
8778 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8779 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8781 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8782 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8783 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8784 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8785 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8786 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8787 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8788 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8791 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8792 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8794 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8795 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8796 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8797 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8798 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8799 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8800 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8801 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8804 c call transpose2(a2(1,1),a2t(1,1))
8807 crc print *,((prod_(i,j),i=1,2),j=1,2)
8808 crc print *,((prod(i,j),i=1,2),j=1,2)