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'
27 include 'COMMON.SPLITELE'
29 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
30 c & " nfgtasks",nfgtasks
31 if (nfgtasks.gt.1) then
33 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
34 if (fg_rank.eq.0) then
35 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
36 c print *,"Processor",myrank," BROADCAST iorder"
37 C FG master sets up the WEIGHTS_ array which will be broadcast to the
38 C FG slaves as WEIGHTS array.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
85 time_Bcast=time_Bcast+MPI_Wtime()-time00
86 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
87 c call chainbuild_cart
89 c print *,'Processor',myrank,' calling etotal ipot=',ipot
90 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
92 c if (modecalc.eq.12.or.modecalc.eq.14) then
93 c call int_from_cart1(.false.)
100 C Compute the side-chain and electrostatic interaction energy
102 goto (101,102,103,104,105,106) ipot
103 C Lennard-Jones potential.
105 cd print '(a)','Exit ELJ'
107 C Lennard-Jones-Kihara potential (shifted).
110 C Berne-Pechukas potential (dilated LJ, angular dependence).
113 C Gay-Berne potential (shifted LJ, angular dependence).
116 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
119 C Soft-sphere potential
120 106 call e_softsphere(evdw)
122 C Calculate electrostatic (H-bonding) energy of the main chain.
126 cmc Sep-06: egb takes care of dynamic ss bonds too
128 c if (dyn_ss) call dyn_set_nss
130 c print *,"Processor",myrank," computed USCSC"
136 time_vec=time_vec+MPI_Wtime()-time01
138 c print *,"Processor",myrank," left VEC_AND_DERIV"
141 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
142 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
143 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
144 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
146 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
147 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
148 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
149 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
151 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
160 write (iout,*) "Soft-spheer ELEC potential"
161 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
164 c print *,"Processor",myrank," computed UELEC"
166 C Calculate excluded-volume interaction energy between peptide groups
171 call escp(evdw2,evdw2_14)
177 c write (iout,*) "Soft-sphere SCP potential"
178 call escp_soft_sphere(evdw2,evdw2_14)
181 c Calculate the bond-stretching energy
185 C Calculate the disulfide-bridge and other energy and the contributions
186 C from other distance constraints.
187 cd print *,'Calling EHPB'
189 cd print *,'EHPB exitted succesfully.'
191 C Calculate the virtual-bond-angle energy.
193 if (wang.gt.0d0) then
198 c print *,"Processor",myrank," computed UB"
200 C Calculate the SC local energy.
202 C print *,"TU DOCHODZE?"
204 c print *,"Processor",myrank," computed USC"
206 C Calculate the virtual-bond torsional energy.
208 cd print *,'nterm=',nterm
210 call etor(etors,edihcnstr)
215 c print *,"Processor",myrank," computed Utor"
217 C 6/23/01 Calculate double-torsional energy
219 if (wtor_d.gt.0) then
224 c print *,"Processor",myrank," computed Utord"
226 C 21/5/07 Calculate local sicdechain correlation energy
228 if (wsccor.gt.0.0d0) then
229 call eback_sc_corr(esccor)
233 C print *,"PRZED MULIt"
234 c print *,"Processor",myrank," computed Usccorr"
236 C 12/1/95 Multi-body terms
240 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
241 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
242 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
243 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
244 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
251 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
252 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
253 cd write (iout,*) "multibody_hb ecorr",ecorr
255 c print *,"Processor",myrank," computed Ucorr"
257 C If performing constraint dynamics, call the constraint energy
258 C after the equilibration time
259 if(usampl.and.totT.gt.eq_time) then
266 C 01/27/2015 added by adasko
267 C the energy component below is energy transfer into lipid environment
268 C based on partition function
269 C print *,"przed lipidami"
270 if (wliptran.gt.0) then
271 call Eliptransfer(eliptran)
273 C print *,"za lipidami"
275 time_enecalc=time_enecalc+MPI_Wtime()-time00
277 c print *,"Processor",myrank," computed Uconstr"
286 energia(2)=evdw2-evdw2_14
303 energia(8)=eello_turn3
304 energia(9)=eello_turn4
311 energia(19)=edihcnstr
313 energia(20)=Uconst+Uconst_back
316 c Here are the energies showed per procesor if the are more processors
317 c per molecule then we sum it up in sum_energy subroutine
318 c print *," Processor",myrank," calls SUM_ENERGY"
319 call sum_energy(energia,.true.)
320 if (dyn_ss) call dyn_set_nss
321 c print *," Processor",myrank," left SUM_ENERGY"
323 time_sumene=time_sumene+MPI_Wtime()-time00
327 c-------------------------------------------------------------------------------
328 subroutine sum_energy(energia,reduce)
329 implicit real*8 (a-h,o-z)
334 cMS$ATTRIBUTES C :: proc_proc
340 include 'COMMON.SETUP'
341 include 'COMMON.IOUNITS'
342 double precision energia(0:n_ene),enebuff(0:n_ene+1)
343 include 'COMMON.FFIELD'
344 include 'COMMON.DERIV'
345 include 'COMMON.INTERACT'
346 include 'COMMON.SBRIDGE'
347 include 'COMMON.CHAIN'
349 include 'COMMON.CONTROL'
350 include 'COMMON.TIME1'
353 if (nfgtasks.gt.1 .and. reduce) then
355 write (iout,*) "energies before REDUCE"
356 call enerprint(energia)
360 enebuff(i)=energia(i)
363 call MPI_Barrier(FG_COMM,IERR)
364 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
366 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
367 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
369 write (iout,*) "energies after REDUCE"
370 call enerprint(energia)
373 time_Reduce=time_Reduce+MPI_Wtime()-time00
375 if (fg_rank.eq.0) then
379 evdw2=energia(2)+energia(18)
395 eello_turn3=energia(8)
396 eello_turn4=energia(9)
403 edihcnstr=energia(19)
409 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
410 & +wang*ebe+wtor*etors+wscloc*escloc
411 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
412 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
413 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
414 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
416 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
417 & +wang*ebe+wtor*etors+wscloc*escloc
418 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
419 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
420 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
421 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
427 if (isnan(etot).ne.0) energia(0)=1.0d+99
429 if (isnan(etot)) energia(0)=1.0d+99
434 idumm=proc_proc(etot,i)
436 call proc_proc(etot,i)
438 if(i.eq.1)energia(0)=1.0d+99
445 c-------------------------------------------------------------------------------
446 subroutine sum_gradient
447 implicit real*8 (a-h,o-z)
452 cMS$ATTRIBUTES C :: proc_proc
458 double precision gradbufc(3,0:maxres),gradbufx(3,0:maxres),
459 & glocbuf(4*maxres),gradbufc_sum(3,0:maxres),gloc_scbuf(3,0:maxres)
460 include 'COMMON.SETUP'
461 include 'COMMON.IOUNITS'
462 include 'COMMON.FFIELD'
463 include 'COMMON.DERIV'
464 include 'COMMON.INTERACT'
465 include 'COMMON.SBRIDGE'
466 include 'COMMON.CHAIN'
468 include 'COMMON.CONTROL'
469 include 'COMMON.TIME1'
470 include 'COMMON.MAXGRAD'
471 include 'COMMON.SCCOR'
476 write (iout,*) "sum_gradient gvdwc, gvdwx"
478 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
479 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
484 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
485 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
486 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
489 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
490 C in virtual-bond-vector coordinates
493 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
495 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
496 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
498 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
500 c write (iout,'(i5,3f10.5,2x,f10.5)')
501 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
503 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
505 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
506 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
514 gradbufc(j,i)=wsc*gvdwc(j,i)+
515 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
516 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
517 & wel_loc*gel_loc_long(j,i)+
518 & wcorr*gradcorr_long(j,i)+
519 & wcorr5*gradcorr5_long(j,i)+
520 & wcorr6*gradcorr6_long(j,i)+
521 & wturn6*gcorr6_turn_long(j,i)+
523 & +wliptran*gliptranc(j,i)
530 gradbufc(j,i)=wsc*gvdwc(j,i)+
531 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
532 & welec*gelc_long(j,i)+
534 & wel_loc*gel_loc_long(j,i)+
535 & wcorr*gradcorr_long(j,i)+
536 & wcorr5*gradcorr5_long(j,i)+
537 & wcorr6*gradcorr6_long(j,i)+
538 & wturn6*gcorr6_turn_long(j,i)+
540 & +wliptran*gliptranc(j,i)
545 if (nfgtasks.gt.1) then
548 write (iout,*) "gradbufc before allreduce"
550 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
556 gradbufc_sum(j,i)=gradbufc(j,i)
559 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
560 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
561 c time_reduce=time_reduce+MPI_Wtime()-time00
563 c write (iout,*) "gradbufc_sum after allreduce"
565 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
570 c time_allreduce=time_allreduce+MPI_Wtime()-time00
578 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
579 write (iout,*) (i," jgrad_start",jgrad_start(i),
580 & " jgrad_end ",jgrad_end(i),
581 & i=igrad_start,igrad_end)
584 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
585 c do not parallelize this part.
587 c do i=igrad_start,igrad_end
588 c do j=jgrad_start(i),jgrad_end(i)
590 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
595 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
599 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
603 write (iout,*) "gradbufc after summing"
605 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
612 write (iout,*) "gradbufc"
614 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
620 gradbufc_sum(j,i)=gradbufc(j,i)
625 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
629 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
634 c gradbufc(k,i)=0.0d0
638 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
643 write (iout,*) "gradbufc after summing"
645 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
653 gradbufc(k,nres)=0.0d0
658 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
659 & wel_loc*gel_loc(j,i)+
660 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
661 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
662 & wel_loc*gel_loc_long(j,i)+
663 & wcorr*gradcorr_long(j,i)+
664 & wcorr5*gradcorr5_long(j,i)+
665 & wcorr6*gradcorr6_long(j,i)+
666 & wturn6*gcorr6_turn_long(j,i))+
668 & wcorr*gradcorr(j,i)+
669 & wturn3*gcorr3_turn(j,i)+
670 & wturn4*gcorr4_turn(j,i)+
671 & wcorr5*gradcorr5(j,i)+
672 & wcorr6*gradcorr6(j,i)+
673 & wturn6*gcorr6_turn(j,i)+
674 & wsccor*gsccorc(j,i)
675 & +wscloc*gscloc(j,i)
676 & +wliptran*gliptranc(j,i)
678 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
679 & wel_loc*gel_loc(j,i)+
680 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
681 & welec*gelc_long(j,i)
682 & wel_loc*gel_loc_long(j,i)+
683 & wcorr*gcorr_long(j,i)+
684 & wcorr5*gradcorr5_long(j,i)+
685 & wcorr6*gradcorr6_long(j,i)+
686 & wturn6*gcorr6_turn_long(j,i))+
688 & wcorr*gradcorr(j,i)+
689 & wturn3*gcorr3_turn(j,i)+
690 & wturn4*gcorr4_turn(j,i)+
691 & wcorr5*gradcorr5(j,i)+
692 & wcorr6*gradcorr6(j,i)+
693 & wturn6*gcorr6_turn(j,i)+
694 & wsccor*gsccorc(j,i)
695 & +wscloc*gscloc(j,i)
696 & +wliptran*gliptranc(j,i)
698 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
700 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
701 & wsccor*gsccorx(j,i)
702 & +wscloc*gsclocx(j,i)
703 & +wliptran*gliptranx(j,i)
707 write (iout,*) "gloc before adding corr"
709 write (iout,*) i,gloc(i,icg)
713 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
714 & +wcorr5*g_corr5_loc(i)
715 & +wcorr6*g_corr6_loc(i)
716 & +wturn4*gel_loc_turn4(i)
717 & +wturn3*gel_loc_turn3(i)
718 & +wturn6*gel_loc_turn6(i)
719 & +wel_loc*gel_loc_loc(i)
722 write (iout,*) "gloc after adding corr"
724 write (iout,*) i,gloc(i,icg)
728 if (nfgtasks.gt.1) then
731 gradbufc(j,i)=gradc(j,i,icg)
732 gradbufx(j,i)=gradx(j,i,icg)
736 glocbuf(i)=gloc(i,icg)
740 write (iout,*) "gloc_sc before reduce"
743 write (iout,*) i,j,gloc_sc(j,i,icg)
750 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
754 call MPI_Barrier(FG_COMM,IERR)
755 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
757 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
758 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
759 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
760 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
761 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
762 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
763 time_reduce=time_reduce+MPI_Wtime()-time00
764 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
765 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
766 time_reduce=time_reduce+MPI_Wtime()-time00
769 write (iout,*) "gloc_sc after reduce"
772 write (iout,*) i,j,gloc_sc(j,i,icg)
778 write (iout,*) "gloc after reduce"
780 write (iout,*) i,gloc(i,icg)
785 if (gnorm_check) then
787 c Compute the maximum elements of the gradient
797 gcorr3_turn_max=0.0d0
798 gcorr4_turn_max=0.0d0
801 gcorr6_turn_max=0.0d0
811 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
812 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
813 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
814 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
815 & gvdwc_scp_max=gvdwc_scp_norm
816 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
817 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
818 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
819 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
820 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
821 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
822 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
823 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
824 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
825 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
826 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
827 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
828 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
830 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
831 & gcorr3_turn_max=gcorr3_turn_norm
832 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
834 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
835 & gcorr4_turn_max=gcorr4_turn_norm
836 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
837 if (gradcorr5_norm.gt.gradcorr5_max)
838 & gradcorr5_max=gradcorr5_norm
839 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
840 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
841 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
843 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
844 & gcorr6_turn_max=gcorr6_turn_norm
845 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
846 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
847 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
848 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
849 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
850 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
851 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
852 if (gradx_scp_norm.gt.gradx_scp_max)
853 & gradx_scp_max=gradx_scp_norm
854 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
855 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
856 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
857 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
858 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
859 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
860 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
861 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
865 open(istat,file=statname,position="append")
867 open(istat,file=statname,access="append")
869 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
870 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
871 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
872 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
873 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
874 & gsccorx_max,gsclocx_max
876 if (gvdwc_max.gt.1.0d4) then
877 write (iout,*) "gvdwc gvdwx gradb gradbx"
879 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
880 & gradb(j,i),gradbx(j,i),j=1,3)
882 call pdbout(0.0d0,'cipiszcze',iout)
888 write (iout,*) "gradc gradx gloc"
890 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
891 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
895 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
899 c-------------------------------------------------------------------------------
900 subroutine rescale_weights(t_bath)
901 implicit real*8 (a-h,o-z)
903 include 'COMMON.IOUNITS'
904 include 'COMMON.FFIELD'
905 include 'COMMON.SBRIDGE'
906 double precision kfac /2.4d0/
907 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
909 c facT=2*temp0/(t_bath+temp0)
910 if (rescale_mode.eq.0) then
916 else if (rescale_mode.eq.1) then
917 facT=kfac/(kfac-1.0d0+t_bath/temp0)
918 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
919 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
920 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
921 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
922 else if (rescale_mode.eq.2) then
928 facT=licznik/dlog(dexp(x)+dexp(-x))
929 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
930 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
931 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
932 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
934 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
935 write (*,*) "Wrong RESCALE_MODE",rescale_mode
937 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
941 welec=weights(3)*fact
942 wcorr=weights(4)*fact3
943 wcorr5=weights(5)*fact4
944 wcorr6=weights(6)*fact5
945 wel_loc=weights(7)*fact2
946 wturn3=weights(8)*fact2
947 wturn4=weights(9)*fact3
948 wturn6=weights(10)*fact5
949 wtor=weights(13)*fact
950 wtor_d=weights(14)*fact2
951 wsccor=weights(21)*fact
955 C------------------------------------------------------------------------
956 subroutine enerprint(energia)
957 implicit real*8 (a-h,o-z)
959 include 'COMMON.IOUNITS'
960 include 'COMMON.FFIELD'
961 include 'COMMON.SBRIDGE'
963 double precision energia(0:n_ene)
968 evdw2=energia(2)+energia(18)
980 eello_turn3=energia(8)
981 eello_turn4=energia(9)
982 eello_turn6=energia(10)
988 edihcnstr=energia(19)
994 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
995 & estr,wbond,ebe,wang,
996 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
998 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
999 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1000 & edihcnstr,ebr*nss,
1001 & Uconst,eliptran,wliptran,etot
1002 10 format (/'Virtual-chain energies:'//
1003 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1004 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1005 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1006 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1007 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1008 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1009 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1010 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1011 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1012 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1013 & ' (SS bridges & dist. cnstr.)'/
1014 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1015 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1016 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1017 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1018 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1019 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1020 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1021 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1022 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1023 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1024 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1025 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1026 & 'ETOT= ',1pE16.6,' (total)')
1028 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1029 & estr,wbond,ebe,wang,
1030 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1032 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1033 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1034 & ebr*nss,Uconst,eliptran,wliptran,etot
1035 10 format (/'Virtual-chain energies:'//
1036 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1037 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1038 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1039 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1040 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1041 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1042 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1043 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1044 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1045 & ' (SS bridges & dist. cnstr.)'/
1046 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1047 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1048 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1049 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1050 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1051 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1052 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1053 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1054 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1055 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1056 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1057 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1058 & 'ETOT= ',1pE16.6,' (total)')
1062 C-----------------------------------------------------------------------
1063 subroutine elj(evdw)
1065 C This subroutine calculates the interaction energy of nonbonded side chains
1066 C assuming the LJ potential of interaction.
1068 implicit real*8 (a-h,o-z)
1069 include 'DIMENSIONS'
1070 parameter (accur=1.0d-10)
1071 include 'COMMON.GEO'
1072 include 'COMMON.VAR'
1073 include 'COMMON.LOCAL'
1074 include 'COMMON.CHAIN'
1075 include 'COMMON.DERIV'
1076 include 'COMMON.INTERACT'
1077 include 'COMMON.TORSION'
1078 include 'COMMON.SBRIDGE'
1079 include 'COMMON.NAMES'
1080 include 'COMMON.IOUNITS'
1081 include 'COMMON.CONTACTS'
1083 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1085 do i=iatsc_s,iatsc_e
1086 itypi=iabs(itype(i))
1087 if (itypi.eq.ntyp1) cycle
1088 itypi1=iabs(itype(i+1))
1095 C Calculate SC interaction energy.
1097 do iint=1,nint_gr(i)
1098 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1099 cd & 'iend=',iend(i,iint)
1100 do j=istart(i,iint),iend(i,iint)
1101 itypj=iabs(itype(j))
1102 if (itypj.eq.ntyp1) cycle
1106 C Change 12/1/95 to calculate four-body interactions
1107 rij=xj*xj+yj*yj+zj*zj
1109 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1110 eps0ij=eps(itypi,itypj)
1112 C have you changed here?
1113 e1=fac*fac*aa(itypi,itypj)
1114 e2=fac*bb(itypi,itypj)
1116 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1117 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1118 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1119 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1120 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1121 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1124 C Calculate the components of the gradient in DC and X
1126 fac=-rrij*(e1+evdwij)
1131 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1132 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1133 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1134 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1138 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1142 C 12/1/95, revised on 5/20/97
1144 C Calculate the contact function. The ith column of the array JCONT will
1145 C contain the numbers of atoms that make contacts with the atom I (of numbers
1146 C greater than I). The arrays FACONT and GACONT will contain the values of
1147 C the contact function and its derivative.
1149 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1150 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1151 C Uncomment next line, if the correlation interactions are contact function only
1152 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1154 sigij=sigma(itypi,itypj)
1155 r0ij=rs0(itypi,itypj)
1157 C Check whether the SC's are not too far to make a contact.
1160 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1161 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1163 if (fcont.gt.0.0D0) then
1164 C If the SC-SC distance if close to sigma, apply spline.
1165 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1166 cAdam & fcont1,fprimcont1)
1167 cAdam fcont1=1.0d0-fcont1
1168 cAdam if (fcont1.gt.0.0d0) then
1169 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1170 cAdam fcont=fcont*fcont1
1172 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1173 cga eps0ij=1.0d0/dsqrt(eps0ij)
1175 cga gg(k)=gg(k)*eps0ij
1177 cga eps0ij=-evdwij*eps0ij
1178 C Uncomment for AL's type of SC correlation interactions.
1179 cadam eps0ij=-evdwij
1180 num_conti=num_conti+1
1181 jcont(num_conti,i)=j
1182 facont(num_conti,i)=fcont*eps0ij
1183 fprimcont=eps0ij*fprimcont/rij
1185 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1186 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1187 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1188 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1189 gacont(1,num_conti,i)=-fprimcont*xj
1190 gacont(2,num_conti,i)=-fprimcont*yj
1191 gacont(3,num_conti,i)=-fprimcont*zj
1192 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1193 cd write (iout,'(2i3,3f10.5)')
1194 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1200 num_cont(i)=num_conti
1204 gvdwc(j,i)=expon*gvdwc(j,i)
1205 gvdwx(j,i)=expon*gvdwx(j,i)
1208 C******************************************************************************
1212 C To save time, the factor of EXPON has been extracted from ALL components
1213 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1216 C******************************************************************************
1219 C-----------------------------------------------------------------------------
1220 subroutine eljk(evdw)
1222 C This subroutine calculates the interaction energy of nonbonded side chains
1223 C assuming the LJK potential of interaction.
1225 implicit real*8 (a-h,o-z)
1226 include 'DIMENSIONS'
1227 include 'COMMON.GEO'
1228 include 'COMMON.VAR'
1229 include 'COMMON.LOCAL'
1230 include 'COMMON.CHAIN'
1231 include 'COMMON.DERIV'
1232 include 'COMMON.INTERACT'
1233 include 'COMMON.IOUNITS'
1234 include 'COMMON.NAMES'
1237 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1239 do i=iatsc_s,iatsc_e
1240 itypi=iabs(itype(i))
1241 if (itypi.eq.ntyp1) cycle
1242 itypi1=iabs(itype(i+1))
1247 C Calculate SC interaction energy.
1249 do iint=1,nint_gr(i)
1250 do j=istart(i,iint),iend(i,iint)
1251 itypj=iabs(itype(j))
1252 if (itypj.eq.ntyp1) cycle
1256 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1257 fac_augm=rrij**expon
1258 e_augm=augm(itypi,itypj)*fac_augm
1259 r_inv_ij=dsqrt(rrij)
1261 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1262 fac=r_shift_inv**expon
1263 C have you changed here?
1264 e1=fac*fac*aa(itypi,itypj)
1265 e2=fac*bb(itypi,itypj)
1267 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1268 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1269 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1270 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1271 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1272 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1273 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1276 C Calculate the components of the gradient in DC and X
1278 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1283 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1284 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1285 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1286 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1290 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1298 gvdwc(j,i)=expon*gvdwc(j,i)
1299 gvdwx(j,i)=expon*gvdwx(j,i)
1304 C-----------------------------------------------------------------------------
1305 subroutine ebp(evdw)
1307 C This subroutine calculates the interaction energy of nonbonded side chains
1308 C assuming the Berne-Pechukas potential of interaction.
1310 implicit real*8 (a-h,o-z)
1311 include 'DIMENSIONS'
1312 include 'COMMON.GEO'
1313 include 'COMMON.VAR'
1314 include 'COMMON.LOCAL'
1315 include 'COMMON.CHAIN'
1316 include 'COMMON.DERIV'
1317 include 'COMMON.NAMES'
1318 include 'COMMON.INTERACT'
1319 include 'COMMON.IOUNITS'
1320 include 'COMMON.CALC'
1321 common /srutu/ icall
1322 c double precision rrsave(maxdim)
1325 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1327 c if (icall.eq.0) then
1333 do i=iatsc_s,iatsc_e
1334 itypi=iabs(itype(i))
1335 if (itypi.eq.ntyp1) cycle
1336 itypi1=iabs(itype(i+1))
1340 dxi=dc_norm(1,nres+i)
1341 dyi=dc_norm(2,nres+i)
1342 dzi=dc_norm(3,nres+i)
1343 c dsci_inv=dsc_inv(itypi)
1344 dsci_inv=vbld_inv(i+nres)
1346 C Calculate SC interaction energy.
1348 do iint=1,nint_gr(i)
1349 do j=istart(i,iint),iend(i,iint)
1351 itypj=iabs(itype(j))
1352 if (itypj.eq.ntyp1) cycle
1353 c dscj_inv=dsc_inv(itypj)
1354 dscj_inv=vbld_inv(j+nres)
1355 chi1=chi(itypi,itypj)
1356 chi2=chi(itypj,itypi)
1363 alf12=0.5D0*(alf1+alf2)
1364 C For diagnostics only!!!
1377 dxj=dc_norm(1,nres+j)
1378 dyj=dc_norm(2,nres+j)
1379 dzj=dc_norm(3,nres+j)
1380 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1381 cd if (icall.eq.0) then
1387 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1389 C Calculate whole angle-dependent part of epsilon and contributions
1390 C to its derivatives
1391 C have you changed here?
1392 fac=(rrij*sigsq)**expon2
1393 e1=fac*fac*aa(itypi,itypj)
1394 e2=fac*bb(itypi,itypj)
1395 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1396 eps2der=evdwij*eps3rt
1397 eps3der=evdwij*eps2rt
1398 evdwij=evdwij*eps2rt*eps3rt
1401 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1402 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1403 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1404 cd & restyp(itypi),i,restyp(itypj),j,
1405 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1406 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1407 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1410 C Calculate gradient components.
1411 e1=e1*eps1*eps2rt**2*eps3rt**2
1412 fac=-expon*(e1+evdwij)
1415 C Calculate radial part of the gradient
1419 C Calculate the angular part of the gradient and sum add the contributions
1420 C to the appropriate components of the Cartesian gradient.
1428 C-----------------------------------------------------------------------------
1429 subroutine egb(evdw)
1431 C This subroutine calculates the interaction energy of nonbonded side chains
1432 C assuming the Gay-Berne potential of interaction.
1434 implicit real*8 (a-h,o-z)
1435 include 'DIMENSIONS'
1436 include 'COMMON.GEO'
1437 include 'COMMON.VAR'
1438 include 'COMMON.LOCAL'
1439 include 'COMMON.CHAIN'
1440 include 'COMMON.DERIV'
1441 include 'COMMON.NAMES'
1442 include 'COMMON.INTERACT'
1443 include 'COMMON.IOUNITS'
1444 include 'COMMON.CALC'
1445 include 'COMMON.CONTROL'
1446 include 'COMMON.SPLITELE'
1447 include 'COMMON.SBRIDGE'
1449 integer xshift,yshift,zshift
1451 ccccc energy_dec=.false.
1452 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1455 c if (icall.eq.0) lprn=.false.
1457 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1458 C we have the original box)
1462 do i=iatsc_s,iatsc_e
1463 itypi=iabs(itype(i))
1464 if (itypi.eq.ntyp1) cycle
1465 itypi1=iabs(itype(i+1))
1469 C Return atom into box, boxxsize is size of box in x dimension
1471 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1472 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1473 C Condition for being inside the proper box
1474 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1475 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1479 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1480 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1481 C Condition for being inside the proper box
1482 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1483 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1487 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1488 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1489 C Condition for being inside the proper box
1490 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1491 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1495 if (xi.lt.0) xi=xi+boxxsize
1497 if (yi.lt.0) yi=yi+boxysize
1499 if (zi.lt.0) zi=zi+boxzsize
1500 C xi=xi+xshift*boxxsize
1501 C yi=yi+yshift*boxysize
1502 C zi=zi+zshift*boxzsize
1504 dxi=dc_norm(1,nres+i)
1505 dyi=dc_norm(2,nres+i)
1506 dzi=dc_norm(3,nres+i)
1507 c dsci_inv=dsc_inv(itypi)
1508 dsci_inv=vbld_inv(i+nres)
1509 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1510 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1512 C Calculate SC interaction energy.
1514 do iint=1,nint_gr(i)
1515 do j=istart(i,iint),iend(i,iint)
1516 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1517 call dyn_ssbond_ene(i,j,evdwij)
1519 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1520 & 'evdw',i,j,evdwij,' ss'
1523 itypj=iabs(itype(j))
1524 if (itypj.eq.ntyp1) cycle
1525 c dscj_inv=dsc_inv(itypj)
1526 dscj_inv=vbld_inv(j+nres)
1527 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1528 c & 1.0d0/vbld(j+nres)
1529 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1530 sig0ij=sigma(itypi,itypj)
1531 chi1=chi(itypi,itypj)
1532 chi2=chi(itypj,itypi)
1539 alf12=0.5D0*(alf1+alf2)
1540 C For diagnostics only!!!
1553 C Return atom J into box the original box
1555 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1556 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1557 C Condition for being inside the proper box
1558 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1559 c & (xj.lt.((-0.5d0)*boxxsize))) then
1563 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1564 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1565 C Condition for being inside the proper box
1566 c if ((yj.gt.((0.5d0)*boxysize)).or.
1567 c & (yj.lt.((-0.5d0)*boxysize))) then
1571 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1572 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1573 C Condition for being inside the proper box
1574 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1575 c & (zj.lt.((-0.5d0)*boxzsize))) then
1579 if (xj.lt.0) xj=xj+boxxsize
1581 if (yj.lt.0) yj=yj+boxysize
1583 if (zj.lt.0) zj=zj+boxzsize
1584 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1592 xj=xj_safe+xshift*boxxsize
1593 yj=yj_safe+yshift*boxysize
1594 zj=zj_safe+zshift*boxzsize
1595 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1596 if(dist_temp.lt.dist_init) then
1606 if (subchap.eq.1) then
1615 dxj=dc_norm(1,nres+j)
1616 dyj=dc_norm(2,nres+j)
1617 dzj=dc_norm(3,nres+j)
1621 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1622 c write (iout,*) "j",j," dc_norm",
1623 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1624 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1626 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1627 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1629 c write (iout,'(a7,4f8.3)')
1630 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1631 if (sss.gt.0.0d0) then
1632 C Calculate angle-dependent terms of energy and contributions to their
1636 sig=sig0ij*dsqrt(sigsq)
1637 rij_shift=1.0D0/rij-sig+sig0ij
1638 c for diagnostics; uncomment
1639 c rij_shift=1.2*sig0ij
1640 C I hate to put IF's in the loops, but here don't have another choice!!!!
1641 if (rij_shift.le.0.0D0) then
1643 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1644 cd & restyp(itypi),i,restyp(itypj),j,
1645 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1649 c---------------------------------------------------------------
1650 rij_shift=1.0D0/rij_shift
1651 fac=rij_shift**expon
1652 C here to start with
1654 e1=fac*fac*aa(itypi,itypj)
1655 e2=fac*bb(itypi,itypj)
1656 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1657 eps2der=evdwij*eps3rt
1658 eps3der=evdwij*eps2rt
1659 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1660 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1661 evdwij=evdwij*eps2rt*eps3rt
1662 evdw=evdw+evdwij*sss
1664 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1665 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1666 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1667 & restyp(itypi),i,restyp(itypj),j,
1668 & epsi,sigm,chi1,chi2,chip1,chip2,
1669 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1670 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1674 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1677 C Calculate gradient components.
1678 e1=e1*eps1*eps2rt**2*eps3rt**2
1679 fac=-expon*(e1+evdwij)*rij_shift
1682 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1683 c & evdwij,fac,sigma(itypi,itypj),expon
1684 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1686 C Calculate the radial part of the gradient
1690 C Calculate angular part of the gradient.
1700 c write (iout,*) "Number of loop steps in EGB:",ind
1701 cccc energy_dec=.false.
1704 C-----------------------------------------------------------------------------
1705 subroutine egbv(evdw)
1707 C This subroutine calculates the interaction energy of nonbonded side chains
1708 C assuming the Gay-Berne-Vorobjev potential of interaction.
1710 implicit real*8 (a-h,o-z)
1711 include 'DIMENSIONS'
1712 include 'COMMON.GEO'
1713 include 'COMMON.VAR'
1714 include 'COMMON.LOCAL'
1715 include 'COMMON.CHAIN'
1716 include 'COMMON.DERIV'
1717 include 'COMMON.NAMES'
1718 include 'COMMON.INTERACT'
1719 include 'COMMON.IOUNITS'
1720 include 'COMMON.CALC'
1721 common /srutu/ icall
1724 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1727 c if (icall.eq.0) lprn=.true.
1729 do i=iatsc_s,iatsc_e
1730 itypi=iabs(itype(i))
1731 if (itypi.eq.ntyp1) cycle
1732 itypi1=iabs(itype(i+1))
1736 dxi=dc_norm(1,nres+i)
1737 dyi=dc_norm(2,nres+i)
1738 dzi=dc_norm(3,nres+i)
1739 c dsci_inv=dsc_inv(itypi)
1740 dsci_inv=vbld_inv(i+nres)
1742 C Calculate SC interaction energy.
1744 do iint=1,nint_gr(i)
1745 do j=istart(i,iint),iend(i,iint)
1747 itypj=iabs(itype(j))
1748 if (itypj.eq.ntyp1) cycle
1749 c dscj_inv=dsc_inv(itypj)
1750 dscj_inv=vbld_inv(j+nres)
1751 sig0ij=sigma(itypi,itypj)
1752 r0ij=r0(itypi,itypj)
1753 chi1=chi(itypi,itypj)
1754 chi2=chi(itypj,itypi)
1761 alf12=0.5D0*(alf1+alf2)
1762 C For diagnostics only!!!
1775 dxj=dc_norm(1,nres+j)
1776 dyj=dc_norm(2,nres+j)
1777 dzj=dc_norm(3,nres+j)
1778 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1780 C Calculate angle-dependent terms of energy and contributions to their
1784 sig=sig0ij*dsqrt(sigsq)
1785 rij_shift=1.0D0/rij-sig+r0ij
1786 C I hate to put IF's in the loops, but here don't have another choice!!!!
1787 if (rij_shift.le.0.0D0) then
1792 c---------------------------------------------------------------
1793 rij_shift=1.0D0/rij_shift
1794 fac=rij_shift**expon
1795 e1=fac*fac*aa(itypi,itypj)
1796 e2=fac*bb(itypi,itypj)
1797 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1798 eps2der=evdwij*eps3rt
1799 eps3der=evdwij*eps2rt
1800 fac_augm=rrij**expon
1801 e_augm=augm(itypi,itypj)*fac_augm
1802 evdwij=evdwij*eps2rt*eps3rt
1803 evdw=evdw+evdwij+e_augm
1805 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1806 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1807 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1808 & restyp(itypi),i,restyp(itypj),j,
1809 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1810 & chi1,chi2,chip1,chip2,
1811 & eps1,eps2rt**2,eps3rt**2,
1812 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1815 C Calculate gradient components.
1816 e1=e1*eps1*eps2rt**2*eps3rt**2
1817 fac=-expon*(e1+evdwij)*rij_shift
1819 fac=rij*fac-2*expon*rrij*e_augm
1820 C Calculate the radial part of the gradient
1824 C Calculate angular part of the gradient.
1830 C-----------------------------------------------------------------------------
1831 subroutine sc_angular
1832 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1833 C om12. Called by ebp, egb, and egbv.
1835 include 'COMMON.CALC'
1836 include 'COMMON.IOUNITS'
1840 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1841 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1842 om12=dxi*dxj+dyi*dyj+dzi*dzj
1844 C Calculate eps1(om12) and its derivative in om12
1845 faceps1=1.0D0-om12*chiom12
1846 faceps1_inv=1.0D0/faceps1
1847 eps1=dsqrt(faceps1_inv)
1848 C Following variable is eps1*deps1/dom12
1849 eps1_om12=faceps1_inv*chiom12
1854 c write (iout,*) "om12",om12," eps1",eps1
1855 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1860 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1861 sigsq=1.0D0-facsig*faceps1_inv
1862 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1863 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1864 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1870 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1871 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1873 C Calculate eps2 and its derivatives in om1, om2, and om12.
1876 chipom12=chip12*om12
1877 facp=1.0D0-om12*chipom12
1879 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1880 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1881 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1882 C Following variable is the square root of eps2
1883 eps2rt=1.0D0-facp1*facp_inv
1884 C Following three variables are the derivatives of the square root of eps
1885 C in om1, om2, and om12.
1886 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1887 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1888 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1889 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1890 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1891 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1892 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1893 c & " eps2rt_om12",eps2rt_om12
1894 C Calculate whole angle-dependent part of epsilon and contributions
1895 C to its derivatives
1898 C----------------------------------------------------------------------------
1900 implicit real*8 (a-h,o-z)
1901 include 'DIMENSIONS'
1902 include 'COMMON.CHAIN'
1903 include 'COMMON.DERIV'
1904 include 'COMMON.CALC'
1905 include 'COMMON.IOUNITS'
1906 double precision dcosom1(3),dcosom2(3)
1907 cc print *,'sss=',sss
1908 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1909 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1910 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1911 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1915 c eom12=evdwij*eps1_om12
1917 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1918 c & " sigder",sigder
1919 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1920 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1922 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1923 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1926 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
1928 c write (iout,*) "gg",(gg(k),k=1,3)
1930 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1931 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1932 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
1933 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1934 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1935 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
1936 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1937 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1938 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1939 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1942 C Calculate the components of the gradient in DC and X
1946 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1950 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1951 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1955 C-----------------------------------------------------------------------
1956 subroutine e_softsphere(evdw)
1958 C This subroutine calculates the interaction energy of nonbonded side chains
1959 C assuming the LJ potential of interaction.
1961 implicit real*8 (a-h,o-z)
1962 include 'DIMENSIONS'
1963 parameter (accur=1.0d-10)
1964 include 'COMMON.GEO'
1965 include 'COMMON.VAR'
1966 include 'COMMON.LOCAL'
1967 include 'COMMON.CHAIN'
1968 include 'COMMON.DERIV'
1969 include 'COMMON.INTERACT'
1970 include 'COMMON.TORSION'
1971 include 'COMMON.SBRIDGE'
1972 include 'COMMON.NAMES'
1973 include 'COMMON.IOUNITS'
1974 include 'COMMON.CONTACTS'
1976 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1978 do i=iatsc_s,iatsc_e
1979 itypi=iabs(itype(i))
1980 if (itypi.eq.ntyp1) cycle
1981 itypi1=iabs(itype(i+1))
1986 C Calculate SC interaction energy.
1988 do iint=1,nint_gr(i)
1989 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1990 cd & 'iend=',iend(i,iint)
1991 do j=istart(i,iint),iend(i,iint)
1992 itypj=iabs(itype(j))
1993 if (itypj.eq.ntyp1) cycle
1997 rij=xj*xj+yj*yj+zj*zj
1998 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1999 r0ij=r0(itypi,itypj)
2001 c print *,i,j,r0ij,dsqrt(rij)
2002 if (rij.lt.r0ijsq) then
2003 evdwij=0.25d0*(rij-r0ijsq)**2
2011 C Calculate the components of the gradient in DC and X
2017 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2018 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2019 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2020 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2024 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2032 C--------------------------------------------------------------------------
2033 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2036 C Soft-sphere potential of p-p interaction
2038 implicit real*8 (a-h,o-z)
2039 include 'DIMENSIONS'
2040 include 'COMMON.CONTROL'
2041 include 'COMMON.IOUNITS'
2042 include 'COMMON.GEO'
2043 include 'COMMON.VAR'
2044 include 'COMMON.LOCAL'
2045 include 'COMMON.CHAIN'
2046 include 'COMMON.DERIV'
2047 include 'COMMON.INTERACT'
2048 include 'COMMON.CONTACTS'
2049 include 'COMMON.TORSION'
2050 include 'COMMON.VECTORS'
2051 include 'COMMON.FFIELD'
2053 C write(iout,*) 'In EELEC_soft_sphere'
2060 do i=iatel_s,iatel_e
2061 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2065 xmedi=c(1,i)+0.5d0*dxi
2066 ymedi=c(2,i)+0.5d0*dyi
2067 zmedi=c(3,i)+0.5d0*dzi
2068 xmedi=mod(xmedi,boxxsize)
2069 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2070 ymedi=mod(ymedi,boxysize)
2071 if (ymedi.lt.0) ymedi=ymedi+boxysize
2072 zmedi=mod(zmedi,boxzsize)
2073 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2075 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2076 do j=ielstart(i),ielend(i)
2077 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2081 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2082 r0ij=rpp(iteli,itelj)
2091 if (xj.lt.0) xj=xj+boxxsize
2093 if (yj.lt.0) yj=yj+boxysize
2095 if (zj.lt.0) zj=zj+boxzsize
2096 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2104 xj=xj_safe+xshift*boxxsize
2105 yj=yj_safe+yshift*boxysize
2106 zj=zj_safe+zshift*boxzsize
2107 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2108 if(dist_temp.lt.dist_init) then
2118 if (isubchap.eq.1) then
2127 rij=xj*xj+yj*yj+zj*zj
2128 sss=sscale(sqrt(rij))
2129 sssgrad=sscagrad(sqrt(rij))
2130 if (rij.lt.r0ijsq) then
2131 evdw1ij=0.25d0*(rij-r0ijsq)**2
2137 evdw1=evdw1+evdw1ij*sss
2139 C Calculate contributions to the Cartesian gradient.
2141 ggg(1)=fac*xj*sssgrad
2142 ggg(2)=fac*yj*sssgrad
2143 ggg(3)=fac*zj*sssgrad
2145 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2146 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2149 * Loop over residues i+1 thru j-1.
2153 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2158 cgrad do i=nnt,nct-1
2160 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2162 cgrad do j=i+1,nct-1
2164 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2170 c------------------------------------------------------------------------------
2171 subroutine vec_and_deriv
2172 implicit real*8 (a-h,o-z)
2173 include 'DIMENSIONS'
2177 include 'COMMON.IOUNITS'
2178 include 'COMMON.GEO'
2179 include 'COMMON.VAR'
2180 include 'COMMON.LOCAL'
2181 include 'COMMON.CHAIN'
2182 include 'COMMON.VECTORS'
2183 include 'COMMON.SETUP'
2184 include 'COMMON.TIME1'
2185 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2186 C Compute the local reference systems. For reference system (i), the
2187 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2188 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2190 do i=ivec_start,ivec_end
2194 if (i.eq.nres-1) then
2195 C Case of the last full residue
2196 C Compute the Z-axis
2197 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2198 costh=dcos(pi-theta(nres))
2199 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2203 C Compute the derivatives of uz
2205 uzder(2,1,1)=-dc_norm(3,i-1)
2206 uzder(3,1,1)= dc_norm(2,i-1)
2207 uzder(1,2,1)= dc_norm(3,i-1)
2209 uzder(3,2,1)=-dc_norm(1,i-1)
2210 uzder(1,3,1)=-dc_norm(2,i-1)
2211 uzder(2,3,1)= dc_norm(1,i-1)
2214 uzder(2,1,2)= dc_norm(3,i)
2215 uzder(3,1,2)=-dc_norm(2,i)
2216 uzder(1,2,2)=-dc_norm(3,i)
2218 uzder(3,2,2)= dc_norm(1,i)
2219 uzder(1,3,2)= dc_norm(2,i)
2220 uzder(2,3,2)=-dc_norm(1,i)
2222 C Compute the Y-axis
2225 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2227 C Compute the derivatives of uy
2230 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2231 & -dc_norm(k,i)*dc_norm(j,i-1)
2232 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2234 uyder(j,j,1)=uyder(j,j,1)-costh
2235 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2240 uygrad(l,k,j,i)=uyder(l,k,j)
2241 uzgrad(l,k,j,i)=uzder(l,k,j)
2245 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2246 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2247 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2248 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2251 C Compute the Z-axis
2252 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2253 costh=dcos(pi-theta(i+2))
2254 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2258 C Compute the derivatives of uz
2260 uzder(2,1,1)=-dc_norm(3,i+1)
2261 uzder(3,1,1)= dc_norm(2,i+1)
2262 uzder(1,2,1)= dc_norm(3,i+1)
2264 uzder(3,2,1)=-dc_norm(1,i+1)
2265 uzder(1,3,1)=-dc_norm(2,i+1)
2266 uzder(2,3,1)= dc_norm(1,i+1)
2269 uzder(2,1,2)= dc_norm(3,i)
2270 uzder(3,1,2)=-dc_norm(2,i)
2271 uzder(1,2,2)=-dc_norm(3,i)
2273 uzder(3,2,2)= dc_norm(1,i)
2274 uzder(1,3,2)= dc_norm(2,i)
2275 uzder(2,3,2)=-dc_norm(1,i)
2277 C Compute the Y-axis
2280 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2282 C Compute the derivatives of uy
2285 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2286 & -dc_norm(k,i)*dc_norm(j,i+1)
2287 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2289 uyder(j,j,1)=uyder(j,j,1)-costh
2290 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2295 uygrad(l,k,j,i)=uyder(l,k,j)
2296 uzgrad(l,k,j,i)=uzder(l,k,j)
2300 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2301 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2302 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2303 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2307 vbld_inv_temp(1)=vbld_inv(i+1)
2308 if (i.lt.nres-1) then
2309 vbld_inv_temp(2)=vbld_inv(i+2)
2311 vbld_inv_temp(2)=vbld_inv(i)
2316 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2317 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2322 #if defined(PARVEC) && defined(MPI)
2323 if (nfgtasks1.gt.1) then
2325 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2326 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2327 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2328 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2329 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2331 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2332 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2334 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2335 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2336 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2337 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2338 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2339 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2340 time_gather=time_gather+MPI_Wtime()-time00
2342 c if (fg_rank.eq.0) then
2343 c write (iout,*) "Arrays UY and UZ"
2345 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2352 C-----------------------------------------------------------------------------
2353 subroutine check_vecgrad
2354 implicit real*8 (a-h,o-z)
2355 include 'DIMENSIONS'
2356 include 'COMMON.IOUNITS'
2357 include 'COMMON.GEO'
2358 include 'COMMON.VAR'
2359 include 'COMMON.LOCAL'
2360 include 'COMMON.CHAIN'
2361 include 'COMMON.VECTORS'
2362 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2363 dimension uyt(3,maxres),uzt(3,maxres)
2364 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2365 double precision delta /1.0d-7/
2368 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2369 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2370 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2371 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2372 cd & (dc_norm(if90,i),if90=1,3)
2373 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2374 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2375 cd write(iout,'(a)')
2381 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2382 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2395 cd write (iout,*) 'i=',i
2397 erij(k)=dc_norm(k,i)
2401 dc_norm(k,i)=erij(k)
2403 dc_norm(j,i)=dc_norm(j,i)+delta
2404 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2406 c dc_norm(k,i)=dc_norm(k,i)/fac
2408 c write (iout,*) (dc_norm(k,i),k=1,3)
2409 c write (iout,*) (erij(k),k=1,3)
2412 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2413 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2414 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2415 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2417 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2418 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2419 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2422 dc_norm(k,i)=erij(k)
2425 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2426 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2427 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2428 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2429 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2430 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2431 cd write (iout,'(a)')
2436 C--------------------------------------------------------------------------
2437 subroutine set_matrices
2438 implicit real*8 (a-h,o-z)
2439 include 'DIMENSIONS'
2442 include "COMMON.SETUP"
2444 integer status(MPI_STATUS_SIZE)
2446 include 'COMMON.IOUNITS'
2447 include 'COMMON.GEO'
2448 include 'COMMON.VAR'
2449 include 'COMMON.LOCAL'
2450 include 'COMMON.CHAIN'
2451 include 'COMMON.DERIV'
2452 include 'COMMON.INTERACT'
2453 include 'COMMON.CONTACTS'
2454 include 'COMMON.TORSION'
2455 include 'COMMON.VECTORS'
2456 include 'COMMON.FFIELD'
2457 double precision auxvec(2),auxmat(2,2)
2459 C Compute the virtual-bond-torsional-angle dependent quantities needed
2460 C to calculate the el-loc multibody terms of various order.
2463 do i=ivec_start+2,ivec_end+2
2467 if (i .lt. nres+1) then
2504 if (i .gt. 3 .and. i .lt. nres+1) then
2505 obrot_der(1,i-2)=-sin1
2506 obrot_der(2,i-2)= cos1
2507 Ugder(1,1,i-2)= sin1
2508 Ugder(1,2,i-2)=-cos1
2509 Ugder(2,1,i-2)=-cos1
2510 Ugder(2,2,i-2)=-sin1
2513 obrot2_der(1,i-2)=-dwasin2
2514 obrot2_der(2,i-2)= dwacos2
2515 Ug2der(1,1,i-2)= dwasin2
2516 Ug2der(1,2,i-2)=-dwacos2
2517 Ug2der(2,1,i-2)=-dwacos2
2518 Ug2der(2,2,i-2)=-dwasin2
2520 obrot_der(1,i-2)=0.0d0
2521 obrot_der(2,i-2)=0.0d0
2522 Ugder(1,1,i-2)=0.0d0
2523 Ugder(1,2,i-2)=0.0d0
2524 Ugder(2,1,i-2)=0.0d0
2525 Ugder(2,2,i-2)=0.0d0
2526 obrot2_der(1,i-2)=0.0d0
2527 obrot2_der(2,i-2)=0.0d0
2528 Ug2der(1,1,i-2)=0.0d0
2529 Ug2der(1,2,i-2)=0.0d0
2530 Ug2der(2,1,i-2)=0.0d0
2531 Ug2der(2,2,i-2)=0.0d0
2533 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2534 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2535 iti = itortyp(itype(i-2))
2539 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2540 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2541 iti1 = itortyp(itype(i-1))
2545 cd write (iout,*) '*******i',i,' iti1',iti
2546 cd write (iout,*) 'b1',b1(:,iti)
2547 cd write (iout,*) 'b2',b2(:,iti)
2548 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2549 c if (i .gt. iatel_s+2) then
2550 if (i .gt. nnt+2) then
2551 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2552 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2553 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2555 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2556 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2557 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2558 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2559 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2570 DtUg2(l,k,i-2)=0.0d0
2574 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2575 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2577 muder(k,i-2)=Ub2der(k,i-2)
2579 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2580 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2581 if (itype(i-1).le.ntyp) then
2582 iti1 = itortyp(itype(i-1))
2590 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2592 cd write (iout,*) 'mu ',mu(:,i-2)
2593 cd write (iout,*) 'mu1',mu1(:,i-2)
2594 cd write (iout,*) 'mu2',mu2(:,i-2)
2595 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2597 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2598 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2599 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2600 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2601 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2602 C Vectors and matrices dependent on a single virtual-bond dihedral.
2603 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2604 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2605 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2606 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2607 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2608 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2609 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2610 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2611 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2614 C Matrices dependent on two consecutive virtual-bond dihedrals.
2615 C The order of matrices is from left to right.
2616 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2618 c do i=max0(ivec_start,2),ivec_end
2620 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2621 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2622 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2623 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2624 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2625 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2626 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2627 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2630 #if defined(MPI) && defined(PARMAT)
2632 c if (fg_rank.eq.0) then
2633 write (iout,*) "Arrays UG and UGDER before GATHER"
2635 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2636 & ((ug(l,k,i),l=1,2),k=1,2),
2637 & ((ugder(l,k,i),l=1,2),k=1,2)
2639 write (iout,*) "Arrays UG2 and UG2DER"
2641 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2642 & ((ug2(l,k,i),l=1,2),k=1,2),
2643 & ((ug2der(l,k,i),l=1,2),k=1,2)
2645 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2647 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2648 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2649 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2651 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2653 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2654 & costab(i),sintab(i),costab2(i),sintab2(i)
2656 write (iout,*) "Array MUDER"
2658 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2662 if (nfgtasks.gt.1) then
2664 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2665 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2666 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2668 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2669 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2671 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2672 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2674 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2675 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2677 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2678 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2680 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2681 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2683 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2684 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2686 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2687 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2688 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2689 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2690 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2691 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2692 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2693 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2694 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2695 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2696 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2697 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2698 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2700 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2701 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2703 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2704 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2706 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2707 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2709 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2710 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2712 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2713 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2715 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2716 & ivec_count(fg_rank1),
2717 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2719 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2720 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2722 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2723 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2725 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2726 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2728 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2729 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2731 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2732 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2734 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2735 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2737 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2738 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2740 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2741 & ivec_count(fg_rank1),
2742 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2744 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2745 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2747 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2748 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2750 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2751 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2753 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2754 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2756 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2757 & ivec_count(fg_rank1),
2758 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2760 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2761 & ivec_count(fg_rank1),
2762 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2764 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2765 & ivec_count(fg_rank1),
2766 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2767 & MPI_MAT2,FG_COMM1,IERR)
2768 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2769 & ivec_count(fg_rank1),
2770 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2771 & MPI_MAT2,FG_COMM1,IERR)
2774 c Passes matrix info through the ring
2777 if (irecv.lt.0) irecv=nfgtasks1-1
2780 if (inext.ge.nfgtasks1) inext=0
2782 c write (iout,*) "isend",isend," irecv",irecv
2784 lensend=lentyp(isend)
2785 lenrecv=lentyp(irecv)
2786 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2787 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2788 c & MPI_ROTAT1(lensend),inext,2200+isend,
2789 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2790 c & iprev,2200+irecv,FG_COMM,status,IERR)
2791 c write (iout,*) "Gather ROTAT1"
2793 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2794 c & MPI_ROTAT2(lensend),inext,3300+isend,
2795 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2796 c & iprev,3300+irecv,FG_COMM,status,IERR)
2797 c write (iout,*) "Gather ROTAT2"
2799 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2800 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2801 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2802 & iprev,4400+irecv,FG_COMM,status,IERR)
2803 c write (iout,*) "Gather ROTAT_OLD"
2805 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2806 & MPI_PRECOMP11(lensend),inext,5500+isend,
2807 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2808 & iprev,5500+irecv,FG_COMM,status,IERR)
2809 c write (iout,*) "Gather PRECOMP11"
2811 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2812 & MPI_PRECOMP12(lensend),inext,6600+isend,
2813 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2814 & iprev,6600+irecv,FG_COMM,status,IERR)
2815 c write (iout,*) "Gather PRECOMP12"
2817 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2819 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2820 & MPI_ROTAT2(lensend),inext,7700+isend,
2821 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2822 & iprev,7700+irecv,FG_COMM,status,IERR)
2823 c write (iout,*) "Gather PRECOMP21"
2825 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2826 & MPI_PRECOMP22(lensend),inext,8800+isend,
2827 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2828 & iprev,8800+irecv,FG_COMM,status,IERR)
2829 c write (iout,*) "Gather PRECOMP22"
2831 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2832 & MPI_PRECOMP23(lensend),inext,9900+isend,
2833 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2834 & MPI_PRECOMP23(lenrecv),
2835 & iprev,9900+irecv,FG_COMM,status,IERR)
2836 c write (iout,*) "Gather PRECOMP23"
2841 if (irecv.lt.0) irecv=nfgtasks1-1
2844 time_gather=time_gather+MPI_Wtime()-time00
2847 c if (fg_rank.eq.0) then
2848 write (iout,*) "Arrays UG and UGDER"
2850 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2851 & ((ug(l,k,i),l=1,2),k=1,2),
2852 & ((ugder(l,k,i),l=1,2),k=1,2)
2854 write (iout,*) "Arrays UG2 and UG2DER"
2856 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2857 & ((ug2(l,k,i),l=1,2),k=1,2),
2858 & ((ug2der(l,k,i),l=1,2),k=1,2)
2860 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2862 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2863 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2864 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2866 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2868 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2869 & costab(i),sintab(i),costab2(i),sintab2(i)
2871 write (iout,*) "Array MUDER"
2873 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2879 cd iti = itortyp(itype(i))
2882 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2883 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2888 C--------------------------------------------------------------------------
2889 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2891 C This subroutine calculates the average interaction energy and its gradient
2892 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2893 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2894 C The potential depends both on the distance of peptide-group centers and on
2895 C the orientation of the CA-CA virtual bonds.
2897 implicit real*8 (a-h,o-z)
2901 include 'DIMENSIONS'
2902 include 'COMMON.CONTROL'
2903 include 'COMMON.SETUP'
2904 include 'COMMON.IOUNITS'
2905 include 'COMMON.GEO'
2906 include 'COMMON.VAR'
2907 include 'COMMON.LOCAL'
2908 include 'COMMON.CHAIN'
2909 include 'COMMON.DERIV'
2910 include 'COMMON.INTERACT'
2911 include 'COMMON.CONTACTS'
2912 include 'COMMON.TORSION'
2913 include 'COMMON.VECTORS'
2914 include 'COMMON.FFIELD'
2915 include 'COMMON.TIME1'
2916 include 'COMMON.SPLITELE'
2917 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2918 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2919 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2920 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2921 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2922 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2924 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2926 double precision scal_el /1.0d0/
2928 double precision scal_el /0.5d0/
2931 C 13-go grudnia roku pamietnego...
2932 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2933 & 0.0d0,1.0d0,0.0d0,
2934 & 0.0d0,0.0d0,1.0d0/
2935 cd write(iout,*) 'In EELEC'
2937 cd write(iout,*) 'Type',i
2938 cd write(iout,*) 'B1',B1(:,i)
2939 cd write(iout,*) 'B2',B2(:,i)
2940 cd write(iout,*) 'CC',CC(:,:,i)
2941 cd write(iout,*) 'DD',DD(:,:,i)
2942 cd write(iout,*) 'EE',EE(:,:,i)
2944 cd call check_vecgrad
2946 if (icheckgrad.eq.1) then
2948 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2950 dc_norm(k,i)=dc(k,i)*fac
2952 c write (iout,*) 'i',i,' fac',fac
2955 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2956 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2957 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2958 c call vec_and_deriv
2964 time_mat=time_mat+MPI_Wtime()-time01
2968 cd write (iout,*) 'i=',i
2970 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2973 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2974 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2987 cd print '(a)','Enter EELEC'
2988 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2990 gel_loc_loc(i)=0.0d0
2995 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2997 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2999 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3000 do i=iturn3_start,iturn3_end
3002 C write(iout,*) "tu jest i",i
3003 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3004 & .or. itype(i+2).eq.ntyp1
3005 & .or. itype(i+3).eq.ntyp1
3006 & .or. itype(i-1).eq.ntyp1
3007 & .or. itype(i+4).eq.ntyp1
3012 dx_normi=dc_norm(1,i)
3013 dy_normi=dc_norm(2,i)
3014 dz_normi=dc_norm(3,i)
3015 xmedi=c(1,i)+0.5d0*dxi
3016 ymedi=c(2,i)+0.5d0*dyi
3017 zmedi=c(3,i)+0.5d0*dzi
3018 xmedi=mod(xmedi,boxxsize)
3019 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3020 ymedi=mod(ymedi,boxysize)
3021 if (ymedi.lt.0) ymedi=ymedi+boxysize
3022 zmedi=mod(zmedi,boxzsize)
3023 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3025 call eelecij(i,i+2,ees,evdw1,eel_loc)
3026 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3027 num_cont_hb(i)=num_conti
3029 do i=iturn4_start,iturn4_end
3031 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3032 & .or. itype(i+3).eq.ntyp1
3033 & .or. itype(i+4).eq.ntyp1
3034 & .or. itype(i+5).eq.ntyp1
3035 & .or. itype(i).eq.ntyp1
3036 & .or. itype(i-1).eq.ntyp1
3041 dx_normi=dc_norm(1,i)
3042 dy_normi=dc_norm(2,i)
3043 dz_normi=dc_norm(3,i)
3044 xmedi=c(1,i)+0.5d0*dxi
3045 ymedi=c(2,i)+0.5d0*dyi
3046 zmedi=c(3,i)+0.5d0*dzi
3047 C Return atom into box, boxxsize is size of box in x dimension
3049 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3050 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3051 C Condition for being inside the proper box
3052 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3053 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3057 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3058 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3059 C Condition for being inside the proper box
3060 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3061 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3065 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3066 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3067 C Condition for being inside the proper box
3068 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3069 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3072 xmedi=mod(xmedi,boxxsize)
3073 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3074 ymedi=mod(ymedi,boxysize)
3075 if (ymedi.lt.0) ymedi=ymedi+boxysize
3076 zmedi=mod(zmedi,boxzsize)
3077 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3079 num_conti=num_cont_hb(i)
3080 call eelecij(i,i+3,ees,evdw1,eel_loc)
3081 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3082 & call eturn4(i,eello_turn4)
3083 num_cont_hb(i)=num_conti
3085 C Loop over all neighbouring boxes
3090 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3092 do i=iatel_s,iatel_e
3094 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3095 & .or. itype(i+2).eq.ntyp1
3096 & .or. itype(i-1).eq.ntyp1
3101 dx_normi=dc_norm(1,i)
3102 dy_normi=dc_norm(2,i)
3103 dz_normi=dc_norm(3,i)
3104 xmedi=c(1,i)+0.5d0*dxi
3105 ymedi=c(2,i)+0.5d0*dyi
3106 zmedi=c(3,i)+0.5d0*dzi
3107 xmedi=mod(xmedi,boxxsize)
3108 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3109 ymedi=mod(ymedi,boxysize)
3110 if (ymedi.lt.0) ymedi=ymedi+boxysize
3111 zmedi=mod(zmedi,boxzsize)
3112 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3113 C xmedi=xmedi+xshift*boxxsize
3114 C ymedi=ymedi+yshift*boxysize
3115 C zmedi=zmedi+zshift*boxzsize
3117 C Return tom into box, boxxsize is size of box in x dimension
3119 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3120 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3121 C Condition for being inside the proper box
3122 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3123 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3127 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3128 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3129 C Condition for being inside the proper box
3130 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3131 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3135 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3136 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3137 cC Condition for being inside the proper box
3138 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3139 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3143 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3144 num_conti=num_cont_hb(i)
3145 do j=ielstart(i),ielend(i)
3146 C write (iout,*) i,j
3148 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3149 & .or.itype(j+2).eq.ntyp1
3150 & .or.itype(j-1).eq.ntyp1
3152 call eelecij(i,j,ees,evdw1,eel_loc)
3154 num_cont_hb(i)=num_conti
3160 c write (iout,*) "Number of loop steps in EELEC:",ind
3162 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3163 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3165 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3166 ccc eel_loc=eel_loc+eello_turn3
3167 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3170 C-------------------------------------------------------------------------------
3171 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3172 implicit real*8 (a-h,o-z)
3173 include 'DIMENSIONS'
3177 include 'COMMON.CONTROL'
3178 include 'COMMON.IOUNITS'
3179 include 'COMMON.GEO'
3180 include 'COMMON.VAR'
3181 include 'COMMON.LOCAL'
3182 include 'COMMON.CHAIN'
3183 include 'COMMON.DERIV'
3184 include 'COMMON.INTERACT'
3185 include 'COMMON.CONTACTS'
3186 include 'COMMON.TORSION'
3187 include 'COMMON.VECTORS'
3188 include 'COMMON.FFIELD'
3189 include 'COMMON.TIME1'
3190 include 'COMMON.SPLITELE'
3191 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3192 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3193 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3194 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3195 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3196 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3198 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3200 double precision scal_el /1.0d0/
3202 double precision scal_el /0.5d0/
3205 C 13-go grudnia roku pamietnego...
3206 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3207 & 0.0d0,1.0d0,0.0d0,
3208 & 0.0d0,0.0d0,1.0d0/
3209 c time00=MPI_Wtime()
3210 cd write (iout,*) "eelecij",i,j
3214 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3215 aaa=app(iteli,itelj)
3216 bbb=bpp(iteli,itelj)
3217 ael6i=ael6(iteli,itelj)
3218 ael3i=ael3(iteli,itelj)
3222 dx_normj=dc_norm(1,j)
3223 dy_normj=dc_norm(2,j)
3224 dz_normj=dc_norm(3,j)
3225 C xj=c(1,j)+0.5D0*dxj-xmedi
3226 C yj=c(2,j)+0.5D0*dyj-ymedi
3227 C zj=c(3,j)+0.5D0*dzj-zmedi
3232 if (xj.lt.0) xj=xj+boxxsize
3234 if (yj.lt.0) yj=yj+boxysize
3236 if (zj.lt.0) zj=zj+boxzsize
3237 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3238 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3246 xj=xj_safe+xshift*boxxsize
3247 yj=yj_safe+yshift*boxysize
3248 zj=zj_safe+zshift*boxzsize
3249 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3250 if(dist_temp.lt.dist_init) then
3260 if (isubchap.eq.1) then
3269 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3271 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3272 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3273 C Condition for being inside the proper box
3274 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3275 c & (xj.lt.((-0.5d0)*boxxsize))) then
3279 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3280 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3281 C Condition for being inside the proper box
3282 c if ((yj.gt.((0.5d0)*boxysize)).or.
3283 c & (yj.lt.((-0.5d0)*boxysize))) then
3287 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3288 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3289 C Condition for being inside the proper box
3290 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3291 c & (zj.lt.((-0.5d0)*boxzsize))) then
3294 C endif !endPBC condintion
3298 rij=xj*xj+yj*yj+zj*zj
3300 sss=sscale(sqrt(rij))
3301 sssgrad=sscagrad(sqrt(rij))
3302 c if (sss.gt.0.0d0) then
3308 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3309 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3310 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3311 fac=cosa-3.0D0*cosb*cosg
3313 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3314 if (j.eq.i+2) ev1=scal_el*ev1
3319 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3323 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3324 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3326 evdw1=evdw1+evdwij*sss
3327 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3328 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3329 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3330 cd & xmedi,ymedi,zmedi,xj,yj,zj
3332 if (energy_dec) then
3333 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3335 &,iteli,itelj,aaa,evdw1
3336 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3340 C Calculate contributions to the Cartesian gradient.
3343 facvdw=-6*rrmij*(ev1+evdwij)*sss
3344 facel=-3*rrmij*(el1+eesij)
3350 * Radial derivatives. First process both termini of the fragment (i,j)
3356 c ghalf=0.5D0*ggg(k)
3357 c gelc(k,i)=gelc(k,i)+ghalf
3358 c gelc(k,j)=gelc(k,j)+ghalf
3360 c 9/28/08 AL Gradient compotents will be summed only at the end
3362 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3363 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3366 * Loop over residues i+1 thru j-1.
3370 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3373 if (sss.gt.0.0) then
3374 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3375 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3376 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3383 c ghalf=0.5D0*ggg(k)
3384 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3385 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3387 c 9/28/08 AL Gradient compotents will be summed only at the end
3389 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3390 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3393 * Loop over residues i+1 thru j-1.
3397 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3402 facvdw=(ev1+evdwij)*sss
3405 fac=-3*rrmij*(facvdw+facvdw+facel)
3410 * Radial derivatives. First process both termini of the fragment (i,j)
3416 c ghalf=0.5D0*ggg(k)
3417 c gelc(k,i)=gelc(k,i)+ghalf
3418 c gelc(k,j)=gelc(k,j)+ghalf
3420 c 9/28/08 AL Gradient compotents will be summed only at the end
3422 gelc_long(k,j)=gelc(k,j)+ggg(k)
3423 gelc_long(k,i)=gelc(k,i)-ggg(k)
3426 * Loop over residues i+1 thru j-1.
3430 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3433 c 9/28/08 AL Gradient compotents will be summed only at the end
3434 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3435 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3436 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3438 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3439 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3445 ecosa=2.0D0*fac3*fac1+fac4
3448 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3449 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3451 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3452 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3454 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3455 cd & (dcosg(k),k=1,3)
3457 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3460 c ghalf=0.5D0*ggg(k)
3461 c gelc(k,i)=gelc(k,i)+ghalf
3462 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3463 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3464 c gelc(k,j)=gelc(k,j)+ghalf
3465 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3466 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3470 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3475 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3476 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3478 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3479 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3480 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3481 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3485 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3486 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3487 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3489 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3490 C energy of a peptide unit is assumed in the form of a second-order
3491 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3492 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3493 C are computed for EVERY pair of non-contiguous peptide groups.
3495 if (j.lt.nres-1) then
3506 muij(kkk)=mu(k,i)*mu(l,j)
3509 cd write (iout,*) 'EELEC: i',i,' j',j
3510 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3511 cd write(iout,*) 'muij',muij
3512 ury=scalar(uy(1,i),erij)
3513 urz=scalar(uz(1,i),erij)
3514 vry=scalar(uy(1,j),erij)
3515 vrz=scalar(uz(1,j),erij)
3516 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3517 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3518 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3519 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3520 fac=dsqrt(-ael6i)*r3ij
3525 cd write (iout,'(4i5,4f10.5)')
3526 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3527 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3528 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3529 cd & uy(:,j),uz(:,j)
3530 cd write (iout,'(4f10.5)')
3531 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3532 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3533 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3534 cd write (iout,'(9f10.5/)')
3535 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3536 C Derivatives of the elements of A in virtual-bond vectors
3537 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3539 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3540 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3541 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3542 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3543 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3544 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3545 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3546 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3547 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3548 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3549 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3550 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3552 C Compute radial contributions to the gradient
3570 C Add the contributions coming from er
3573 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3574 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3575 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3576 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3579 C Derivatives in DC(i)
3580 cgrad ghalf1=0.5d0*agg(k,1)
3581 cgrad ghalf2=0.5d0*agg(k,2)
3582 cgrad ghalf3=0.5d0*agg(k,3)
3583 cgrad ghalf4=0.5d0*agg(k,4)
3584 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3585 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3586 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3587 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3588 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3589 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3590 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3591 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3592 C Derivatives in DC(i+1)
3593 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3594 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3595 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3596 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3597 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3598 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3599 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3600 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3601 C Derivatives in DC(j)
3602 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3603 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3604 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3605 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3606 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3607 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3608 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3609 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3610 C Derivatives in DC(j+1) or DC(nres-1)
3611 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3612 & -3.0d0*vryg(k,3)*ury)
3613 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3614 & -3.0d0*vrzg(k,3)*ury)
3615 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3616 & -3.0d0*vryg(k,3)*urz)
3617 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3618 & -3.0d0*vrzg(k,3)*urz)
3619 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3621 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3634 aggi(k,l)=-aggi(k,l)
3635 aggi1(k,l)=-aggi1(k,l)
3636 aggj(k,l)=-aggj(k,l)
3637 aggj1(k,l)=-aggj1(k,l)
3640 if (j.lt.nres-1) then
3646 aggi(k,l)=-aggi(k,l)
3647 aggi1(k,l)=-aggi1(k,l)
3648 aggj(k,l)=-aggj(k,l)
3649 aggj1(k,l)=-aggj1(k,l)
3660 aggi(k,l)=-aggi(k,l)
3661 aggi1(k,l)=-aggi1(k,l)
3662 aggj(k,l)=-aggj(k,l)
3663 aggj1(k,l)=-aggj1(k,l)
3668 IF (wel_loc.gt.0.0d0) THEN
3669 C Contribution to the local-electrostatic energy coming from the i-j pair
3670 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3672 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3673 c & ' eel_loc_ij',eel_loc_ij
3675 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3676 & 'eelloc',i,j,eel_loc_ij
3677 c if (eel_loc_ij.ne.0)
3678 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3679 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3681 eel_loc=eel_loc+eel_loc_ij
3682 C Partial derivatives in virtual-bond dihedral angles gamma
3684 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3685 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3686 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3687 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3688 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3689 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3690 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3692 ggg(l)=agg(l,1)*muij(1)+
3693 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3694 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3695 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3696 cgrad ghalf=0.5d0*ggg(l)
3697 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3698 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3702 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3705 C Remaining derivatives of eello
3707 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3708 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3709 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3710 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3711 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3712 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3713 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3714 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3717 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3718 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3719 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3720 & .and. num_conti.le.maxconts) then
3721 c write (iout,*) i,j," entered corr"
3723 C Calculate the contact function. The ith column of the array JCONT will
3724 C contain the numbers of atoms that make contacts with the atom I (of numbers
3725 C greater than I). The arrays FACONT and GACONT will contain the values of
3726 C the contact function and its derivative.
3727 c r0ij=1.02D0*rpp(iteli,itelj)
3728 c r0ij=1.11D0*rpp(iteli,itelj)
3729 r0ij=2.20D0*rpp(iteli,itelj)
3730 c r0ij=1.55D0*rpp(iteli,itelj)
3731 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3732 if (fcont.gt.0.0D0) then
3733 num_conti=num_conti+1
3734 if (num_conti.gt.maxconts) then
3735 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3736 & ' will skip next contacts for this conf.'
3738 jcont_hb(num_conti,i)=j
3739 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3740 cd & " jcont_hb",jcont_hb(num_conti,i)
3741 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3742 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3743 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3745 d_cont(num_conti,i)=rij
3746 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3747 C --- Electrostatic-interaction matrix ---
3748 a_chuj(1,1,num_conti,i)=a22
3749 a_chuj(1,2,num_conti,i)=a23
3750 a_chuj(2,1,num_conti,i)=a32
3751 a_chuj(2,2,num_conti,i)=a33
3752 C --- Gradient of rij
3754 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3761 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3762 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3763 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3764 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3765 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3770 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3771 C Calculate contact energies
3773 wij=cosa-3.0D0*cosb*cosg
3776 c fac3=dsqrt(-ael6i)/r0ij**3
3777 fac3=dsqrt(-ael6i)*r3ij
3778 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3779 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3780 if (ees0tmp.gt.0) then
3781 ees0pij=dsqrt(ees0tmp)
3785 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3786 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3787 if (ees0tmp.gt.0) then
3788 ees0mij=dsqrt(ees0tmp)
3793 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3794 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3795 C Diagnostics. Comment out or remove after debugging!
3796 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3797 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3798 c ees0m(num_conti,i)=0.0D0
3800 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3801 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3802 C Angular derivatives of the contact function
3803 ees0pij1=fac3/ees0pij
3804 ees0mij1=fac3/ees0mij
3805 fac3p=-3.0D0*fac3*rrmij
3806 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3807 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3809 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3810 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3811 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3812 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3813 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3814 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3815 ecosap=ecosa1+ecosa2
3816 ecosbp=ecosb1+ecosb2
3817 ecosgp=ecosg1+ecosg2
3818 ecosam=ecosa1-ecosa2
3819 ecosbm=ecosb1-ecosb2
3820 ecosgm=ecosg1-ecosg2
3829 facont_hb(num_conti,i)=fcont
3830 fprimcont=fprimcont/rij
3831 cd facont_hb(num_conti,i)=1.0D0
3832 C Following line is for diagnostics.
3835 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3836 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3839 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3840 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3842 gggp(1)=gggp(1)+ees0pijp*xj
3843 gggp(2)=gggp(2)+ees0pijp*yj
3844 gggp(3)=gggp(3)+ees0pijp*zj
3845 gggm(1)=gggm(1)+ees0mijp*xj
3846 gggm(2)=gggm(2)+ees0mijp*yj
3847 gggm(3)=gggm(3)+ees0mijp*zj
3848 C Derivatives due to the contact function
3849 gacont_hbr(1,num_conti,i)=fprimcont*xj
3850 gacont_hbr(2,num_conti,i)=fprimcont*yj
3851 gacont_hbr(3,num_conti,i)=fprimcont*zj
3854 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3855 c following the change of gradient-summation algorithm.
3857 cgrad ghalfp=0.5D0*gggp(k)
3858 cgrad ghalfm=0.5D0*gggm(k)
3859 gacontp_hb1(k,num_conti,i)=!ghalfp
3860 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3861 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3862 gacontp_hb2(k,num_conti,i)=!ghalfp
3863 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3864 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3865 gacontp_hb3(k,num_conti,i)=gggp(k)
3866 gacontm_hb1(k,num_conti,i)=!ghalfm
3867 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3868 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3869 gacontm_hb2(k,num_conti,i)=!ghalfm
3870 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3871 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3872 gacontm_hb3(k,num_conti,i)=gggm(k)
3874 C Diagnostics. Comment out or remove after debugging!
3876 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3877 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3878 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3879 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3880 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3881 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3884 endif ! num_conti.le.maxconts
3887 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3890 ghalf=0.5d0*agg(l,k)
3891 aggi(l,k)=aggi(l,k)+ghalf
3892 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3893 aggj(l,k)=aggj(l,k)+ghalf
3896 if (j.eq.nres-1 .and. i.lt.j-2) then
3899 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3904 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3907 C-----------------------------------------------------------------------------
3908 subroutine eturn3(i,eello_turn3)
3909 C Third- and fourth-order contributions from turns
3910 implicit real*8 (a-h,o-z)
3911 include 'DIMENSIONS'
3912 include 'COMMON.IOUNITS'
3913 include 'COMMON.GEO'
3914 include 'COMMON.VAR'
3915 include 'COMMON.LOCAL'
3916 include 'COMMON.CHAIN'
3917 include 'COMMON.DERIV'
3918 include 'COMMON.INTERACT'
3919 include 'COMMON.CONTACTS'
3920 include 'COMMON.TORSION'
3921 include 'COMMON.VECTORS'
3922 include 'COMMON.FFIELD'
3923 include 'COMMON.CONTROL'
3925 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3926 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3927 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3928 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3929 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3930 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3931 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3934 c write (iout,*) "eturn3",i,j,j1,j2
3939 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3941 C Third-order contributions
3948 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3949 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3950 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3951 call transpose2(auxmat(1,1),auxmat1(1,1))
3952 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3953 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3954 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3955 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3956 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3957 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3958 cd & ' eello_turn3_num',4*eello_turn3_num
3959 C Derivatives in gamma(i)
3960 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3961 call transpose2(auxmat2(1,1),auxmat3(1,1))
3962 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3963 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3964 C Derivatives in gamma(i+1)
3965 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3966 call transpose2(auxmat2(1,1),auxmat3(1,1))
3967 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3968 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3969 & +0.5d0*(pizda(1,1)+pizda(2,2))
3970 C Cartesian derivatives
3972 c ghalf1=0.5d0*agg(l,1)
3973 c ghalf2=0.5d0*agg(l,2)
3974 c ghalf3=0.5d0*agg(l,3)
3975 c ghalf4=0.5d0*agg(l,4)
3976 a_temp(1,1)=aggi(l,1)!+ghalf1
3977 a_temp(1,2)=aggi(l,2)!+ghalf2
3978 a_temp(2,1)=aggi(l,3)!+ghalf3
3979 a_temp(2,2)=aggi(l,4)!+ghalf4
3980 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3981 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3982 & +0.5d0*(pizda(1,1)+pizda(2,2))
3983 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3984 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3985 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3986 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3987 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3988 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3989 & +0.5d0*(pizda(1,1)+pizda(2,2))
3990 a_temp(1,1)=aggj(l,1)!+ghalf1
3991 a_temp(1,2)=aggj(l,2)!+ghalf2
3992 a_temp(2,1)=aggj(l,3)!+ghalf3
3993 a_temp(2,2)=aggj(l,4)!+ghalf4
3994 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3995 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3996 & +0.5d0*(pizda(1,1)+pizda(2,2))
3997 a_temp(1,1)=aggj1(l,1)
3998 a_temp(1,2)=aggj1(l,2)
3999 a_temp(2,1)=aggj1(l,3)
4000 a_temp(2,2)=aggj1(l,4)
4001 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4002 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4003 & +0.5d0*(pizda(1,1)+pizda(2,2))
4007 C-------------------------------------------------------------------------------
4008 subroutine eturn4(i,eello_turn4)
4009 C Third- and fourth-order contributions from turns
4010 implicit real*8 (a-h,o-z)
4011 include 'DIMENSIONS'
4012 include 'COMMON.IOUNITS'
4013 include 'COMMON.GEO'
4014 include 'COMMON.VAR'
4015 include 'COMMON.LOCAL'
4016 include 'COMMON.CHAIN'
4017 include 'COMMON.DERIV'
4018 include 'COMMON.INTERACT'
4019 include 'COMMON.CONTACTS'
4020 include 'COMMON.TORSION'
4021 include 'COMMON.VECTORS'
4022 include 'COMMON.FFIELD'
4023 include 'COMMON.CONTROL'
4025 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4026 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4027 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
4028 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4029 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4030 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4031 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4034 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4036 C Fourth-order contributions
4044 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4045 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4046 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4051 iti1=itortyp(itype(i+1))
4052 iti2=itortyp(itype(i+2))
4053 iti3=itortyp(itype(i+3))
4054 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4055 call transpose2(EUg(1,1,i+1),e1t(1,1))
4056 call transpose2(Eug(1,1,i+2),e2t(1,1))
4057 call transpose2(Eug(1,1,i+3),e3t(1,1))
4058 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4059 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4060 s1=scalar2(b1(1,iti2),auxvec(1))
4061 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4062 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4063 s2=scalar2(b1(1,iti1),auxvec(1))
4064 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4065 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4066 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4067 eello_turn4=eello_turn4-(s1+s2+s3)
4068 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4069 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4070 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4071 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4072 cd & ' eello_turn4_num',8*eello_turn4_num
4073 C Derivatives in gamma(i)
4074 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4075 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4076 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4077 s1=scalar2(b1(1,iti2),auxvec(1))
4078 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4079 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4080 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4081 C Derivatives in gamma(i+1)
4082 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4083 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4084 s2=scalar2(b1(1,iti1),auxvec(1))
4085 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4086 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4087 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4088 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4089 C Derivatives in gamma(i+2)
4090 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4091 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4092 s1=scalar2(b1(1,iti2),auxvec(1))
4093 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4094 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4095 s2=scalar2(b1(1,iti1),auxvec(1))
4096 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4097 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4098 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4099 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4100 C Cartesian derivatives
4101 C Derivatives of this turn contributions in DC(i+2)
4102 if (j.lt.nres-1) then
4104 a_temp(1,1)=agg(l,1)
4105 a_temp(1,2)=agg(l,2)
4106 a_temp(2,1)=agg(l,3)
4107 a_temp(2,2)=agg(l,4)
4108 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4109 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4110 s1=scalar2(b1(1,iti2),auxvec(1))
4111 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4112 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4113 s2=scalar2(b1(1,iti1),auxvec(1))
4114 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4115 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4116 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4118 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4121 C Remaining derivatives of this turn contribution
4123 a_temp(1,1)=aggi(l,1)
4124 a_temp(1,2)=aggi(l,2)
4125 a_temp(2,1)=aggi(l,3)
4126 a_temp(2,2)=aggi(l,4)
4127 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4128 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4129 s1=scalar2(b1(1,iti2),auxvec(1))
4130 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4131 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4132 s2=scalar2(b1(1,iti1),auxvec(1))
4133 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4134 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4135 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4136 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4137 a_temp(1,1)=aggi1(l,1)
4138 a_temp(1,2)=aggi1(l,2)
4139 a_temp(2,1)=aggi1(l,3)
4140 a_temp(2,2)=aggi1(l,4)
4141 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4142 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4143 s1=scalar2(b1(1,iti2),auxvec(1))
4144 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4145 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4146 s2=scalar2(b1(1,iti1),auxvec(1))
4147 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4148 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4149 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4150 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4151 a_temp(1,1)=aggj(l,1)
4152 a_temp(1,2)=aggj(l,2)
4153 a_temp(2,1)=aggj(l,3)
4154 a_temp(2,2)=aggj(l,4)
4155 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4156 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4157 s1=scalar2(b1(1,iti2),auxvec(1))
4158 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4159 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4160 s2=scalar2(b1(1,iti1),auxvec(1))
4161 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4162 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4163 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4164 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4165 a_temp(1,1)=aggj1(l,1)
4166 a_temp(1,2)=aggj1(l,2)
4167 a_temp(2,1)=aggj1(l,3)
4168 a_temp(2,2)=aggj1(l,4)
4169 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4170 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4171 s1=scalar2(b1(1,iti2),auxvec(1))
4172 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4173 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4174 s2=scalar2(b1(1,iti1),auxvec(1))
4175 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4176 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4177 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4178 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4179 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4183 C-----------------------------------------------------------------------------
4184 subroutine vecpr(u,v,w)
4185 implicit real*8(a-h,o-z)
4186 dimension u(3),v(3),w(3)
4187 w(1)=u(2)*v(3)-u(3)*v(2)
4188 w(2)=-u(1)*v(3)+u(3)*v(1)
4189 w(3)=u(1)*v(2)-u(2)*v(1)
4192 C-----------------------------------------------------------------------------
4193 subroutine unormderiv(u,ugrad,unorm,ungrad)
4194 C This subroutine computes the derivatives of a normalized vector u, given
4195 C the derivatives computed without normalization conditions, ugrad. Returns
4198 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4199 double precision vec(3)
4200 double precision scalar
4202 c write (2,*) 'ugrad',ugrad
4205 vec(i)=scalar(ugrad(1,i),u(1))
4207 c write (2,*) 'vec',vec
4210 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4213 c write (2,*) 'ungrad',ungrad
4216 C-----------------------------------------------------------------------------
4217 subroutine escp_soft_sphere(evdw2,evdw2_14)
4219 C This subroutine calculates the excluded-volume interaction energy between
4220 C peptide-group centers and side chains and its gradient in virtual-bond and
4221 C side-chain vectors.
4223 implicit real*8 (a-h,o-z)
4224 include 'DIMENSIONS'
4225 include 'COMMON.GEO'
4226 include 'COMMON.VAR'
4227 include 'COMMON.LOCAL'
4228 include 'COMMON.CHAIN'
4229 include 'COMMON.DERIV'
4230 include 'COMMON.INTERACT'
4231 include 'COMMON.FFIELD'
4232 include 'COMMON.IOUNITS'
4233 include 'COMMON.CONTROL'
4238 cd print '(a)','Enter ESCP'
4239 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4243 do i=iatscp_s,iatscp_e
4244 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4246 xi=0.5D0*(c(1,i)+c(1,i+1))
4247 yi=0.5D0*(c(2,i)+c(2,i+1))
4248 zi=0.5D0*(c(3,i)+c(3,i+1))
4249 C Return atom into box, boxxsize is size of box in x dimension
4251 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4252 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4253 C Condition for being inside the proper box
4254 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4255 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4259 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4260 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4261 C Condition for being inside the proper box
4262 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4263 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4267 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4268 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4269 cC Condition for being inside the proper box
4270 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4271 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4275 if (xi.lt.0) xi=xi+boxxsize
4277 if (yi.lt.0) yi=yi+boxysize
4279 if (zi.lt.0) zi=zi+boxzsize
4280 C xi=xi+xshift*boxxsize
4281 C yi=yi+yshift*boxysize
4282 C zi=zi+zshift*boxzsize
4283 do iint=1,nscp_gr(i)
4285 do j=iscpstart(i,iint),iscpend(i,iint)
4286 if (itype(j).eq.ntyp1) cycle
4287 itypj=iabs(itype(j))
4288 C Uncomment following three lines for SC-p interactions
4292 C Uncomment following three lines for Ca-p interactions
4297 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4298 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4299 C Condition for being inside the proper box
4300 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4301 c & (xj.lt.((-0.5d0)*boxxsize))) then
4305 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4306 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4307 cC Condition for being inside the proper box
4308 c if ((yj.gt.((0.5d0)*boxysize)).or.
4309 c & (yj.lt.((-0.5d0)*boxysize))) then
4313 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4314 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4315 C Condition for being inside the proper box
4316 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4317 c & (zj.lt.((-0.5d0)*boxzsize))) then
4320 if (xj.lt.0) xj=xj+boxxsize
4322 if (yj.lt.0) yj=yj+boxysize
4324 if (zj.lt.0) zj=zj+boxzsize
4325 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4333 xj=xj_safe+xshift*boxxsize
4334 yj=yj_safe+yshift*boxysize
4335 zj=zj_safe+zshift*boxzsize
4336 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4337 if(dist_temp.lt.dist_init) then
4347 if (subchap.eq.1) then
4360 rij=xj*xj+yj*yj+zj*zj
4364 if (rij.lt.r0ijsq) then
4365 evdwij=0.25d0*(rij-r0ijsq)**2
4373 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4378 cgrad if (j.lt.i) then
4379 cd write (iout,*) 'j<i'
4380 C Uncomment following three lines for SC-p interactions
4382 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4385 cd write (iout,*) 'j>i'
4387 cgrad ggg(k)=-ggg(k)
4388 C Uncomment following line for SC-p interactions
4389 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4393 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4395 cgrad kstart=min0(i+1,j)
4396 cgrad kend=max0(i-1,j-1)
4397 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4398 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4399 cgrad do k=kstart,kend
4401 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4405 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4406 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4417 C-----------------------------------------------------------------------------
4418 subroutine escp(evdw2,evdw2_14)
4420 C This subroutine calculates the excluded-volume interaction energy between
4421 C peptide-group centers and side chains and its gradient in virtual-bond and
4422 C side-chain vectors.
4424 implicit real*8 (a-h,o-z)
4425 include 'DIMENSIONS'
4426 include 'COMMON.GEO'
4427 include 'COMMON.VAR'
4428 include 'COMMON.LOCAL'
4429 include 'COMMON.CHAIN'
4430 include 'COMMON.DERIV'
4431 include 'COMMON.INTERACT'
4432 include 'COMMON.FFIELD'
4433 include 'COMMON.IOUNITS'
4434 include 'COMMON.CONTROL'
4435 include 'COMMON.SPLITELE'
4439 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4440 cd print '(a)','Enter ESCP'
4441 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4445 do i=iatscp_s,iatscp_e
4446 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4448 xi=0.5D0*(c(1,i)+c(1,i+1))
4449 yi=0.5D0*(c(2,i)+c(2,i+1))
4450 zi=0.5D0*(c(3,i)+c(3,i+1))
4452 if (xi.lt.0) xi=xi+boxxsize
4454 if (yi.lt.0) yi=yi+boxysize
4456 if (zi.lt.0) zi=zi+boxzsize
4457 c xi=xi+xshift*boxxsize
4458 c yi=yi+yshift*boxysize
4459 c zi=zi+zshift*boxzsize
4460 c print *,xi,yi,zi,'polozenie i'
4461 C Return atom into box, boxxsize is size of box in x dimension
4463 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4464 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4465 C Condition for being inside the proper box
4466 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4467 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4471 c print *,xi,boxxsize,"pierwszy"
4473 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4474 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4475 C Condition for being inside the proper box
4476 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4477 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4481 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4482 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4483 C Condition for being inside the proper box
4484 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4485 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4488 do iint=1,nscp_gr(i)
4490 do j=iscpstart(i,iint),iscpend(i,iint)
4491 itypj=iabs(itype(j))
4492 if (itypj.eq.ntyp1) cycle
4493 C Uncomment following three lines for SC-p interactions
4497 C Uncomment following three lines for Ca-p interactions
4502 if (xj.lt.0) xj=xj+boxxsize
4504 if (yj.lt.0) yj=yj+boxysize
4506 if (zj.lt.0) zj=zj+boxzsize
4508 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4509 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4510 C Condition for being inside the proper box
4511 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4512 c & (xj.lt.((-0.5d0)*boxxsize))) then
4516 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4517 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4518 cC Condition for being inside the proper box
4519 c if ((yj.gt.((0.5d0)*boxysize)).or.
4520 c & (yj.lt.((-0.5d0)*boxysize))) then
4524 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4525 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4526 C Condition for being inside the proper box
4527 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4528 c & (zj.lt.((-0.5d0)*boxzsize))) then
4531 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
4532 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4540 xj=xj_safe+xshift*boxxsize
4541 yj=yj_safe+yshift*boxysize
4542 zj=zj_safe+zshift*boxzsize
4543 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4544 if(dist_temp.lt.dist_init) then
4554 if (subchap.eq.1) then
4563 c print *,xj,yj,zj,'polozenie j'
4564 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4566 sss=sscale(1.0d0/(dsqrt(rrij)))
4567 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
4568 c if (sss.eq.0) print *,'czasem jest OK'
4569 if (sss.le.0.0d0) cycle
4570 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4572 e1=fac*fac*aad(itypj,iteli)
4573 e2=fac*bad(itypj,iteli)
4574 if (iabs(j-i) .le. 2) then
4577 evdw2_14=evdw2_14+(e1+e2)*sss
4580 evdw2=evdw2+evdwij*sss
4581 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4582 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4585 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4587 fac=-(evdwij+e1)*rrij*sss
4588 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4592 cgrad if (j.lt.i) then
4593 cd write (iout,*) 'j<i'
4594 C Uncomment following three lines for SC-p interactions
4596 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4599 cd write (iout,*) 'j>i'
4601 cgrad ggg(k)=-ggg(k)
4602 C Uncomment following line for SC-p interactions
4603 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4604 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4608 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4610 cgrad kstart=min0(i+1,j)
4611 cgrad kend=max0(i-1,j-1)
4612 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4613 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4614 cgrad do k=kstart,kend
4616 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4620 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4621 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4623 c endif !endif for sscale cutoff
4633 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4634 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4635 gradx_scp(j,i)=expon*gradx_scp(j,i)
4638 C******************************************************************************
4642 C To save time the factor EXPON has been extracted from ALL components
4643 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4646 C******************************************************************************
4649 C--------------------------------------------------------------------------
4650 subroutine edis(ehpb)
4652 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4654 implicit real*8 (a-h,o-z)
4655 include 'DIMENSIONS'
4656 include 'COMMON.SBRIDGE'
4657 include 'COMMON.CHAIN'
4658 include 'COMMON.DERIV'
4659 include 'COMMON.VAR'
4660 include 'COMMON.INTERACT'
4661 include 'COMMON.IOUNITS'
4664 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4665 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4666 if (link_end.eq.0) return
4667 do i=link_start,link_end
4668 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4669 C CA-CA distance used in regularization of structure.
4672 C iii and jjj point to the residues for which the distance is assigned.
4673 if (ii.gt.nres) then
4680 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4681 c & dhpb(i),dhpb1(i),forcon(i)
4682 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4683 C distance and angle dependent SS bond potential.
4684 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4685 C & iabs(itype(jjj)).eq.1) then
4686 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4687 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4688 if (.not.dyn_ss .and. i.le.nss) then
4689 C 15/02/13 CC dynamic SSbond - additional check
4691 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4692 call ssbond_ene(iii,jjj,eij)
4695 cd write (iout,*) "eij",eij
4697 C Calculate the distance between the two points and its difference from the
4701 C Get the force constant corresponding to this distance.
4703 C Calculate the contribution to energy.
4704 ehpb=ehpb+waga*rdis*rdis
4706 C Evaluate gradient.
4709 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4710 cd & ' waga=',waga,' fac=',fac
4712 ggg(j)=fac*(c(j,jj)-c(j,ii))
4714 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4715 C If this is a SC-SC distance, we need to calculate the contributions to the
4716 C Cartesian gradient in the SC vectors (ghpbx).
4719 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4720 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4723 cgrad do j=iii,jjj-1
4725 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4729 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4730 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4737 C--------------------------------------------------------------------------
4738 subroutine ssbond_ene(i,j,eij)
4740 C Calculate the distance and angle dependent SS-bond potential energy
4741 C using a free-energy function derived based on RHF/6-31G** ab initio
4742 C calculations of diethyl disulfide.
4744 C A. Liwo and U. Kozlowska, 11/24/03
4746 implicit real*8 (a-h,o-z)
4747 include 'DIMENSIONS'
4748 include 'COMMON.SBRIDGE'
4749 include 'COMMON.CHAIN'
4750 include 'COMMON.DERIV'
4751 include 'COMMON.LOCAL'
4752 include 'COMMON.INTERACT'
4753 include 'COMMON.VAR'
4754 include 'COMMON.IOUNITS'
4755 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4756 itypi=iabs(itype(i))
4760 dxi=dc_norm(1,nres+i)
4761 dyi=dc_norm(2,nres+i)
4762 dzi=dc_norm(3,nres+i)
4763 c dsci_inv=dsc_inv(itypi)
4764 dsci_inv=vbld_inv(nres+i)
4765 itypj=iabs(itype(j))
4766 c dscj_inv=dsc_inv(itypj)
4767 dscj_inv=vbld_inv(nres+j)
4771 dxj=dc_norm(1,nres+j)
4772 dyj=dc_norm(2,nres+j)
4773 dzj=dc_norm(3,nres+j)
4774 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4779 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4780 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4781 om12=dxi*dxj+dyi*dyj+dzi*dzj
4783 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4784 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4790 deltat12=om2-om1+2.0d0
4792 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4793 & +akct*deltad*deltat12
4794 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4795 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4796 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4797 c & " deltat12",deltat12," eij",eij
4798 ed=2*akcm*deltad+akct*deltat12
4800 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4801 eom1=-2*akth*deltat1-pom1-om2*pom2
4802 eom2= 2*akth*deltat2+pom1-om1*pom2
4805 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4806 ghpbx(k,i)=ghpbx(k,i)-ggk
4807 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4808 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4809 ghpbx(k,j)=ghpbx(k,j)+ggk
4810 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4811 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4812 ghpbc(k,i)=ghpbc(k,i)-ggk
4813 ghpbc(k,j)=ghpbc(k,j)+ggk
4816 C Calculate the components of the gradient in DC and X
4820 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4825 C--------------------------------------------------------------------------
4826 subroutine ebond(estr)
4828 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4830 implicit real*8 (a-h,o-z)
4831 include 'DIMENSIONS'
4832 include 'COMMON.LOCAL'
4833 include 'COMMON.GEO'
4834 include 'COMMON.INTERACT'
4835 include 'COMMON.DERIV'
4836 include 'COMMON.VAR'
4837 include 'COMMON.CHAIN'
4838 include 'COMMON.IOUNITS'
4839 include 'COMMON.NAMES'
4840 include 'COMMON.FFIELD'
4841 include 'COMMON.CONTROL'
4842 include 'COMMON.SETUP'
4843 double precision u(3),ud(3)
4846 do i=ibondp_start,ibondp_end
4847 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4848 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4850 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4851 c & *dc(j,i-1)/vbld(i)
4853 c if (energy_dec) write(iout,*)
4854 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4856 C Checking if it involves dummy (NH3+ or COO-) group
4857 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4858 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
4859 diff = vbld(i)-vbldpDUM
4861 C NO vbldp0 is the equlibrium lenght of spring for peptide group
4862 diff = vbld(i)-vbldp0
4864 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4865 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4868 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4870 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4873 estr=0.5d0*AKP*estr+estr1
4875 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4877 do i=ibond_start,ibond_end
4879 if (iti.ne.10 .and. iti.ne.ntyp1) then
4882 diff=vbld(i+nres)-vbldsc0(1,iti)
4883 if (energy_dec) write (iout,*)
4884 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4885 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4886 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4888 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4892 diff=vbld(i+nres)-vbldsc0(j,iti)
4893 ud(j)=aksc(j,iti)*diff
4894 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4908 uprod2=uprod2*u(k)*u(k)
4912 usumsqder=usumsqder+ud(j)*uprod2
4914 estr=estr+uprod/usum
4916 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4924 C--------------------------------------------------------------------------
4925 subroutine ebend(etheta)
4927 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4928 C angles gamma and its derivatives in consecutive thetas and gammas.
4930 implicit real*8 (a-h,o-z)
4931 include 'DIMENSIONS'
4932 include 'COMMON.LOCAL'
4933 include 'COMMON.GEO'
4934 include 'COMMON.INTERACT'
4935 include 'COMMON.DERIV'
4936 include 'COMMON.VAR'
4937 include 'COMMON.CHAIN'
4938 include 'COMMON.IOUNITS'
4939 include 'COMMON.NAMES'
4940 include 'COMMON.FFIELD'
4941 include 'COMMON.CONTROL'
4942 common /calcthet/ term1,term2,termm,diffak,ratak,
4943 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4944 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4945 double precision y(2),z(2)
4947 c time11=dexp(-2*time)
4950 c write (*,'(a,i2)') 'EBEND ICG=',icg
4951 do i=ithet_start,ithet_end
4952 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4953 & .or.itype(i).eq.ntyp1) cycle
4954 C Zero the energy function and its derivative at 0 or pi.
4955 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4957 ichir1=isign(1,itype(i-2))
4958 ichir2=isign(1,itype(i))
4959 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4960 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4961 if (itype(i-1).eq.10) then
4962 itype1=isign(10,itype(i-2))
4963 ichir11=isign(1,itype(i-2))
4964 ichir12=isign(1,itype(i-2))
4965 itype2=isign(10,itype(i))
4966 ichir21=isign(1,itype(i))
4967 ichir22=isign(1,itype(i))
4970 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4973 if (phii.ne.phii) phii=150.0
4983 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4986 if (phii1.ne.phii1) phii1=150.0
4998 C Calculate the "mean" value of theta from the part of the distribution
4999 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5000 C In following comments this theta will be referred to as t_c.
5001 thet_pred_mean=0.0d0
5003 athetk=athet(k,it,ichir1,ichir2)
5004 bthetk=bthet(k,it,ichir1,ichir2)
5006 athetk=athet(k,itype1,ichir11,ichir12)
5007 bthetk=bthet(k,itype2,ichir21,ichir22)
5009 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5010 c write(iout,*) 'chuj tu', y(k),z(k)
5012 dthett=thet_pred_mean*ssd
5013 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5014 C Derivatives of the "mean" values in gamma1 and gamma2.
5015 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5016 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5017 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5018 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5020 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5021 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5022 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5023 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5025 if (theta(i).gt.pi-delta) then
5026 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5028 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5029 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5030 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5032 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5034 else if (theta(i).lt.delta) then
5035 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5036 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5037 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5039 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5040 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5043 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5046 etheta=etheta+ethetai
5047 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5048 & 'ebend',i,ethetai,theta(i),itype(i)
5049 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5050 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5051 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5053 C Ufff.... We've done all this!!!
5056 C---------------------------------------------------------------------------
5057 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5059 implicit real*8 (a-h,o-z)
5060 include 'DIMENSIONS'
5061 include 'COMMON.LOCAL'
5062 include 'COMMON.IOUNITS'
5063 common /calcthet/ term1,term2,termm,diffak,ratak,
5064 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5065 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5066 C Calculate the contributions to both Gaussian lobes.
5067 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5068 C The "polynomial part" of the "standard deviation" of this part of
5069 C the distributioni.
5070 ccc write (iout,*) thetai,thet_pred_mean
5073 sig=sig*thet_pred_mean+polthet(j,it)
5075 C Derivative of the "interior part" of the "standard deviation of the"
5076 C gamma-dependent Gaussian lobe in t_c.
5077 sigtc=3*polthet(3,it)
5079 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5082 C Set the parameters of both Gaussian lobes of the distribution.
5083 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5084 fac=sig*sig+sigc0(it)
5087 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5088 sigsqtc=-4.0D0*sigcsq*sigtc
5089 c print *,i,sig,sigtc,sigsqtc
5090 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5091 sigtc=-sigtc/(fac*fac)
5092 C Following variable is sigma(t_c)**(-2)
5093 sigcsq=sigcsq*sigcsq
5095 sig0inv=1.0D0/sig0i**2
5096 delthec=thetai-thet_pred_mean
5097 delthe0=thetai-theta0i
5098 term1=-0.5D0*sigcsq*delthec*delthec
5099 term2=-0.5D0*sig0inv*delthe0*delthe0
5100 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5101 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5102 C NaNs in taking the logarithm. We extract the largest exponent which is added
5103 C to the energy (this being the log of the distribution) at the end of energy
5104 C term evaluation for this virtual-bond angle.
5105 if (term1.gt.term2) then
5107 term2=dexp(term2-termm)
5111 term1=dexp(term1-termm)
5114 C The ratio between the gamma-independent and gamma-dependent lobes of
5115 C the distribution is a Gaussian function of thet_pred_mean too.
5116 diffak=gthet(2,it)-thet_pred_mean
5117 ratak=diffak/gthet(3,it)**2
5118 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5119 C Let's differentiate it in thet_pred_mean NOW.
5121 C Now put together the distribution terms to make complete distribution.
5122 termexp=term1+ak*term2
5123 termpre=sigc+ak*sig0i
5124 C Contribution of the bending energy from this theta is just the -log of
5125 C the sum of the contributions from the two lobes and the pre-exponential
5126 C factor. Simple enough, isn't it?
5127 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5128 C write (iout,*) 'termexp',termexp,termm,termpre,i
5129 C NOW the derivatives!!!
5130 C 6/6/97 Take into account the deformation.
5131 E_theta=(delthec*sigcsq*term1
5132 & +ak*delthe0*sig0inv*term2)/termexp
5133 E_tc=((sigtc+aktc*sig0i)/termpre
5134 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5135 & aktc*term2)/termexp)
5138 c-----------------------------------------------------------------------------
5139 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5140 implicit real*8 (a-h,o-z)
5141 include 'DIMENSIONS'
5142 include 'COMMON.LOCAL'
5143 include 'COMMON.IOUNITS'
5144 common /calcthet/ term1,term2,termm,diffak,ratak,
5145 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5146 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5147 delthec=thetai-thet_pred_mean
5148 delthe0=thetai-theta0i
5149 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5150 t3 = thetai-thet_pred_mean
5154 t14 = t12+t6*sigsqtc
5156 t21 = thetai-theta0i
5162 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5163 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5164 & *(-t12*t9-ak*sig0inv*t27)
5168 C--------------------------------------------------------------------------
5169 subroutine ebend(etheta)
5171 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5172 C angles gamma and its derivatives in consecutive thetas and gammas.
5173 C ab initio-derived potentials from
5174 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5176 implicit real*8 (a-h,o-z)
5177 include 'DIMENSIONS'
5178 include 'COMMON.LOCAL'
5179 include 'COMMON.GEO'
5180 include 'COMMON.INTERACT'
5181 include 'COMMON.DERIV'
5182 include 'COMMON.VAR'
5183 include 'COMMON.CHAIN'
5184 include 'COMMON.IOUNITS'
5185 include 'COMMON.NAMES'
5186 include 'COMMON.FFIELD'
5187 include 'COMMON.CONTROL'
5188 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5189 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5190 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5191 & sinph1ph2(maxdouble,maxdouble)
5192 logical lprn /.false./, lprn1 /.false./
5194 do i=ithet_start,ithet_end
5195 c print *,i,itype(i-1),itype(i),itype(i-2)
5196 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5197 & .or.itype(i).eq.ntyp1) cycle
5198 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5200 if (iabs(itype(i+1)).eq.20) iblock=2
5201 if (iabs(itype(i+1)).ne.20) iblock=1
5205 theti2=0.5d0*theta(i)
5206 ityp2=ithetyp((itype(i-1)))
5208 coskt(k)=dcos(k*theti2)
5209 sinkt(k)=dsin(k*theti2)
5211 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5214 if (phii.ne.phii) phii=150.0
5218 ityp1=ithetyp((itype(i-2)))
5219 C propagation of chirality for glycine type
5221 cosph1(k)=dcos(k*phii)
5222 sinph1(k)=dsin(k*phii)
5232 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5235 if (phii1.ne.phii1) phii1=150.0
5240 ityp3=ithetyp((itype(i)))
5242 cosph2(k)=dcos(k*phii1)
5243 sinph2(k)=dsin(k*phii1)
5253 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5256 ccl=cosph1(l)*cosph2(k-l)
5257 ssl=sinph1(l)*sinph2(k-l)
5258 scl=sinph1(l)*cosph2(k-l)
5259 csl=cosph1(l)*sinph2(k-l)
5260 cosph1ph2(l,k)=ccl-ssl
5261 cosph1ph2(k,l)=ccl+ssl
5262 sinph1ph2(l,k)=scl+csl
5263 sinph1ph2(k,l)=scl-csl
5267 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5268 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5269 write (iout,*) "coskt and sinkt"
5271 write (iout,*) k,coskt(k),sinkt(k)
5275 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5276 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5279 & write (iout,*) "k",k,"
5280 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5281 & " ethetai",ethetai
5284 write (iout,*) "cosph and sinph"
5286 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5288 write (iout,*) "cosph1ph2 and sinph2ph2"
5291 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5292 & sinph1ph2(l,k),sinph1ph2(k,l)
5295 write(iout,*) "ethetai",ethetai
5299 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5300 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5301 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5302 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5303 ethetai=ethetai+sinkt(m)*aux
5304 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5305 dephii=dephii+k*sinkt(m)*(
5306 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5307 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5308 dephii1=dephii1+k*sinkt(m)*(
5309 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5310 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5312 & write (iout,*) "m",m," k",k," bbthet",
5313 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5314 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5315 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5316 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5320 & write(iout,*) "ethetai",ethetai
5324 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5325 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5326 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5327 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5328 ethetai=ethetai+sinkt(m)*aux
5329 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5330 dephii=dephii+l*sinkt(m)*(
5331 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5332 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5333 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5334 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5335 dephii1=dephii1+(k-l)*sinkt(m)*(
5336 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5337 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5338 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5339 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5341 write (iout,*) "m",m," k",k," l",l," ffthet",
5342 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5343 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5344 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5345 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5346 & " ethetai",ethetai
5347 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5348 & cosph1ph2(k,l)*sinkt(m),
5349 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5357 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5358 & i,theta(i)*rad2deg,phii*rad2deg,
5359 & phii1*rad2deg,ethetai
5361 etheta=etheta+ethetai
5362 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5363 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5364 gloc(nphi+i-2,icg)=wang*dethetai+ gloc(nphi+i-2,icg)
5370 c-----------------------------------------------------------------------------
5371 subroutine esc(escloc)
5372 C Calculate the local energy of a side chain and its derivatives in the
5373 C corresponding virtual-bond valence angles THETA and the spherical angles
5375 implicit real*8 (a-h,o-z)
5376 include 'DIMENSIONS'
5377 include 'COMMON.GEO'
5378 include 'COMMON.LOCAL'
5379 include 'COMMON.VAR'
5380 include 'COMMON.INTERACT'
5381 include 'COMMON.DERIV'
5382 include 'COMMON.CHAIN'
5383 include 'COMMON.IOUNITS'
5384 include 'COMMON.NAMES'
5385 include 'COMMON.FFIELD'
5386 include 'COMMON.CONTROL'
5387 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5388 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5389 common /sccalc/ time11,time12,time112,theti,it,nlobit
5392 c write (iout,'(a)') 'ESC'
5393 do i=loc_start,loc_end
5395 if (it.eq.ntyp1) cycle
5396 if (it.eq.10) goto 1
5397 nlobit=nlob(iabs(it))
5398 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5399 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5400 theti=theta(i+1)-pipol
5405 if (x(2).gt.pi-delta) then
5409 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5411 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5412 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5414 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5415 & ddersc0(1),dersc(1))
5416 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5417 & ddersc0(3),dersc(3))
5419 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5421 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5422 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5423 & dersc0(2),esclocbi,dersc02)
5424 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5426 call splinthet(x(2),0.5d0*delta,ss,ssd)
5431 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5433 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5434 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5436 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5438 c write (iout,*) escloci
5439 else if (x(2).lt.delta) then
5443 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5445 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5446 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5448 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5449 & ddersc0(1),dersc(1))
5450 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5451 & ddersc0(3),dersc(3))
5453 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5455 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5456 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5457 & dersc0(2),esclocbi,dersc02)
5458 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5463 call splinthet(x(2),0.5d0*delta,ss,ssd)
5465 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5467 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5468 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5470 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5471 c write (iout,*) escloci
5473 call enesc(x,escloci,dersc,ddummy,.false.)
5476 escloc=escloc+escloci
5477 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5478 & 'escloc',i,escloci
5479 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5481 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5483 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5484 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5489 C---------------------------------------------------------------------------
5490 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5491 implicit real*8 (a-h,o-z)
5492 include 'DIMENSIONS'
5493 include 'COMMON.GEO'
5494 include 'COMMON.LOCAL'
5495 include 'COMMON.IOUNITS'
5496 common /sccalc/ time11,time12,time112,theti,it,nlobit
5497 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5498 double precision contr(maxlob,-1:1)
5500 c write (iout,*) 'it=',it,' nlobit=',nlobit
5504 if (mixed) ddersc(j)=0.0d0
5508 C Because of periodicity of the dependence of the SC energy in omega we have
5509 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5510 C To avoid underflows, first compute & store the exponents.
5518 z(k)=x(k)-censc(k,j,it)
5523 Axk=Axk+gaussc(l,k,j,it)*z(l)
5529 expfac=expfac+Ax(k,j,iii)*z(k)
5537 C As in the case of ebend, we want to avoid underflows in exponentiation and
5538 C subsequent NaNs and INFs in energy calculation.
5539 C Find the largest exponent
5543 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5547 cd print *,'it=',it,' emin=',emin
5549 C Compute the contribution to SC energy and derivatives
5554 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5555 if(adexp.ne.adexp) adexp=1.0
5558 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5560 cd print *,'j=',j,' expfac=',expfac
5561 escloc_i=escloc_i+expfac
5563 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5567 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5568 & +gaussc(k,2,j,it))*expfac
5575 dersc(1)=dersc(1)/cos(theti)**2
5576 ddersc(1)=ddersc(1)/cos(theti)**2
5579 escloci=-(dlog(escloc_i)-emin)
5581 dersc(j)=dersc(j)/escloc_i
5585 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5590 C------------------------------------------------------------------------------
5591 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5592 implicit real*8 (a-h,o-z)
5593 include 'DIMENSIONS'
5594 include 'COMMON.GEO'
5595 include 'COMMON.LOCAL'
5596 include 'COMMON.IOUNITS'
5597 common /sccalc/ time11,time12,time112,theti,it,nlobit
5598 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5599 double precision contr(maxlob)
5610 z(k)=x(k)-censc(k,j,it)
5616 Axk=Axk+gaussc(l,k,j,it)*z(l)
5622 expfac=expfac+Ax(k,j)*z(k)
5627 C As in the case of ebend, we want to avoid underflows in exponentiation and
5628 C subsequent NaNs and INFs in energy calculation.
5629 C Find the largest exponent
5632 if (emin.gt.contr(j)) emin=contr(j)
5636 C Compute the contribution to SC energy and derivatives
5640 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5641 escloc_i=escloc_i+expfac
5643 dersc(k)=dersc(k)+Ax(k,j)*expfac
5645 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5646 & +gaussc(1,2,j,it))*expfac
5650 dersc(1)=dersc(1)/cos(theti)**2
5651 dersc12=dersc12/cos(theti)**2
5652 escloci=-(dlog(escloc_i)-emin)
5654 dersc(j)=dersc(j)/escloc_i
5656 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5660 c----------------------------------------------------------------------------------
5661 subroutine esc(escloc)
5662 C Calculate the local energy of a side chain and its derivatives in the
5663 C corresponding virtual-bond valence angles THETA and the spherical angles
5664 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5665 C added by Urszula Kozlowska. 07/11/2007
5667 implicit real*8 (a-h,o-z)
5668 include 'DIMENSIONS'
5669 include 'COMMON.GEO'
5670 include 'COMMON.LOCAL'
5671 include 'COMMON.VAR'
5672 include 'COMMON.SCROT'
5673 include 'COMMON.INTERACT'
5674 include 'COMMON.DERIV'
5675 include 'COMMON.CHAIN'
5676 include 'COMMON.IOUNITS'
5677 include 'COMMON.NAMES'
5678 include 'COMMON.FFIELD'
5679 include 'COMMON.CONTROL'
5680 include 'COMMON.VECTORS'
5681 double precision x_prime(3),y_prime(3),z_prime(3)
5682 & , sumene,dsc_i,dp2_i,x(65),
5683 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5684 & de_dxx,de_dyy,de_dzz,de_dt
5685 double precision s1_t,s1_6_t,s2_t,s2_6_t
5687 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5688 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5689 & dt_dCi(3),dt_dCi1(3)
5690 common /sccalc/ time11,time12,time112,theti,it,nlobit
5693 do i=loc_start,loc_end
5694 if (itype(i).eq.ntyp1) cycle
5695 costtab(i+1) =dcos(theta(i+1))
5696 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5697 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5698 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5699 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5700 cosfac=dsqrt(cosfac2)
5701 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5702 sinfac=dsqrt(sinfac2)
5704 if (it.eq.10) goto 1
5706 C Compute the axes of tghe local cartesian coordinates system; store in
5707 c x_prime, y_prime and z_prime
5714 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5715 C & dc_norm(3,i+nres)
5717 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5718 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5721 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5724 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5725 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5726 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5727 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5728 c & " xy",scalar(x_prime(1),y_prime(1)),
5729 c & " xz",scalar(x_prime(1),z_prime(1)),
5730 c & " yy",scalar(y_prime(1),y_prime(1)),
5731 c & " yz",scalar(y_prime(1),z_prime(1)),
5732 c & " zz",scalar(z_prime(1),z_prime(1))
5734 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5735 C to local coordinate system. Store in xx, yy, zz.
5741 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5742 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5743 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5750 C Compute the energy of the ith side cbain
5752 c write (2,*) "xx",xx," yy",yy," zz",zz
5755 x(j) = sc_parmin(j,it)
5758 Cc diagnostics - remove later
5760 yy1 = dsin(alph(2))*dcos(omeg(2))
5761 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5762 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5763 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5765 C," --- ", xx_w,yy_w,zz_w
5768 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5769 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5771 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5772 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5774 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5775 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5776 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5777 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5778 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5780 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5781 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5782 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5783 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5784 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5786 dsc_i = 0.743d0+x(61)
5788 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5789 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5790 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5791 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5792 s1=(1+x(63))/(0.1d0 + dscp1)
5793 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5794 s2=(1+x(65))/(0.1d0 + dscp2)
5795 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5796 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5797 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5798 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5800 c & dscp1,dscp2,sumene
5801 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5802 escloc = escloc + sumene
5803 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5808 C This section to check the numerical derivatives of the energy of ith side
5809 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5810 C #define DEBUG in the code to turn it on.
5812 write (2,*) "sumene =",sumene
5816 write (2,*) xx,yy,zz
5817 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5818 de_dxx_num=(sumenep-sumene)/aincr
5820 write (2,*) "xx+ sumene from enesc=",sumenep
5823 write (2,*) xx,yy,zz
5824 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5825 de_dyy_num=(sumenep-sumene)/aincr
5827 write (2,*) "yy+ sumene from enesc=",sumenep
5830 write (2,*) xx,yy,zz
5831 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5832 de_dzz_num=(sumenep-sumene)/aincr
5834 write (2,*) "zz+ sumene from enesc=",sumenep
5835 costsave=cost2tab(i+1)
5836 sintsave=sint2tab(i+1)
5837 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5838 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5839 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5840 de_dt_num=(sumenep-sumene)/aincr
5841 write (2,*) " t+ sumene from enesc=",sumenep
5842 cost2tab(i+1)=costsave
5843 sint2tab(i+1)=sintsave
5844 C End of diagnostics section.
5847 C Compute the gradient of esc
5849 c zz=zz*dsign(1.0,dfloat(itype(i)))
5850 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5851 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5852 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5853 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5854 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5855 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5856 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5857 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5858 pom1=(sumene3*sint2tab(i+1)+sumene1)
5859 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5860 pom2=(sumene4*cost2tab(i+1)+sumene2)
5861 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5862 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5863 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5864 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5866 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5867 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5868 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5870 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5871 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5872 & +(pom1+pom2)*pom_dx
5874 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5877 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5878 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5879 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5881 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5882 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5883 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5884 & +x(59)*zz**2 +x(60)*xx*zz
5885 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5886 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5887 & +(pom1-pom2)*pom_dy
5889 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5892 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5893 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5894 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5895 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5896 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5897 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5898 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5899 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5901 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5904 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5905 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5906 & +pom1*pom_dt1+pom2*pom_dt2
5908 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5913 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5914 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5915 cosfac2xx=cosfac2*xx
5916 sinfac2yy=sinfac2*yy
5918 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5920 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5922 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5923 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5924 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5925 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5926 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5927 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5928 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5929 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5930 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5931 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5935 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5936 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5937 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5938 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5941 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5942 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5943 dZZ_XYZ(k)=vbld_inv(i+nres)*
5944 & (z_prime(k)-zz*dC_norm(k,i+nres))
5946 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5947 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5951 dXX_Ctab(k,i)=dXX_Ci(k)
5952 dXX_C1tab(k,i)=dXX_Ci1(k)
5953 dYY_Ctab(k,i)=dYY_Ci(k)
5954 dYY_C1tab(k,i)=dYY_Ci1(k)
5955 dZZ_Ctab(k,i)=dZZ_Ci(k)
5956 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5957 dXX_XYZtab(k,i)=dXX_XYZ(k)
5958 dYY_XYZtab(k,i)=dYY_XYZ(k)
5959 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5963 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5964 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5965 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5966 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5967 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5969 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5970 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5971 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5972 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5973 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5974 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5975 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5976 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5978 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5979 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5981 C to check gradient call subroutine check_grad
5987 c------------------------------------------------------------------------------
5988 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5990 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5991 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5992 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5993 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5995 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5996 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5998 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5999 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6000 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6001 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6002 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6004 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6005 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6006 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6007 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6008 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6010 dsc_i = 0.743d0+x(61)
6012 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6013 & *(xx*cost2+yy*sint2))
6014 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6015 & *(xx*cost2-yy*sint2))
6016 s1=(1+x(63))/(0.1d0 + dscp1)
6017 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6018 s2=(1+x(65))/(0.1d0 + dscp2)
6019 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6020 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6021 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6026 c------------------------------------------------------------------------------
6027 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6029 C This procedure calculates two-body contact function g(rij) and its derivative:
6032 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6035 C where x=(rij-r0ij)/delta
6037 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6040 double precision rij,r0ij,eps0ij,fcont,fprimcont
6041 double precision x,x2,x4,delta
6045 if (x.lt.-1.0D0) then
6048 else if (x.le.1.0D0) then
6051 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6052 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6059 c------------------------------------------------------------------------------
6060 subroutine splinthet(theti,delta,ss,ssder)
6061 implicit real*8 (a-h,o-z)
6062 include 'DIMENSIONS'
6063 include 'COMMON.VAR'
6064 include 'COMMON.GEO'
6067 if (theti.gt.pipol) then
6068 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6070 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6075 c------------------------------------------------------------------------------
6076 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6078 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6079 double precision ksi,ksi2,ksi3,a1,a2,a3
6080 a1=fprim0*delta/(f1-f0)
6086 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6087 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6090 c------------------------------------------------------------------------------
6091 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6093 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6094 double precision ksi,ksi2,ksi3,a1,a2,a3
6099 a2=3*(f1x-f0x)-2*fprim0x*delta
6100 a3=fprim0x*delta-2*(f1x-f0x)
6101 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6104 C-----------------------------------------------------------------------------
6106 C-----------------------------------------------------------------------------
6107 subroutine etor(etors,edihcnstr)
6108 implicit real*8 (a-h,o-z)
6109 include 'DIMENSIONS'
6110 include 'COMMON.VAR'
6111 include 'COMMON.GEO'
6112 include 'COMMON.LOCAL'
6113 include 'COMMON.TORSION'
6114 include 'COMMON.INTERACT'
6115 include 'COMMON.DERIV'
6116 include 'COMMON.CHAIN'
6117 include 'COMMON.NAMES'
6118 include 'COMMON.IOUNITS'
6119 include 'COMMON.FFIELD'
6120 include 'COMMON.TORCNSTR'
6121 include 'COMMON.CONTROL'
6123 C Set lprn=.true. for debugging
6127 do i=iphi_start,iphi_end
6129 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6130 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6131 itori=itortyp(itype(i-2))
6132 itori1=itortyp(itype(i-1))
6135 C Proline-Proline pair is a special case...
6136 if (itori.eq.3 .and. itori1.eq.3) then
6137 if (phii.gt.-dwapi3) then
6139 fac=1.0D0/(1.0D0-cosphi)
6140 etorsi=v1(1,3,3)*fac
6141 etorsi=etorsi+etorsi
6142 etors=etors+etorsi-v1(1,3,3)
6143 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6144 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6147 v1ij=v1(j+1,itori,itori1)
6148 v2ij=v2(j+1,itori,itori1)
6151 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6152 if (energy_dec) etors_ii=etors_ii+
6153 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6154 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6158 v1ij=v1(j,itori,itori1)
6159 v2ij=v2(j,itori,itori1)
6162 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6163 if (energy_dec) etors_ii=etors_ii+
6164 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6165 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6168 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6171 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6172 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6173 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6174 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6175 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6177 ! 6/20/98 - dihedral angle constraints
6180 itori=idih_constr(i)
6183 if (difi.gt.drange(i)) then
6185 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6186 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6187 else if (difi.lt.-drange(i)) then
6189 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6190 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6192 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6193 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6195 ! write (iout,*) 'edihcnstr',edihcnstr
6198 c------------------------------------------------------------------------------
6199 subroutine etor_d(etors_d)
6203 c----------------------------------------------------------------------------
6205 subroutine etor(etors,edihcnstr)
6206 implicit real*8 (a-h,o-z)
6207 include 'DIMENSIONS'
6208 include 'COMMON.VAR'
6209 include 'COMMON.GEO'
6210 include 'COMMON.LOCAL'
6211 include 'COMMON.TORSION'
6212 include 'COMMON.INTERACT'
6213 include 'COMMON.DERIV'
6214 include 'COMMON.CHAIN'
6215 include 'COMMON.NAMES'
6216 include 'COMMON.IOUNITS'
6217 include 'COMMON.FFIELD'
6218 include 'COMMON.TORCNSTR'
6219 include 'COMMON.CONTROL'
6221 C Set lprn=.true. for debugging
6225 do i=iphi_start,iphi_end
6226 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6227 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6228 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6229 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6230 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6231 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6232 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6233 C For introducing the NH3+ and COO- group please check the etor_d for reference
6236 if (iabs(itype(i)).eq.20) then
6241 itori=itortyp(itype(i-2))
6242 itori1=itortyp(itype(i-1))
6245 C Regular cosine and sine terms
6246 do j=1,nterm(itori,itori1,iblock)
6247 v1ij=v1(j,itori,itori1,iblock)
6248 v2ij=v2(j,itori,itori1,iblock)
6251 etors=etors+v1ij*cosphi+v2ij*sinphi
6252 if (energy_dec) etors_ii=etors_ii+
6253 & v1ij*cosphi+v2ij*sinphi
6254 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6258 C E = SUM ----------------------------------- - v1
6259 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6261 cosphi=dcos(0.5d0*phii)
6262 sinphi=dsin(0.5d0*phii)
6263 do j=1,nlor(itori,itori1,iblock)
6264 vl1ij=vlor1(j,itori,itori1)
6265 vl2ij=vlor2(j,itori,itori1)
6266 vl3ij=vlor3(j,itori,itori1)
6267 pom=vl2ij*cosphi+vl3ij*sinphi
6268 pom1=1.0d0/(pom*pom+1.0d0)
6269 etors=etors+vl1ij*pom1
6270 if (energy_dec) etors_ii=etors_ii+
6273 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6275 C Subtract the constant term
6276 etors=etors-v0(itori,itori1,iblock)
6277 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6278 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6280 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6281 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6282 & (v1(j,itori,itori1,iblock),j=1,6),
6283 & (v2(j,itori,itori1,iblock),j=1,6)
6284 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6285 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6287 ! 6/20/98 - dihedral angle constraints
6289 c do i=1,ndih_constr
6290 do i=idihconstr_start,idihconstr_end
6291 itori=idih_constr(i)
6293 difi=pinorm(phii-phi0(i))
6294 if (difi.gt.drange(i)) then
6296 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6297 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6298 else if (difi.lt.-drange(i)) then
6300 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6301 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6305 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6306 cd & rad2deg*phi0(i), rad2deg*drange(i),
6307 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6309 cd write (iout,*) 'edihcnstr',edihcnstr
6312 c----------------------------------------------------------------------------
6313 subroutine etor_d(etors_d)
6314 C 6/23/01 Compute double torsional energy
6315 implicit real*8 (a-h,o-z)
6316 include 'DIMENSIONS'
6317 include 'COMMON.VAR'
6318 include 'COMMON.GEO'
6319 include 'COMMON.LOCAL'
6320 include 'COMMON.TORSION'
6321 include 'COMMON.INTERACT'
6322 include 'COMMON.DERIV'
6323 include 'COMMON.CHAIN'
6324 include 'COMMON.NAMES'
6325 include 'COMMON.IOUNITS'
6326 include 'COMMON.FFIELD'
6327 include 'COMMON.TORCNSTR'
6329 C Set lprn=.true. for debugging
6333 c write(iout,*) "a tu??"
6334 do i=iphid_start,iphid_end
6335 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6336 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6337 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6338 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6339 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6340 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6341 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6342 & (itype(i+1).eq.ntyp1)) cycle
6343 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6344 itori=itortyp(itype(i-2))
6345 itori1=itortyp(itype(i-1))
6346 itori2=itortyp(itype(i))
6352 if (iabs(itype(i+1)).eq.20) iblock=2
6353 C Iblock=2 Proline type
6354 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6355 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6356 C if (itype(i+1).eq.ntyp1) iblock=3
6357 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6358 C IS or IS NOT need for this
6359 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6360 C is (itype(i-3).eq.ntyp1) ntblock=2
6361 C ntblock is N-terminal blocking group
6363 C Regular cosine and sine terms
6364 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6365 C Example of changes for NH3+ blocking group
6366 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6367 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6368 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6369 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6370 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6371 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6372 cosphi1=dcos(j*phii)
6373 sinphi1=dsin(j*phii)
6374 cosphi2=dcos(j*phii1)
6375 sinphi2=dsin(j*phii1)
6376 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6377 & v2cij*cosphi2+v2sij*sinphi2
6378 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6379 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6381 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6383 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6384 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6385 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6386 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6387 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6388 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6389 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6390 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6391 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6392 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6393 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6394 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6395 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6396 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6399 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6400 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6405 c------------------------------------------------------------------------------
6406 subroutine eback_sc_corr(esccor)
6407 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6408 c conformational states; temporarily implemented as differences
6409 c between UNRES torsional potentials (dependent on three types of
6410 c residues) and the torsional potentials dependent on all 20 types
6411 c of residues computed from AM1 energy surfaces of terminally-blocked
6412 c amino-acid residues.
6413 implicit real*8 (a-h,o-z)
6414 include 'DIMENSIONS'
6415 include 'COMMON.VAR'
6416 include 'COMMON.GEO'
6417 include 'COMMON.LOCAL'
6418 include 'COMMON.TORSION'
6419 include 'COMMON.SCCOR'
6420 include 'COMMON.INTERACT'
6421 include 'COMMON.DERIV'
6422 include 'COMMON.CHAIN'
6423 include 'COMMON.NAMES'
6424 include 'COMMON.IOUNITS'
6425 include 'COMMON.FFIELD'
6426 include 'COMMON.CONTROL'
6428 C Set lprn=.true. for debugging
6431 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6433 do i=itau_start,itau_end
6434 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6436 isccori=isccortyp(itype(i-2))
6437 isccori1=isccortyp(itype(i-1))
6438 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6440 do intertyp=1,3 !intertyp
6441 cc Added 09 May 2012 (Adasko)
6442 cc Intertyp means interaction type of backbone mainchain correlation:
6443 c 1 = SC...Ca...Ca...Ca
6444 c 2 = Ca...Ca...Ca...SC
6445 c 3 = SC...Ca...Ca...SCi
6447 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6448 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6449 & (itype(i-1).eq.ntyp1)))
6450 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6451 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6452 & .or.(itype(i).eq.ntyp1)))
6453 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6454 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6455 & (itype(i-3).eq.ntyp1)))) cycle
6456 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6457 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6459 do j=1,nterm_sccor(isccori,isccori1)
6460 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6461 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6462 cosphi=dcos(j*tauangle(intertyp,i))
6463 sinphi=dsin(j*tauangle(intertyp,i))
6464 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6465 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6467 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6468 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6470 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6471 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6472 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6473 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6474 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6480 c----------------------------------------------------------------------------
6481 subroutine multibody(ecorr)
6482 C This subroutine calculates multi-body contributions to energy following
6483 C the idea of Skolnick et al. If side chains I and J make a contact and
6484 C at the same time side chains I+1 and J+1 make a contact, an extra
6485 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6486 implicit real*8 (a-h,o-z)
6487 include 'DIMENSIONS'
6488 include 'COMMON.IOUNITS'
6489 include 'COMMON.DERIV'
6490 include 'COMMON.INTERACT'
6491 include 'COMMON.CONTACTS'
6492 double precision gx(3),gx1(3)
6495 C Set lprn=.true. for debugging
6499 write (iout,'(a)') 'Contact function values:'
6501 write (iout,'(i2,20(1x,i2,f10.5))')
6502 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6517 num_conti=num_cont(i)
6518 num_conti1=num_cont(i1)
6523 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6524 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6525 cd & ' ishift=',ishift
6526 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6527 C The system gains extra energy.
6528 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6529 endif ! j1==j+-ishift
6538 c------------------------------------------------------------------------------
6539 double precision function esccorr(i,j,k,l,jj,kk)
6540 implicit real*8 (a-h,o-z)
6541 include 'DIMENSIONS'
6542 include 'COMMON.IOUNITS'
6543 include 'COMMON.DERIV'
6544 include 'COMMON.INTERACT'
6545 include 'COMMON.CONTACTS'
6546 double precision gx(3),gx1(3)
6551 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6552 C Calculate the multi-body contribution to energy.
6553 C Calculate multi-body contributions to the gradient.
6554 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6555 cd & k,l,(gacont(m,kk,k),m=1,3)
6557 gx(m) =ekl*gacont(m,jj,i)
6558 gx1(m)=eij*gacont(m,kk,k)
6559 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6560 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6561 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6562 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6566 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6571 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6577 c------------------------------------------------------------------------------
6578 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6579 C This subroutine calculates multi-body contributions to hydrogen-bonding
6580 implicit real*8 (a-h,o-z)
6581 include 'DIMENSIONS'
6582 include 'COMMON.IOUNITS'
6585 parameter (max_cont=maxconts)
6586 parameter (max_dim=26)
6587 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6588 double precision zapas(max_dim,maxconts,max_fg_procs),
6589 & zapas_recv(max_dim,maxconts,max_fg_procs)
6590 common /przechowalnia/ zapas
6591 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6592 & status_array(MPI_STATUS_SIZE,maxconts*2)
6594 include 'COMMON.SETUP'
6595 include 'COMMON.FFIELD'
6596 include 'COMMON.DERIV'
6597 include 'COMMON.INTERACT'
6598 include 'COMMON.CONTACTS'
6599 include 'COMMON.CONTROL'
6600 include 'COMMON.LOCAL'
6601 double precision gx(3),gx1(3),time00
6604 C Set lprn=.true. for debugging
6609 if (nfgtasks.le.1) goto 30
6611 write (iout,'(a)') 'Contact function values before RECEIVE:'
6613 write (iout,'(2i3,50(1x,i2,f5.2))')
6614 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6615 & j=1,num_cont_hb(i))
6619 do i=1,ntask_cont_from
6622 do i=1,ntask_cont_to
6625 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6627 C Make the list of contacts to send to send to other procesors
6628 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6630 do i=iturn3_start,iturn3_end
6631 c write (iout,*) "make contact list turn3",i," num_cont",
6633 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6635 do i=iturn4_start,iturn4_end
6636 c write (iout,*) "make contact list turn4",i," num_cont",
6638 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6642 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6644 do j=1,num_cont_hb(i)
6647 iproc=iint_sent_local(k,jjc,ii)
6648 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6649 if (iproc.gt.0) then
6650 ncont_sent(iproc)=ncont_sent(iproc)+1
6651 nn=ncont_sent(iproc)
6653 zapas(2,nn,iproc)=jjc
6654 zapas(3,nn,iproc)=facont_hb(j,i)
6655 zapas(4,nn,iproc)=ees0p(j,i)
6656 zapas(5,nn,iproc)=ees0m(j,i)
6657 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6658 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6659 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6660 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6661 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6662 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6663 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6664 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6665 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6666 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6667 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6668 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6669 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6670 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6671 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6672 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6673 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6674 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6675 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6676 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6677 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6684 & "Numbers of contacts to be sent to other processors",
6685 & (ncont_sent(i),i=1,ntask_cont_to)
6686 write (iout,*) "Contacts sent"
6687 do ii=1,ntask_cont_to
6689 iproc=itask_cont_to(ii)
6690 write (iout,*) nn," contacts to processor",iproc,
6691 & " of CONT_TO_COMM group"
6693 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6701 CorrelID1=nfgtasks+fg_rank+1
6703 C Receive the numbers of needed contacts from other processors
6704 do ii=1,ntask_cont_from
6705 iproc=itask_cont_from(ii)
6707 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6708 & FG_COMM,req(ireq),IERR)
6710 c write (iout,*) "IRECV ended"
6712 C Send the number of contacts needed by other processors
6713 do ii=1,ntask_cont_to
6714 iproc=itask_cont_to(ii)
6716 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6717 & FG_COMM,req(ireq),IERR)
6719 c write (iout,*) "ISEND ended"
6720 c write (iout,*) "number of requests (nn)",ireq
6723 & call MPI_Waitall(ireq,req,status_array,ierr)
6725 c & "Numbers of contacts to be received from other processors",
6726 c & (ncont_recv(i),i=1,ntask_cont_from)
6730 do ii=1,ntask_cont_from
6731 iproc=itask_cont_from(ii)
6733 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6734 c & " of CONT_TO_COMM group"
6738 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6739 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6740 c write (iout,*) "ireq,req",ireq,req(ireq)
6743 C Send the contacts to processors that need them
6744 do ii=1,ntask_cont_to
6745 iproc=itask_cont_to(ii)
6747 c write (iout,*) nn," contacts to processor",iproc,
6748 c & " of CONT_TO_COMM group"
6751 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6752 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6753 c write (iout,*) "ireq,req",ireq,req(ireq)
6755 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6759 c write (iout,*) "number of requests (contacts)",ireq
6760 c write (iout,*) "req",(req(i),i=1,4)
6763 & call MPI_Waitall(ireq,req,status_array,ierr)
6764 do iii=1,ntask_cont_from
6765 iproc=itask_cont_from(iii)
6768 write (iout,*) "Received",nn," contacts from processor",iproc,
6769 & " of CONT_FROM_COMM group"
6772 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6777 ii=zapas_recv(1,i,iii)
6778 c Flag the received contacts to prevent double-counting
6779 jj=-zapas_recv(2,i,iii)
6780 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6782 nnn=num_cont_hb(ii)+1
6785 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6786 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6787 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6788 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6789 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6790 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6791 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6792 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6793 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6794 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6795 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6796 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6797 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6798 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6799 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6800 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6801 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6802 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6803 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6804 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6805 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6806 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6807 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6808 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6813 write (iout,'(a)') 'Contact function values after receive:'
6815 write (iout,'(2i3,50(1x,i3,f5.2))')
6816 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6817 & j=1,num_cont_hb(i))
6824 write (iout,'(a)') 'Contact function values:'
6826 write (iout,'(2i3,50(1x,i3,f5.2))')
6827 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6828 & j=1,num_cont_hb(i))
6832 C Remove the loop below after debugging !!!
6839 C Calculate the local-electrostatic correlation terms
6840 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6842 num_conti=num_cont_hb(i)
6843 num_conti1=num_cont_hb(i+1)
6850 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6851 c & ' jj=',jj,' kk=',kk
6852 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6853 & .or. j.lt.0 .and. j1.gt.0) .and.
6854 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6855 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6856 C The system gains extra energy.
6857 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6858 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6859 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6861 else if (j1.eq.j) then
6862 C Contacts I-J and I-(J+1) occur simultaneously.
6863 C The system loses extra energy.
6864 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6869 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6870 c & ' jj=',jj,' kk=',kk
6872 C Contacts I-J and (I+1)-J occur simultaneously.
6873 C The system loses extra energy.
6874 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6881 c------------------------------------------------------------------------------
6882 subroutine add_hb_contact(ii,jj,itask)
6883 implicit real*8 (a-h,o-z)
6884 include "DIMENSIONS"
6885 include "COMMON.IOUNITS"
6888 parameter (max_cont=maxconts)
6889 parameter (max_dim=26)
6890 include "COMMON.CONTACTS"
6891 double precision zapas(max_dim,maxconts,max_fg_procs),
6892 & zapas_recv(max_dim,maxconts,max_fg_procs)
6893 common /przechowalnia/ zapas
6894 integer i,j,ii,jj,iproc,itask(4),nn
6895 c write (iout,*) "itask",itask
6898 if (iproc.gt.0) then
6899 do j=1,num_cont_hb(ii)
6901 c write (iout,*) "i",ii," j",jj," jjc",jjc
6903 ncont_sent(iproc)=ncont_sent(iproc)+1
6904 nn=ncont_sent(iproc)
6905 zapas(1,nn,iproc)=ii
6906 zapas(2,nn,iproc)=jjc
6907 zapas(3,nn,iproc)=facont_hb(j,ii)
6908 zapas(4,nn,iproc)=ees0p(j,ii)
6909 zapas(5,nn,iproc)=ees0m(j,ii)
6910 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6911 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6912 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6913 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6914 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6915 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6916 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6917 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6918 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6919 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6920 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6921 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6922 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6923 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6924 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6925 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6926 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6927 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6928 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6929 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6930 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6938 c------------------------------------------------------------------------------
6939 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6941 C This subroutine calculates multi-body contributions to hydrogen-bonding
6942 implicit real*8 (a-h,o-z)
6943 include 'DIMENSIONS'
6944 include 'COMMON.IOUNITS'
6947 parameter (max_cont=maxconts)
6948 parameter (max_dim=70)
6949 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6950 double precision zapas(max_dim,maxconts,max_fg_procs),
6951 & zapas_recv(max_dim,maxconts,max_fg_procs)
6952 common /przechowalnia/ zapas
6953 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6954 & status_array(MPI_STATUS_SIZE,maxconts*2)
6956 include 'COMMON.SETUP'
6957 include 'COMMON.FFIELD'
6958 include 'COMMON.DERIV'
6959 include 'COMMON.LOCAL'
6960 include 'COMMON.INTERACT'
6961 include 'COMMON.CONTACTS'
6962 include 'COMMON.CHAIN'
6963 include 'COMMON.CONTROL'
6964 double precision gx(3),gx1(3)
6965 integer num_cont_hb_old(maxres)
6967 double precision eello4,eello5,eelo6,eello_turn6
6968 external eello4,eello5,eello6,eello_turn6
6969 C Set lprn=.true. for debugging
6974 num_cont_hb_old(i)=num_cont_hb(i)
6978 if (nfgtasks.le.1) goto 30
6980 write (iout,'(a)') 'Contact function values before RECEIVE:'
6982 write (iout,'(2i3,50(1x,i2,f5.2))')
6983 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6984 & j=1,num_cont_hb(i))
6988 do i=1,ntask_cont_from
6991 do i=1,ntask_cont_to
6994 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6996 C Make the list of contacts to send to send to other procesors
6997 do i=iturn3_start,iturn3_end
6998 c write (iout,*) "make contact list turn3",i," num_cont",
7000 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7002 do i=iturn4_start,iturn4_end
7003 c write (iout,*) "make contact list turn4",i," num_cont",
7005 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7009 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7011 do j=1,num_cont_hb(i)
7014 iproc=iint_sent_local(k,jjc,ii)
7015 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7016 if (iproc.ne.0) then
7017 ncont_sent(iproc)=ncont_sent(iproc)+1
7018 nn=ncont_sent(iproc)
7020 zapas(2,nn,iproc)=jjc
7021 zapas(3,nn,iproc)=d_cont(j,i)
7025 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7030 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7038 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7049 & "Numbers of contacts to be sent to other processors",
7050 & (ncont_sent(i),i=1,ntask_cont_to)
7051 write (iout,*) "Contacts sent"
7052 do ii=1,ntask_cont_to
7054 iproc=itask_cont_to(ii)
7055 write (iout,*) nn," contacts to processor",iproc,
7056 & " of CONT_TO_COMM group"
7058 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7066 CorrelID1=nfgtasks+fg_rank+1
7068 C Receive the numbers of needed contacts from other processors
7069 do ii=1,ntask_cont_from
7070 iproc=itask_cont_from(ii)
7072 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7073 & FG_COMM,req(ireq),IERR)
7075 c write (iout,*) "IRECV ended"
7077 C Send the number of contacts needed by other processors
7078 do ii=1,ntask_cont_to
7079 iproc=itask_cont_to(ii)
7081 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7082 & FG_COMM,req(ireq),IERR)
7084 c write (iout,*) "ISEND ended"
7085 c write (iout,*) "number of requests (nn)",ireq
7088 & call MPI_Waitall(ireq,req,status_array,ierr)
7090 c & "Numbers of contacts to be received from other processors",
7091 c & (ncont_recv(i),i=1,ntask_cont_from)
7095 do ii=1,ntask_cont_from
7096 iproc=itask_cont_from(ii)
7098 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7099 c & " of CONT_TO_COMM group"
7103 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7104 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7105 c write (iout,*) "ireq,req",ireq,req(ireq)
7108 C Send the contacts to processors that need them
7109 do ii=1,ntask_cont_to
7110 iproc=itask_cont_to(ii)
7112 c write (iout,*) nn," contacts to processor",iproc,
7113 c & " of CONT_TO_COMM group"
7116 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7117 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7118 c write (iout,*) "ireq,req",ireq,req(ireq)
7120 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7124 c write (iout,*) "number of requests (contacts)",ireq
7125 c write (iout,*) "req",(req(i),i=1,4)
7128 & call MPI_Waitall(ireq,req,status_array,ierr)
7129 do iii=1,ntask_cont_from
7130 iproc=itask_cont_from(iii)
7133 write (iout,*) "Received",nn," contacts from processor",iproc,
7134 & " of CONT_FROM_COMM group"
7137 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7142 ii=zapas_recv(1,i,iii)
7143 c Flag the received contacts to prevent double-counting
7144 jj=-zapas_recv(2,i,iii)
7145 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7147 nnn=num_cont_hb(ii)+1
7150 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7154 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7159 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7167 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7176 write (iout,'(a)') 'Contact function values after receive:'
7178 write (iout,'(2i3,50(1x,i3,5f6.3))')
7179 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7180 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7187 write (iout,'(a)') 'Contact function values:'
7189 write (iout,'(2i3,50(1x,i2,5f6.3))')
7190 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7191 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7197 C Remove the loop below after debugging !!!
7204 C Calculate the dipole-dipole interaction energies
7205 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7206 do i=iatel_s,iatel_e+1
7207 num_conti=num_cont_hb(i)
7216 C Calculate the local-electrostatic correlation terms
7217 c write (iout,*) "gradcorr5 in eello5 before loop"
7219 c write (iout,'(i5,3f10.5)')
7220 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7222 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7223 c write (iout,*) "corr loop i",i
7225 num_conti=num_cont_hb(i)
7226 num_conti1=num_cont_hb(i+1)
7233 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7234 c & ' jj=',jj,' kk=',kk
7235 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7236 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7237 & .or. j.lt.0 .and. j1.gt.0) .and.
7238 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7239 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7240 C The system gains extra energy.
7242 sqd1=dsqrt(d_cont(jj,i))
7243 sqd2=dsqrt(d_cont(kk,i1))
7244 sred_geom = sqd1*sqd2
7245 IF (sred_geom.lt.cutoff_corr) THEN
7246 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7248 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7249 cd & ' jj=',jj,' kk=',kk
7250 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7251 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7253 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7254 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7257 cd write (iout,*) 'sred_geom=',sred_geom,
7258 cd & ' ekont=',ekont,' fprim=',fprimcont,
7259 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7260 cd write (iout,*) "g_contij",g_contij
7261 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7262 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7263 call calc_eello(i,jp,i+1,jp1,jj,kk)
7264 if (wcorr4.gt.0.0d0)
7265 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7266 if (energy_dec.and.wcorr4.gt.0.0d0)
7267 1 write (iout,'(a6,4i5,0pf7.3)')
7268 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7269 c write (iout,*) "gradcorr5 before eello5"
7271 c write (iout,'(i5,3f10.5)')
7272 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7274 if (wcorr5.gt.0.0d0)
7275 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7276 c write (iout,*) "gradcorr5 after eello5"
7278 c write (iout,'(i5,3f10.5)')
7279 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7281 if (energy_dec.and.wcorr5.gt.0.0d0)
7282 1 write (iout,'(a6,4i5,0pf7.3)')
7283 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7284 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7285 cd write(2,*)'ijkl',i,jp,i+1,jp1
7286 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7287 & .or. wturn6.eq.0.0d0))then
7288 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7289 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7290 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7291 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7292 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7293 cd & 'ecorr6=',ecorr6
7294 cd write (iout,'(4e15.5)') sred_geom,
7295 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7296 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7297 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7298 else if (wturn6.gt.0.0d0
7299 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7300 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7301 eturn6=eturn6+eello_turn6(i,jj,kk)
7302 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7303 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7304 cd write (2,*) 'multibody_eello:eturn6',eturn6
7313 num_cont_hb(i)=num_cont_hb_old(i)
7315 c write (iout,*) "gradcorr5 in eello5"
7317 c write (iout,'(i5,3f10.5)')
7318 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7322 c------------------------------------------------------------------------------
7323 subroutine add_hb_contact_eello(ii,jj,itask)
7324 implicit real*8 (a-h,o-z)
7325 include "DIMENSIONS"
7326 include "COMMON.IOUNITS"
7329 parameter (max_cont=maxconts)
7330 parameter (max_dim=70)
7331 include "COMMON.CONTACTS"
7332 double precision zapas(max_dim,maxconts,max_fg_procs),
7333 & zapas_recv(max_dim,maxconts,max_fg_procs)
7334 common /przechowalnia/ zapas
7335 integer i,j,ii,jj,iproc,itask(4),nn
7336 c write (iout,*) "itask",itask
7339 if (iproc.gt.0) then
7340 do j=1,num_cont_hb(ii)
7342 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7344 ncont_sent(iproc)=ncont_sent(iproc)+1
7345 nn=ncont_sent(iproc)
7346 zapas(1,nn,iproc)=ii
7347 zapas(2,nn,iproc)=jjc
7348 zapas(3,nn,iproc)=d_cont(j,ii)
7352 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7357 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7365 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7377 c------------------------------------------------------------------------------
7378 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7379 implicit real*8 (a-h,o-z)
7380 include 'DIMENSIONS'
7381 include 'COMMON.IOUNITS'
7382 include 'COMMON.DERIV'
7383 include 'COMMON.INTERACT'
7384 include 'COMMON.CONTACTS'
7385 double precision gx(3),gx1(3)
7395 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7396 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7397 C Following 4 lines for diagnostics.
7402 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7403 c & 'Contacts ',i,j,
7404 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7405 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7407 C Calculate the multi-body contribution to energy.
7408 c ecorr=ecorr+ekont*ees
7409 C Calculate multi-body contributions to the gradient.
7410 coeffpees0pij=coeffp*ees0pij
7411 coeffmees0mij=coeffm*ees0mij
7412 coeffpees0pkl=coeffp*ees0pkl
7413 coeffmees0mkl=coeffm*ees0mkl
7415 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7416 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7417 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7418 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7419 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7420 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7421 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7422 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7423 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7424 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7425 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7426 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7427 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7428 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7429 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7430 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7431 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7432 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7433 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7434 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7435 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7436 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7437 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7438 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7439 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7444 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7445 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7446 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7447 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7452 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7453 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7454 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7455 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7458 c write (iout,*) "ehbcorr",ekont*ees
7463 C---------------------------------------------------------------------------
7464 subroutine dipole(i,j,jj)
7465 implicit real*8 (a-h,o-z)
7466 include 'DIMENSIONS'
7467 include 'COMMON.IOUNITS'
7468 include 'COMMON.CHAIN'
7469 include 'COMMON.FFIELD'
7470 include 'COMMON.DERIV'
7471 include 'COMMON.INTERACT'
7472 include 'COMMON.CONTACTS'
7473 include 'COMMON.TORSION'
7474 include 'COMMON.VAR'
7475 include 'COMMON.GEO'
7476 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7478 iti1 = itortyp(itype(i+1))
7479 if (j.lt.nres-1) then
7480 itj1 = itortyp(itype(j+1))
7485 dipi(iii,1)=Ub2(iii,i)
7486 dipderi(iii)=Ub2der(iii,i)
7487 dipi(iii,2)=b1(iii,iti1)
7488 dipj(iii,1)=Ub2(iii,j)
7489 dipderj(iii)=Ub2der(iii,j)
7490 dipj(iii,2)=b1(iii,itj1)
7494 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7497 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7504 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7508 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7513 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7514 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7516 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7518 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7520 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7525 C---------------------------------------------------------------------------
7526 subroutine calc_eello(i,j,k,l,jj,kk)
7528 C This subroutine computes matrices and vectors needed to calculate
7529 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7531 implicit real*8 (a-h,o-z)
7532 include 'DIMENSIONS'
7533 include 'COMMON.IOUNITS'
7534 include 'COMMON.CHAIN'
7535 include 'COMMON.DERIV'
7536 include 'COMMON.INTERACT'
7537 include 'COMMON.CONTACTS'
7538 include 'COMMON.TORSION'
7539 include 'COMMON.VAR'
7540 include 'COMMON.GEO'
7541 include 'COMMON.FFIELD'
7542 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7543 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7546 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7547 cd & ' jj=',jj,' kk=',kk
7548 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7549 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7550 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7553 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7554 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7557 call transpose2(aa1(1,1),aa1t(1,1))
7558 call transpose2(aa2(1,1),aa2t(1,1))
7561 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7562 & aa1tder(1,1,lll,kkk))
7563 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7564 & aa2tder(1,1,lll,kkk))
7568 C parallel orientation of the two CA-CA-CA frames.
7570 iti=itortyp(itype(i))
7574 itk1=itortyp(itype(k+1))
7575 itj=itortyp(itype(j))
7576 if (l.lt.nres-1) then
7577 itl1=itortyp(itype(l+1))
7581 C A1 kernel(j+1) A2T
7583 cd write (iout,'(3f10.5,5x,3f10.5)')
7584 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7586 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7587 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7588 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7589 C Following matrices are needed only for 6-th order cumulants
7590 IF (wcorr6.gt.0.0d0) THEN
7591 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7592 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7593 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7594 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7595 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7596 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7597 & ADtEAderx(1,1,1,1,1,1))
7599 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7600 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7601 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7602 & ADtEA1derx(1,1,1,1,1,1))
7604 C End 6-th order cumulants
7607 cd write (2,*) 'In calc_eello6'
7609 cd write (2,*) 'iii=',iii
7611 cd write (2,*) 'kkk=',kkk
7613 cd write (2,'(3(2f10.5),5x)')
7614 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7619 call transpose2(EUgder(1,1,k),auxmat(1,1))
7620 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7621 call transpose2(EUg(1,1,k),auxmat(1,1))
7622 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7623 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7627 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7628 & EAEAderx(1,1,lll,kkk,iii,1))
7632 C A1T kernel(i+1) A2
7633 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7634 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7635 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7636 C Following matrices are needed only for 6-th order cumulants
7637 IF (wcorr6.gt.0.0d0) THEN
7638 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7639 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7640 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7641 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7642 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7643 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7644 & ADtEAderx(1,1,1,1,1,2))
7645 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7646 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7647 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7648 & ADtEA1derx(1,1,1,1,1,2))
7650 C End 6-th order cumulants
7651 call transpose2(EUgder(1,1,l),auxmat(1,1))
7652 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7653 call transpose2(EUg(1,1,l),auxmat(1,1))
7654 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7655 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7659 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7660 & EAEAderx(1,1,lll,kkk,iii,2))
7665 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7666 C They are needed only when the fifth- or the sixth-order cumulants are
7668 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7669 call transpose2(AEA(1,1,1),auxmat(1,1))
7670 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7671 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7672 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7673 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7674 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7675 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7676 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7677 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7678 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7679 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7680 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7681 call transpose2(AEA(1,1,2),auxmat(1,1))
7682 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7683 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7684 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7685 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7686 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7687 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7688 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7689 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7690 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7691 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7692 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7693 C Calculate the Cartesian derivatives of the vectors.
7697 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7698 call matvec2(auxmat(1,1),b1(1,iti),
7699 & AEAb1derx(1,lll,kkk,iii,1,1))
7700 call matvec2(auxmat(1,1),Ub2(1,i),
7701 & AEAb2derx(1,lll,kkk,iii,1,1))
7702 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7703 & AEAb1derx(1,lll,kkk,iii,2,1))
7704 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7705 & AEAb2derx(1,lll,kkk,iii,2,1))
7706 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7707 call matvec2(auxmat(1,1),b1(1,itj),
7708 & AEAb1derx(1,lll,kkk,iii,1,2))
7709 call matvec2(auxmat(1,1),Ub2(1,j),
7710 & AEAb2derx(1,lll,kkk,iii,1,2))
7711 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7712 & AEAb1derx(1,lll,kkk,iii,2,2))
7713 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7714 & AEAb2derx(1,lll,kkk,iii,2,2))
7721 C Antiparallel orientation of the two CA-CA-CA frames.
7723 iti=itortyp(itype(i))
7727 itk1=itortyp(itype(k+1))
7728 itl=itortyp(itype(l))
7729 itj=itortyp(itype(j))
7730 if (j.lt.nres-1) then
7731 itj1=itortyp(itype(j+1))
7735 C A2 kernel(j-1)T A1T
7736 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7737 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7738 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7739 C Following matrices are needed only for 6-th order cumulants
7740 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7741 & j.eq.i+4 .and. l.eq.i+3)) THEN
7742 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7743 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7744 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7745 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7746 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7747 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7748 & ADtEAderx(1,1,1,1,1,1))
7749 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7750 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7751 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7752 & ADtEA1derx(1,1,1,1,1,1))
7754 C End 6-th order cumulants
7755 call transpose2(EUgder(1,1,k),auxmat(1,1))
7756 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7757 call transpose2(EUg(1,1,k),auxmat(1,1))
7758 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7759 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7763 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7764 & EAEAderx(1,1,lll,kkk,iii,1))
7768 C A2T kernel(i+1)T A1
7769 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7770 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7771 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7772 C Following matrices are needed only for 6-th order cumulants
7773 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7774 & j.eq.i+4 .and. l.eq.i+3)) THEN
7775 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7776 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7777 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7778 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7779 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7780 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7781 & ADtEAderx(1,1,1,1,1,2))
7782 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7783 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7784 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7785 & ADtEA1derx(1,1,1,1,1,2))
7787 C End 6-th order cumulants
7788 call transpose2(EUgder(1,1,j),auxmat(1,1))
7789 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7790 call transpose2(EUg(1,1,j),auxmat(1,1))
7791 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7792 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7796 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7797 & EAEAderx(1,1,lll,kkk,iii,2))
7802 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7803 C They are needed only when the fifth- or the sixth-order cumulants are
7805 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7806 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7807 call transpose2(AEA(1,1,1),auxmat(1,1))
7808 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7809 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7810 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7811 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7812 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7813 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7814 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7815 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7816 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7817 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7818 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7819 call transpose2(AEA(1,1,2),auxmat(1,1))
7820 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7821 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7822 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7823 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7824 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7825 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7826 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7827 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7828 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7829 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7830 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7831 C Calculate the Cartesian derivatives of the vectors.
7835 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7836 call matvec2(auxmat(1,1),b1(1,iti),
7837 & AEAb1derx(1,lll,kkk,iii,1,1))
7838 call matvec2(auxmat(1,1),Ub2(1,i),
7839 & AEAb2derx(1,lll,kkk,iii,1,1))
7840 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7841 & AEAb1derx(1,lll,kkk,iii,2,1))
7842 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7843 & AEAb2derx(1,lll,kkk,iii,2,1))
7844 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7845 call matvec2(auxmat(1,1),b1(1,itl),
7846 & AEAb1derx(1,lll,kkk,iii,1,2))
7847 call matvec2(auxmat(1,1),Ub2(1,l),
7848 & AEAb2derx(1,lll,kkk,iii,1,2))
7849 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7850 & AEAb1derx(1,lll,kkk,iii,2,2))
7851 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7852 & AEAb2derx(1,lll,kkk,iii,2,2))
7861 C---------------------------------------------------------------------------
7862 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7863 & KK,KKderg,AKA,AKAderg,AKAderx)
7867 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7868 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7869 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7874 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7876 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7879 cd if (lprn) write (2,*) 'In kernel'
7881 cd if (lprn) write (2,*) 'kkk=',kkk
7883 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7884 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7886 cd write (2,*) 'lll=',lll
7887 cd write (2,*) 'iii=1'
7889 cd write (2,'(3(2f10.5),5x)')
7890 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7893 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7894 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7896 cd write (2,*) 'lll=',lll
7897 cd write (2,*) 'iii=2'
7899 cd write (2,'(3(2f10.5),5x)')
7900 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7907 C---------------------------------------------------------------------------
7908 double precision function eello4(i,j,k,l,jj,kk)
7909 implicit real*8 (a-h,o-z)
7910 include 'DIMENSIONS'
7911 include 'COMMON.IOUNITS'
7912 include 'COMMON.CHAIN'
7913 include 'COMMON.DERIV'
7914 include 'COMMON.INTERACT'
7915 include 'COMMON.CONTACTS'
7916 include 'COMMON.TORSION'
7917 include 'COMMON.VAR'
7918 include 'COMMON.GEO'
7919 double precision pizda(2,2),ggg1(3),ggg2(3)
7920 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7924 cd print *,'eello4:',i,j,k,l,jj,kk
7925 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7926 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7927 cold eij=facont_hb(jj,i)
7928 cold ekl=facont_hb(kk,k)
7930 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7931 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7932 gcorr_loc(k-1)=gcorr_loc(k-1)
7933 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7935 gcorr_loc(l-1)=gcorr_loc(l-1)
7936 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7938 gcorr_loc(j-1)=gcorr_loc(j-1)
7939 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7944 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7945 & -EAEAderx(2,2,lll,kkk,iii,1)
7946 cd derx(lll,kkk,iii)=0.0d0
7950 cd gcorr_loc(l-1)=0.0d0
7951 cd gcorr_loc(j-1)=0.0d0
7952 cd gcorr_loc(k-1)=0.0d0
7954 cd write (iout,*)'Contacts have occurred for peptide groups',
7955 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7956 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7957 if (j.lt.nres-1) then
7964 if (l.lt.nres-1) then
7972 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7973 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7974 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7975 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7976 cgrad ghalf=0.5d0*ggg1(ll)
7977 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7978 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7979 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7980 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7981 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7982 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7983 cgrad ghalf=0.5d0*ggg2(ll)
7984 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7985 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7986 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7987 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7988 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7989 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7993 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7998 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8003 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8008 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8012 cd write (2,*) iii,gcorr_loc(iii)
8015 cd write (2,*) 'ekont',ekont
8016 cd write (iout,*) 'eello4',ekont*eel4
8019 C---------------------------------------------------------------------------
8020 double precision function eello5(i,j,k,l,jj,kk)
8021 implicit real*8 (a-h,o-z)
8022 include 'DIMENSIONS'
8023 include 'COMMON.IOUNITS'
8024 include 'COMMON.CHAIN'
8025 include 'COMMON.DERIV'
8026 include 'COMMON.INTERACT'
8027 include 'COMMON.CONTACTS'
8028 include 'COMMON.TORSION'
8029 include 'COMMON.VAR'
8030 include 'COMMON.GEO'
8031 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8032 double precision ggg1(3),ggg2(3)
8033 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8038 C /l\ / \ \ / \ / \ / C
8039 C / \ / \ \ / \ / \ / C
8040 C j| o |l1 | o | o| o | | o |o C
8041 C \ |/k\| |/ \| / |/ \| |/ \| C
8042 C \i/ \ / \ / / \ / \ C
8044 C (I) (II) (III) (IV) C
8046 C eello5_1 eello5_2 eello5_3 eello5_4 C
8048 C Antiparallel chains C
8051 C /j\ / \ \ / \ / \ / C
8052 C / \ / \ \ / \ / \ / C
8053 C j1| o |l | o | o| o | | o |o C
8054 C \ |/k\| |/ \| / |/ \| |/ \| C
8055 C \i/ \ / \ / / \ / \ C
8057 C (I) (II) (III) (IV) C
8059 C eello5_1 eello5_2 eello5_3 eello5_4 C
8061 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8063 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8064 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8069 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8071 itk=itortyp(itype(k))
8072 itl=itortyp(itype(l))
8073 itj=itortyp(itype(j))
8078 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8079 cd & eel5_3_num,eel5_4_num)
8083 derx(lll,kkk,iii)=0.0d0
8087 cd eij=facont_hb(jj,i)
8088 cd ekl=facont_hb(kk,k)
8090 cd write (iout,*)'Contacts have occurred for peptide groups',
8091 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8093 C Contribution from the graph I.
8094 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8095 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8096 call transpose2(EUg(1,1,k),auxmat(1,1))
8097 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8098 vv(1)=pizda(1,1)-pizda(2,2)
8099 vv(2)=pizda(1,2)+pizda(2,1)
8100 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8101 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8102 C Explicit gradient in virtual-dihedral angles.
8103 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8104 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8105 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8106 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8107 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8108 vv(1)=pizda(1,1)-pizda(2,2)
8109 vv(2)=pizda(1,2)+pizda(2,1)
8110 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8111 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8112 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8113 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8114 vv(1)=pizda(1,1)-pizda(2,2)
8115 vv(2)=pizda(1,2)+pizda(2,1)
8117 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8118 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8119 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8121 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8122 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8123 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8125 C Cartesian gradient
8129 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8131 vv(1)=pizda(1,1)-pizda(2,2)
8132 vv(2)=pizda(1,2)+pizda(2,1)
8133 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8134 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8135 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8141 C Contribution from graph II
8142 call transpose2(EE(1,1,itk),auxmat(1,1))
8143 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8144 vv(1)=pizda(1,1)+pizda(2,2)
8145 vv(2)=pizda(2,1)-pizda(1,2)
8146 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
8147 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8148 C Explicit gradient in virtual-dihedral angles.
8149 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8150 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8151 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8152 vv(1)=pizda(1,1)+pizda(2,2)
8153 vv(2)=pizda(2,1)-pizda(1,2)
8155 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8156 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8157 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8159 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8160 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8161 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8163 C Cartesian gradient
8167 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8169 vv(1)=pizda(1,1)+pizda(2,2)
8170 vv(2)=pizda(2,1)-pizda(1,2)
8171 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8172 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
8173 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8181 C Parallel orientation
8182 C Contribution from graph III
8183 call transpose2(EUg(1,1,l),auxmat(1,1))
8184 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8185 vv(1)=pizda(1,1)-pizda(2,2)
8186 vv(2)=pizda(1,2)+pizda(2,1)
8187 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8188 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8189 C Explicit gradient in virtual-dihedral angles.
8190 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8191 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8192 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8193 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8194 vv(1)=pizda(1,1)-pizda(2,2)
8195 vv(2)=pizda(1,2)+pizda(2,1)
8196 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8197 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8198 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8199 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8200 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8201 vv(1)=pizda(1,1)-pizda(2,2)
8202 vv(2)=pizda(1,2)+pizda(2,1)
8203 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8204 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8205 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8206 C Cartesian gradient
8210 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8212 vv(1)=pizda(1,1)-pizda(2,2)
8213 vv(2)=pizda(1,2)+pizda(2,1)
8214 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8215 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8216 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8221 C Contribution from graph IV
8223 call transpose2(EE(1,1,itl),auxmat(1,1))
8224 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8225 vv(1)=pizda(1,1)+pizda(2,2)
8226 vv(2)=pizda(2,1)-pizda(1,2)
8227 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
8228 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8229 C Explicit gradient in virtual-dihedral angles.
8230 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8231 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8232 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8233 vv(1)=pizda(1,1)+pizda(2,2)
8234 vv(2)=pizda(2,1)-pizda(1,2)
8235 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8236 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
8237 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8238 C Cartesian gradient
8242 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8244 vv(1)=pizda(1,1)+pizda(2,2)
8245 vv(2)=pizda(2,1)-pizda(1,2)
8246 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8247 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
8248 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8253 C Antiparallel orientation
8254 C Contribution from graph III
8256 call transpose2(EUg(1,1,j),auxmat(1,1))
8257 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8258 vv(1)=pizda(1,1)-pizda(2,2)
8259 vv(2)=pizda(1,2)+pizda(2,1)
8260 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8261 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8262 C Explicit gradient in virtual-dihedral angles.
8263 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8264 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8265 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8266 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8267 vv(1)=pizda(1,1)-pizda(2,2)
8268 vv(2)=pizda(1,2)+pizda(2,1)
8269 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8270 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8271 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8272 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8273 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8274 vv(1)=pizda(1,1)-pizda(2,2)
8275 vv(2)=pizda(1,2)+pizda(2,1)
8276 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8277 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8278 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8279 C Cartesian gradient
8283 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8285 vv(1)=pizda(1,1)-pizda(2,2)
8286 vv(2)=pizda(1,2)+pizda(2,1)
8287 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8288 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8289 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8294 C Contribution from graph IV
8296 call transpose2(EE(1,1,itj),auxmat(1,1))
8297 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8298 vv(1)=pizda(1,1)+pizda(2,2)
8299 vv(2)=pizda(2,1)-pizda(1,2)
8300 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8301 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8302 C Explicit gradient in virtual-dihedral angles.
8303 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8304 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8305 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8306 vv(1)=pizda(1,1)+pizda(2,2)
8307 vv(2)=pizda(2,1)-pizda(1,2)
8308 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8309 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8310 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8311 C Cartesian gradient
8315 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8317 vv(1)=pizda(1,1)+pizda(2,2)
8318 vv(2)=pizda(2,1)-pizda(1,2)
8319 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8320 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8321 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8327 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8328 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8329 cd write (2,*) 'ijkl',i,j,k,l
8330 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8331 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8333 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8334 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8335 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8336 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8337 if (j.lt.nres-1) then
8344 if (l.lt.nres-1) then
8354 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8355 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8356 C summed up outside the subrouine as for the other subroutines
8357 C handling long-range interactions. The old code is commented out
8358 C with "cgrad" to keep track of changes.
8360 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8361 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8362 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8363 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8364 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8365 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8366 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8367 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8368 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8369 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8371 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8372 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8373 cgrad ghalf=0.5d0*ggg1(ll)
8375 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8376 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8377 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8378 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8379 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8380 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8381 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8382 cgrad ghalf=0.5d0*ggg2(ll)
8384 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8385 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8386 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8387 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8388 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8389 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8394 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8395 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8400 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8401 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8407 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8412 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8416 cd write (2,*) iii,g_corr5_loc(iii)
8419 cd write (2,*) 'ekont',ekont
8420 cd write (iout,*) 'eello5',ekont*eel5
8423 c--------------------------------------------------------------------------
8424 double precision function eello6(i,j,k,l,jj,kk)
8425 implicit real*8 (a-h,o-z)
8426 include 'DIMENSIONS'
8427 include 'COMMON.IOUNITS'
8428 include 'COMMON.CHAIN'
8429 include 'COMMON.DERIV'
8430 include 'COMMON.INTERACT'
8431 include 'COMMON.CONTACTS'
8432 include 'COMMON.TORSION'
8433 include 'COMMON.VAR'
8434 include 'COMMON.GEO'
8435 include 'COMMON.FFIELD'
8436 double precision ggg1(3),ggg2(3)
8437 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8442 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8450 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8451 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8455 derx(lll,kkk,iii)=0.0d0
8459 cd eij=facont_hb(jj,i)
8460 cd ekl=facont_hb(kk,k)
8466 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8467 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8468 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8469 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8470 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8471 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8473 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8474 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8475 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8476 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8477 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8478 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8482 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8484 C If turn contributions are considered, they will be handled separately.
8485 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8486 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8487 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8488 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8489 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8490 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8491 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8493 if (j.lt.nres-1) then
8500 if (l.lt.nres-1) then
8508 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8509 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8510 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8511 cgrad ghalf=0.5d0*ggg1(ll)
8513 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8514 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8515 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8516 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8517 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8518 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8519 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8520 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8521 cgrad ghalf=0.5d0*ggg2(ll)
8522 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8524 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8525 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8526 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8527 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8528 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8529 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8534 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8535 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8540 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8541 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8547 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8552 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8556 cd write (2,*) iii,g_corr6_loc(iii)
8559 cd write (2,*) 'ekont',ekont
8560 cd write (iout,*) 'eello6',ekont*eel6
8563 c--------------------------------------------------------------------------
8564 double precision function eello6_graph1(i,j,k,l,imat,swap)
8565 implicit real*8 (a-h,o-z)
8566 include 'DIMENSIONS'
8567 include 'COMMON.IOUNITS'
8568 include 'COMMON.CHAIN'
8569 include 'COMMON.DERIV'
8570 include 'COMMON.INTERACT'
8571 include 'COMMON.CONTACTS'
8572 include 'COMMON.TORSION'
8573 include 'COMMON.VAR'
8574 include 'COMMON.GEO'
8575 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8579 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8581 C Parallel Antiparallel C
8587 C \ j|/k\| / \ |/k\|l / C
8592 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8593 itk=itortyp(itype(k))
8594 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8595 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8596 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8597 call transpose2(EUgC(1,1,k),auxmat(1,1))
8598 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8599 vv1(1)=pizda1(1,1)-pizda1(2,2)
8600 vv1(2)=pizda1(1,2)+pizda1(2,1)
8601 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8602 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8603 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8604 s5=scalar2(vv(1),Dtobr2(1,i))
8605 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8606 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8607 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8608 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8609 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8610 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8611 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8612 & +scalar2(vv(1),Dtobr2der(1,i)))
8613 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8614 vv1(1)=pizda1(1,1)-pizda1(2,2)
8615 vv1(2)=pizda1(1,2)+pizda1(2,1)
8616 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8617 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8619 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8620 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8621 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8622 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8623 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8625 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8626 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8627 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8628 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8629 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8631 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8632 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8633 vv1(1)=pizda1(1,1)-pizda1(2,2)
8634 vv1(2)=pizda1(1,2)+pizda1(2,1)
8635 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8636 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8637 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8638 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8647 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8648 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8649 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8650 call transpose2(EUgC(1,1,k),auxmat(1,1))
8651 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8653 vv1(1)=pizda1(1,1)-pizda1(2,2)
8654 vv1(2)=pizda1(1,2)+pizda1(2,1)
8655 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8656 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8657 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8658 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8659 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8660 s5=scalar2(vv(1),Dtobr2(1,i))
8661 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8667 c----------------------------------------------------------------------------
8668 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8669 implicit real*8 (a-h,o-z)
8670 include 'DIMENSIONS'
8671 include 'COMMON.IOUNITS'
8672 include 'COMMON.CHAIN'
8673 include 'COMMON.DERIV'
8674 include 'COMMON.INTERACT'
8675 include 'COMMON.CONTACTS'
8676 include 'COMMON.TORSION'
8677 include 'COMMON.VAR'
8678 include 'COMMON.GEO'
8680 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8681 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8684 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8686 C Parallel Antiparallel C
8692 C \ j|/k\| \ |/k\|l C
8697 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8698 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8699 C AL 7/4/01 s1 would occur in the sixth-order moment,
8700 C but not in a cluster cumulant
8702 s1=dip(1,jj,i)*dip(1,kk,k)
8704 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8705 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8706 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8707 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8708 call transpose2(EUg(1,1,k),auxmat(1,1))
8709 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8710 vv(1)=pizda(1,1)-pizda(2,2)
8711 vv(2)=pizda(1,2)+pizda(2,1)
8712 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8713 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8715 eello6_graph2=-(s1+s2+s3+s4)
8717 eello6_graph2=-(s2+s3+s4)
8720 C Derivatives in gamma(i-1)
8723 s1=dipderg(1,jj,i)*dip(1,kk,k)
8725 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8726 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8727 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8728 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8730 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8732 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8734 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8736 C Derivatives in gamma(k-1)
8738 s1=dip(1,jj,i)*dipderg(1,kk,k)
8740 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8741 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8742 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8743 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8744 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8745 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8746 vv(1)=pizda(1,1)-pizda(2,2)
8747 vv(2)=pizda(1,2)+pizda(2,1)
8748 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8750 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8752 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8754 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8755 C Derivatives in gamma(j-1) or gamma(l-1)
8758 s1=dipderg(3,jj,i)*dip(1,kk,k)
8760 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8761 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8762 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8763 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8764 vv(1)=pizda(1,1)-pizda(2,2)
8765 vv(2)=pizda(1,2)+pizda(2,1)
8766 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8769 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8771 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8774 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8775 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8777 C Derivatives in gamma(l-1) or gamma(j-1)
8780 s1=dip(1,jj,i)*dipderg(3,kk,k)
8782 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8783 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8784 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8785 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8786 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8787 vv(1)=pizda(1,1)-pizda(2,2)
8788 vv(2)=pizda(1,2)+pizda(2,1)
8789 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8792 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8794 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8797 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8798 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8800 C Cartesian derivatives.
8802 write (2,*) 'In eello6_graph2'
8804 write (2,*) 'iii=',iii
8806 write (2,*) 'kkk=',kkk
8808 write (2,'(3(2f10.5),5x)')
8809 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8819 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8821 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8824 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8826 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8827 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8829 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8830 call transpose2(EUg(1,1,k),auxmat(1,1))
8831 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8833 vv(1)=pizda(1,1)-pizda(2,2)
8834 vv(2)=pizda(1,2)+pizda(2,1)
8835 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8836 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8838 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8840 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8843 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8845 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8852 c----------------------------------------------------------------------------
8853 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8854 implicit real*8 (a-h,o-z)
8855 include 'DIMENSIONS'
8856 include 'COMMON.IOUNITS'
8857 include 'COMMON.CHAIN'
8858 include 'COMMON.DERIV'
8859 include 'COMMON.INTERACT'
8860 include 'COMMON.CONTACTS'
8861 include 'COMMON.TORSION'
8862 include 'COMMON.VAR'
8863 include 'COMMON.GEO'
8864 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8866 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8868 C Parallel Antiparallel C
8874 C j|/k\| / |/k\|l / C
8879 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8881 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8882 C energy moment and not to the cluster cumulant.
8883 iti=itortyp(itype(i))
8884 if (j.lt.nres-1) then
8885 itj1=itortyp(itype(j+1))
8889 itk=itortyp(itype(k))
8890 itk1=itortyp(itype(k+1))
8891 if (l.lt.nres-1) then
8892 itl1=itortyp(itype(l+1))
8897 s1=dip(4,jj,i)*dip(4,kk,k)
8899 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8900 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8901 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8902 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8903 call transpose2(EE(1,1,itk),auxmat(1,1))
8904 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8905 vv(1)=pizda(1,1)+pizda(2,2)
8906 vv(2)=pizda(2,1)-pizda(1,2)
8907 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8908 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8909 cd & "sum",-(s2+s3+s4)
8911 eello6_graph3=-(s1+s2+s3+s4)
8913 eello6_graph3=-(s2+s3+s4)
8916 C Derivatives in gamma(k-1)
8917 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8918 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8919 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8920 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8921 C Derivatives in gamma(l-1)
8922 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8923 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8924 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8925 vv(1)=pizda(1,1)+pizda(2,2)
8926 vv(2)=pizda(2,1)-pizda(1,2)
8927 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8928 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8929 C Cartesian derivatives.
8935 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8937 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8940 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8942 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8943 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8945 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8946 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8948 vv(1)=pizda(1,1)+pizda(2,2)
8949 vv(2)=pizda(2,1)-pizda(1,2)
8950 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8952 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8954 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8957 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8959 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8961 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8967 c----------------------------------------------------------------------------
8968 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8969 implicit real*8 (a-h,o-z)
8970 include 'DIMENSIONS'
8971 include 'COMMON.IOUNITS'
8972 include 'COMMON.CHAIN'
8973 include 'COMMON.DERIV'
8974 include 'COMMON.INTERACT'
8975 include 'COMMON.CONTACTS'
8976 include 'COMMON.TORSION'
8977 include 'COMMON.VAR'
8978 include 'COMMON.GEO'
8979 include 'COMMON.FFIELD'
8980 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8981 & auxvec1(2),auxmat1(2,2)
8983 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8985 C Parallel Antiparallel C
8991 C \ j|/k\| \ |/k\|l C
8996 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8998 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8999 C energy moment and not to the cluster cumulant.
9000 cd write (2,*) 'eello_graph4: wturn6',wturn6
9001 iti=itortyp(itype(i))
9002 itj=itortyp(itype(j))
9003 if (j.lt.nres-1) then
9004 itj1=itortyp(itype(j+1))
9008 itk=itortyp(itype(k))
9009 if (k.lt.nres-1) then
9010 itk1=itortyp(itype(k+1))
9014 itl=itortyp(itype(l))
9015 if (l.lt.nres-1) then
9016 itl1=itortyp(itype(l+1))
9020 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9021 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9022 cd & ' itl',itl,' itl1',itl1
9025 s1=dip(3,jj,i)*dip(3,kk,k)
9027 s1=dip(2,jj,j)*dip(2,kk,l)
9030 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9031 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9033 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9034 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9036 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9037 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9039 call transpose2(EUg(1,1,k),auxmat(1,1))
9040 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9041 vv(1)=pizda(1,1)-pizda(2,2)
9042 vv(2)=pizda(2,1)+pizda(1,2)
9043 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9044 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9046 eello6_graph4=-(s1+s2+s3+s4)
9048 eello6_graph4=-(s2+s3+s4)
9050 C Derivatives in gamma(i-1)
9054 s1=dipderg(2,jj,i)*dip(3,kk,k)
9056 s1=dipderg(4,jj,j)*dip(2,kk,l)
9059 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9061 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9062 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9064 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9065 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9067 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9068 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9069 cd write (2,*) 'turn6 derivatives'
9071 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9073 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9077 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9079 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9083 C Derivatives in gamma(k-1)
9086 s1=dip(3,jj,i)*dipderg(2,kk,k)
9088 s1=dip(2,jj,j)*dipderg(4,kk,l)
9091 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9092 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9094 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9095 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9097 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9098 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9100 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9101 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9102 vv(1)=pizda(1,1)-pizda(2,2)
9103 vv(2)=pizda(2,1)+pizda(1,2)
9104 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9105 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9107 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9109 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9113 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9115 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9118 C Derivatives in gamma(j-1) or gamma(l-1)
9119 if (l.eq.j+1 .and. l.gt.1) then
9120 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9121 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9122 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9123 vv(1)=pizda(1,1)-pizda(2,2)
9124 vv(2)=pizda(2,1)+pizda(1,2)
9125 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9126 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9127 else if (j.gt.1) then
9128 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9129 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9130 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9131 vv(1)=pizda(1,1)-pizda(2,2)
9132 vv(2)=pizda(2,1)+pizda(1,2)
9133 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9134 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9135 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9137 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9140 C Cartesian derivatives.
9147 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9149 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9153 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9155 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9159 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9161 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9163 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9164 & b1(1,itj1),auxvec(1))
9165 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9167 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9168 & b1(1,itl1),auxvec(1))
9169 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9171 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9173 vv(1)=pizda(1,1)-pizda(2,2)
9174 vv(2)=pizda(2,1)+pizda(1,2)
9175 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9177 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9179 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9182 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9185 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9188 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9190 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9192 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9196 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9198 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9201 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9203 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9211 c----------------------------------------------------------------------------
9212 double precision function eello_turn6(i,jj,kk)
9213 implicit real*8 (a-h,o-z)
9214 include 'DIMENSIONS'
9215 include 'COMMON.IOUNITS'
9216 include 'COMMON.CHAIN'
9217 include 'COMMON.DERIV'
9218 include 'COMMON.INTERACT'
9219 include 'COMMON.CONTACTS'
9220 include 'COMMON.TORSION'
9221 include 'COMMON.VAR'
9222 include 'COMMON.GEO'
9223 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9224 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9226 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9227 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9228 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9229 C the respective energy moment and not to the cluster cumulant.
9238 iti=itortyp(itype(i))
9239 itk=itortyp(itype(k))
9240 itk1=itortyp(itype(k+1))
9241 itl=itortyp(itype(l))
9242 itj=itortyp(itype(j))
9243 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9244 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9245 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9250 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9252 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9256 derx_turn(lll,kkk,iii)=0.0d0
9263 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9265 cd write (2,*) 'eello6_5',eello6_5
9267 call transpose2(AEA(1,1,1),auxmat(1,1))
9268 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9269 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9270 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9272 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9273 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9274 s2 = scalar2(b1(1,itk),vtemp1(1))
9276 call transpose2(AEA(1,1,2),atemp(1,1))
9277 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9278 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9279 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9281 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9282 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9283 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9285 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9286 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9287 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9288 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9289 ss13 = scalar2(b1(1,itk),vtemp4(1))
9290 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9292 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9298 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9299 C Derivatives in gamma(i+2)
9303 call transpose2(AEA(1,1,1),auxmatd(1,1))
9304 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9305 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9306 call transpose2(AEAderg(1,1,2),atempd(1,1))
9307 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9308 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9310 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9311 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9312 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9318 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9319 C Derivatives in gamma(i+3)
9321 call transpose2(AEA(1,1,1),auxmatd(1,1))
9322 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9323 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9324 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9326 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9327 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9328 s2d = scalar2(b1(1,itk),vtemp1d(1))
9330 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9331 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9333 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9335 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9336 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9337 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9345 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9346 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9348 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9349 & -0.5d0*ekont*(s2d+s12d)
9351 C Derivatives in gamma(i+4)
9352 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9353 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9354 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9356 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9357 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9358 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9366 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9368 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9370 C Derivatives in gamma(i+5)
9372 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9373 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9374 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9376 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9377 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9378 s2d = scalar2(b1(1,itk),vtemp1d(1))
9380 call transpose2(AEA(1,1,2),atempd(1,1))
9381 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9382 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9384 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9385 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9387 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9388 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9389 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9397 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9398 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9400 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9401 & -0.5d0*ekont*(s2d+s12d)
9403 C Cartesian derivatives
9408 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9409 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9410 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9412 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9413 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9415 s2d = scalar2(b1(1,itk),vtemp1d(1))
9417 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9418 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9419 s8d = -(atempd(1,1)+atempd(2,2))*
9420 & scalar2(cc(1,1,itl),vtemp2(1))
9422 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9424 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9425 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9432 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9435 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9439 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9440 & - 0.5d0*(s8d+s12d)
9442 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9451 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9453 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9454 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9455 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9456 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9457 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9459 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9460 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9461 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9465 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9466 cd & 16*eel_turn6_num
9468 if (j.lt.nres-1) then
9475 if (l.lt.nres-1) then
9483 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9484 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9485 cgrad ghalf=0.5d0*ggg1(ll)
9487 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9488 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9489 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9490 & +ekont*derx_turn(ll,2,1)
9491 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9492 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9493 & +ekont*derx_turn(ll,4,1)
9494 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9495 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9496 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9497 cgrad ghalf=0.5d0*ggg2(ll)
9499 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9500 & +ekont*derx_turn(ll,2,2)
9501 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9502 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9503 & +ekont*derx_turn(ll,4,2)
9504 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9505 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9506 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9511 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9516 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9522 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9527 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9531 cd write (2,*) iii,g_corr6_loc(iii)
9533 eello_turn6=ekont*eel_turn6
9534 cd write (2,*) 'ekont',ekont
9535 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9539 C-----------------------------------------------------------------------------
9540 double precision function scalar(u,v)
9541 !DIR$ INLINEALWAYS scalar
9543 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9546 double precision u(3),v(3)
9547 cd double precision sc
9555 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9558 crc-------------------------------------------------
9559 SUBROUTINE MATVEC2(A1,V1,V2)
9560 !DIR$ INLINEALWAYS MATVEC2
9562 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9564 implicit real*8 (a-h,o-z)
9565 include 'DIMENSIONS'
9566 DIMENSION A1(2,2),V1(2),V2(2)
9570 c 3 VI=VI+A1(I,K)*V1(K)
9574 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9575 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9580 C---------------------------------------
9581 SUBROUTINE MATMAT2(A1,A2,A3)
9583 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9585 implicit real*8 (a-h,o-z)
9586 include 'DIMENSIONS'
9587 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9588 c DIMENSION AI3(2,2)
9592 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9598 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9599 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9600 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9601 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9609 c-------------------------------------------------------------------------
9610 double precision function scalar2(u,v)
9611 !DIR$ INLINEALWAYS scalar2
9613 double precision u(2),v(2)
9616 scalar2=u(1)*v(1)+u(2)*v(2)
9620 C-----------------------------------------------------------------------------
9622 subroutine transpose2(a,at)
9623 !DIR$ INLINEALWAYS transpose2
9625 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9628 double precision a(2,2),at(2,2)
9635 c--------------------------------------------------------------------------
9636 subroutine transpose(n,a,at)
9639 double precision a(n,n),at(n,n)
9647 C---------------------------------------------------------------------------
9648 subroutine prodmat3(a1,a2,kk,transp,prod)
9649 !DIR$ INLINEALWAYS prodmat3
9651 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9655 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9657 crc double precision auxmat(2,2),prod_(2,2)
9660 crc call transpose2(kk(1,1),auxmat(1,1))
9661 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9662 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9664 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9665 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9666 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9667 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9668 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9669 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9670 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9671 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9674 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9675 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9677 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9678 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9679 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9680 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9681 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9682 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9683 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9684 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9687 c call transpose2(a2(1,1),a2t(1,1))
9690 crc print *,((prod_(i,j),i=1,2),j=1,2)
9691 crc print *,((prod(i,j),i=1,2),j=1,2)
9695 CCC----------------------------------------------
9696 subroutine Eliptransfer(eliptran)
9697 implicit real*8 (a-h,o-z)
9698 include 'DIMENSIONS'
9699 include 'COMMON.GEO'
9700 include 'COMMON.VAR'
9701 include 'COMMON.LOCAL'
9702 include 'COMMON.CHAIN'
9703 include 'COMMON.DERIV'
9704 include 'COMMON.NAMES'
9705 include 'COMMON.INTERACT'
9706 include 'COMMON.IOUNITS'
9707 include 'COMMON.CALC'
9708 include 'COMMON.CONTROL'
9709 include 'COMMON.SPLITELE'
9710 include 'COMMON.SBRIDGE'
9714 C--bordliptop-- buffore starts
9715 C--bufliptop--- here true lipid starts
9717 C--buflipbot--- lipid ends buffore starts
9718 C--bordlipbot--buffore ends
9720 do i=ilip_start,ilip_end
9721 if (itype(i).eq.ntyp1) cycle
9723 positi=(mod((c(3,i)+c(3,i+1)),boxzsize))
9724 if (positi.le.0) positi=positi+boxzsize
9726 C first for peptide groups
9727 c for each residue check if it is in lipid or lipid water border area
9728 if ((positi.gt.bordlipbot)
9729 &.and.(positi.lt.bordliptop)) then
9730 C the energy transfer exist
9731 if (positi.lt.buflipbot) then
9732 C what fraction I am in
9734 & ((positi-bordlipbot)/lipbufthick)
9735 C lipbufthick is thickenes of lipid buffore
9736 sslip=sscalelip(fracinbuf)
9737 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9738 eliptran=eliptran+sslip*pepliptran
9739 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0
9740 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0
9741 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9743 C print *,"doing sccale for lower part"
9744 elseif (positi.gt.bufliptop) then
9745 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
9746 sslip=sscalelip(fracinbuf)
9747 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9748 eliptran=eliptran+sslip*pepliptran
9749 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9750 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9751 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9752 print *, "doing sscalefor top part"
9754 eliptran=eliptran+pepliptran
9755 print *,"I am in true lipid"
9758 C eliptran=elpitran+0.0 ! I am in water
9761 C print *, "nic nie bylo w lipidzie?"
9762 C now multiply all by the peptide group transfer factor
9763 C eliptran=eliptran*pepliptran
9764 C now the same for side chains
9765 do i=ilip_start,ilip_end
9766 if (itype(i).eq.ntyp1) cycle
9767 positi=(mod(c(3,i+nres),boxzsize))
9768 if (positi.le.0) positi=positi+boxzsize
9769 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9770 c for each residue check if it is in lipid or lipid water border area
9771 C respos=mod(c(3,i+nres),boxzsize)
9772 if ((positi.gt.bordlipbot)
9773 & .and.(positi.lt.bordliptop)) then
9774 C the energy transfer exist
9775 if (positi.lt.buflipbot) then
9777 & ((positi-bordlipbot)/lipbufthick)
9778 C lipbufthick is thickenes of lipid buffore
9779 sslip=sscalelip(fracinbuf)
9780 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9781 eliptran=eliptran+sslip*liptranene(itype(i))
9782 gliptranx(3,i)=gliptranx(3,i)
9783 &+ssgradlip*liptranene(itype(i))/2.0d0
9785 &+ssgradlip*liptranene(itype(i))
9786 print *,"doing sccale for lower part"
9787 elseif (positi.gt.bufliptop) then
9789 &((bordliptop-positi)/lipbufthick)
9790 sslip=sscalelip(fracinbuf)
9791 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9792 eliptran=eliptran+sslip*liptranene(itype(i))
9793 gliptranx(3,i)=gliptranx(3,i)
9794 &+ssgradlip*liptranene(itype(i))/2.0d0
9796 &+ssgradlip*liptranene(itype(i))
9797 print *, "doing sscalefor top part",sslip,fracinbuf
9799 eliptran=eliptran+liptranene(itype(i))
9800 print *,"I am in true lipid"
9802 endif ! if in lipid or buffor
9804 C eliptran=elpitran+0.0 ! I am in water