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
103 goto (101,102,103,104,105,106) ipot
104 C Lennard-Jones potential.
106 cd print '(a)','Exit ELJ'
108 C Lennard-Jones-Kihara potential (shifted).
111 C Berne-Pechukas potential (dilated LJ, angular dependence).
114 C Gay-Berne potential (shifted LJ, angular dependence).
116 C print *,"bylem w egb"
118 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
121 C Soft-sphere potential
122 106 call e_softsphere(evdw)
124 C Calculate electrostatic (H-bonding) energy of the main chain.
128 cmc Sep-06: egb takes care of dynamic ss bonds too
130 c if (dyn_ss) call dyn_set_nss
132 c print *,"Processor",myrank," computed USCSC"
138 time_vec=time_vec+MPI_Wtime()-time01
140 c print *,"Processor",myrank," left VEC_AND_DERIV"
143 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
144 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
145 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
146 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
148 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
149 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
150 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
151 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
153 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
162 write (iout,*) "Soft-spheer ELEC potential"
163 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
166 c print *,"Processor",myrank," computed UELEC"
168 C Calculate excluded-volume interaction energy between peptide groups
173 call escp(evdw2,evdw2_14)
179 c write (iout,*) "Soft-sphere SCP potential"
180 call escp_soft_sphere(evdw2,evdw2_14)
183 c Calculate the bond-stretching energy
187 C Calculate the disulfide-bridge and other energy and the contributions
188 C from other distance constraints.
189 cd print *,'Calling EHPB'
191 cd print *,'EHPB exitted succesfully.'
193 C Calculate the virtual-bond-angle energy.
195 if (wang.gt.0d0) then
200 c print *,"Processor",myrank," computed UB"
202 C Calculate the SC local energy.
204 C print *,"TU DOCHODZE?"
206 c print *,"Processor",myrank," computed USC"
208 C Calculate the virtual-bond torsional energy.
210 cd print *,'nterm=',nterm
212 call etor(etors,edihcnstr)
217 c print *,"Processor",myrank," computed Utor"
219 C 6/23/01 Calculate double-torsional energy
221 if (wtor_d.gt.0) then
226 c print *,"Processor",myrank," computed Utord"
228 C 21/5/07 Calculate local sicdechain correlation energy
230 if (wsccor.gt.0.0d0) then
231 call eback_sc_corr(esccor)
235 C print *,"PRZED MULIt"
236 c print *,"Processor",myrank," computed Usccorr"
238 C 12/1/95 Multi-body terms
242 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
243 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
244 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
245 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
246 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
253 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
254 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
255 cd write (iout,*) "multibody_hb ecorr",ecorr
257 c print *,"Processor",myrank," computed Ucorr"
259 C If performing constraint dynamics, call the constraint energy
260 C after the equilibration time
261 if(usampl.and.totT.gt.eq_time) then
268 C 01/27/2015 added by adasko
269 C the energy component below is energy transfer into lipid environment
270 C based on partition function
271 C print *,"przed lipidami"
272 if (wliptran.gt.0) then
273 call Eliptransfer(eliptran)
275 C print *,"za lipidami"
277 time_enecalc=time_enecalc+MPI_Wtime()-time00
279 c print *,"Processor",myrank," computed Uconstr"
288 energia(2)=evdw2-evdw2_14
305 energia(8)=eello_turn3
306 energia(9)=eello_turn4
313 energia(19)=edihcnstr
315 energia(20)=Uconst+Uconst_back
318 c Here are the energies showed per procesor if the are more processors
319 c per molecule then we sum it up in sum_energy subroutine
320 c print *," Processor",myrank," calls SUM_ENERGY"
321 call sum_energy(energia,.true.)
322 if (dyn_ss) call dyn_set_nss
323 c print *," Processor",myrank," left SUM_ENERGY"
325 time_sumene=time_sumene+MPI_Wtime()-time00
329 c-------------------------------------------------------------------------------
330 subroutine sum_energy(energia,reduce)
331 implicit real*8 (a-h,o-z)
336 cMS$ATTRIBUTES C :: proc_proc
342 include 'COMMON.SETUP'
343 include 'COMMON.IOUNITS'
344 double precision energia(0:n_ene),enebuff(0:n_ene+1)
345 include 'COMMON.FFIELD'
346 include 'COMMON.DERIV'
347 include 'COMMON.INTERACT'
348 include 'COMMON.SBRIDGE'
349 include 'COMMON.CHAIN'
351 include 'COMMON.CONTROL'
352 include 'COMMON.TIME1'
355 if (nfgtasks.gt.1 .and. reduce) then
357 write (iout,*) "energies before REDUCE"
358 call enerprint(energia)
362 enebuff(i)=energia(i)
365 call MPI_Barrier(FG_COMM,IERR)
366 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
368 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
369 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
371 write (iout,*) "energies after REDUCE"
372 call enerprint(energia)
375 time_Reduce=time_Reduce+MPI_Wtime()-time00
377 if (fg_rank.eq.0) then
381 evdw2=energia(2)+energia(18)
397 eello_turn3=energia(8)
398 eello_turn4=energia(9)
405 edihcnstr=energia(19)
411 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
412 & +wang*ebe+wtor*etors+wscloc*escloc
413 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
414 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
415 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
416 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
418 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
419 & +wang*ebe+wtor*etors+wscloc*escloc
420 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
421 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
422 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
423 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
429 if (isnan(etot).ne.0) energia(0)=1.0d+99
431 if (isnan(etot)) energia(0)=1.0d+99
436 idumm=proc_proc(etot,i)
438 call proc_proc(etot,i)
440 if(i.eq.1)energia(0)=1.0d+99
447 c-------------------------------------------------------------------------------
448 subroutine sum_gradient
449 implicit real*8 (a-h,o-z)
454 cMS$ATTRIBUTES C :: proc_proc
460 double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
461 & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
462 & ,gloc_scbuf(3,-1:maxres)
463 include 'COMMON.SETUP'
464 include 'COMMON.IOUNITS'
465 include 'COMMON.FFIELD'
466 include 'COMMON.DERIV'
467 include 'COMMON.INTERACT'
468 include 'COMMON.SBRIDGE'
469 include 'COMMON.CHAIN'
471 include 'COMMON.CONTROL'
472 include 'COMMON.TIME1'
473 include 'COMMON.MAXGRAD'
474 include 'COMMON.SCCOR'
479 write (iout,*) "sum_gradient gvdwc, gvdwx"
481 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
482 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
487 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
488 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
489 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
492 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
493 C in virtual-bond-vector coordinates
496 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
498 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
499 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
501 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
503 c write (iout,'(i5,3f10.5,2x,f10.5)')
504 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
506 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
508 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
509 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
517 gradbufc(j,i)=wsc*gvdwc(j,i)+
518 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
519 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
520 & wel_loc*gel_loc_long(j,i)+
521 & wcorr*gradcorr_long(j,i)+
522 & wcorr5*gradcorr5_long(j,i)+
523 & wcorr6*gradcorr6_long(j,i)+
524 & wturn6*gcorr6_turn_long(j,i)+
526 & +wliptran*gliptranc(j,i)
533 gradbufc(j,i)=wsc*gvdwc(j,i)+
534 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
535 & welec*gelc_long(j,i)+
537 & wel_loc*gel_loc_long(j,i)+
538 & wcorr*gradcorr_long(j,i)+
539 & wcorr5*gradcorr5_long(j,i)+
540 & wcorr6*gradcorr6_long(j,i)+
541 & wturn6*gcorr6_turn_long(j,i)+
543 & +wliptran*gliptranc(j,i)
548 if (nfgtasks.gt.1) then
551 write (iout,*) "gradbufc before allreduce"
553 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
559 gradbufc_sum(j,i)=gradbufc(j,i)
562 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
563 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
564 c time_reduce=time_reduce+MPI_Wtime()-time00
566 c write (iout,*) "gradbufc_sum after allreduce"
568 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
573 c time_allreduce=time_allreduce+MPI_Wtime()-time00
581 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
582 write (iout,*) (i," jgrad_start",jgrad_start(i),
583 & " jgrad_end ",jgrad_end(i),
584 & i=igrad_start,igrad_end)
587 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
588 c do not parallelize this part.
590 c do i=igrad_start,igrad_end
591 c do j=jgrad_start(i),jgrad_end(i)
593 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
598 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
602 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
606 write (iout,*) "gradbufc after summing"
608 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
615 write (iout,*) "gradbufc"
617 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
623 gradbufc_sum(j,i)=gradbufc(j,i)
628 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
632 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
637 c gradbufc(k,i)=0.0d0
641 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
646 write (iout,*) "gradbufc after summing"
648 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
656 gradbufc(k,nres)=0.0d0
661 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
662 & wel_loc*gel_loc(j,i)+
663 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
664 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
665 & wel_loc*gel_loc_long(j,i)+
666 & wcorr*gradcorr_long(j,i)+
667 & wcorr5*gradcorr5_long(j,i)+
668 & wcorr6*gradcorr6_long(j,i)+
669 & wturn6*gcorr6_turn_long(j,i))+
671 & wcorr*gradcorr(j,i)+
672 & wturn3*gcorr3_turn(j,i)+
673 & wturn4*gcorr4_turn(j,i)+
674 & wcorr5*gradcorr5(j,i)+
675 & wcorr6*gradcorr6(j,i)+
676 & wturn6*gcorr6_turn(j,i)+
677 & wsccor*gsccorc(j,i)
678 & +wscloc*gscloc(j,i)
679 & +wliptran*gliptranc(j,i)
681 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
682 & wel_loc*gel_loc(j,i)+
683 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
684 & welec*gelc_long(j,i)
685 & wel_loc*gel_loc_long(j,i)+
686 & wcorr*gcorr_long(j,i)+
687 & wcorr5*gradcorr5_long(j,i)+
688 & wcorr6*gradcorr6_long(j,i)+
689 & wturn6*gcorr6_turn_long(j,i))+
691 & wcorr*gradcorr(j,i)+
692 & wturn3*gcorr3_turn(j,i)+
693 & wturn4*gcorr4_turn(j,i)+
694 & wcorr5*gradcorr5(j,i)+
695 & wcorr6*gradcorr6(j,i)+
696 & wturn6*gcorr6_turn(j,i)+
697 & wsccor*gsccorc(j,i)
698 & +wscloc*gscloc(j,i)
699 & +wliptran*gliptranc(j,i)
701 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
703 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
704 & wsccor*gsccorx(j,i)
705 & +wscloc*gsclocx(j,i)
706 & +wliptran*gliptranx(j,i)
710 write (iout,*) "gloc before adding corr"
712 write (iout,*) i,gloc(i,icg)
716 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
717 & +wcorr5*g_corr5_loc(i)
718 & +wcorr6*g_corr6_loc(i)
719 & +wturn4*gel_loc_turn4(i)
720 & +wturn3*gel_loc_turn3(i)
721 & +wturn6*gel_loc_turn6(i)
722 & +wel_loc*gel_loc_loc(i)
725 write (iout,*) "gloc after adding corr"
727 write (iout,*) i,gloc(i,icg)
731 if (nfgtasks.gt.1) then
734 gradbufc(j,i)=gradc(j,i,icg)
735 gradbufx(j,i)=gradx(j,i,icg)
739 glocbuf(i)=gloc(i,icg)
743 write (iout,*) "gloc_sc before reduce"
746 write (iout,*) i,j,gloc_sc(j,i,icg)
753 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
757 call MPI_Barrier(FG_COMM,IERR)
758 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
760 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
761 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
762 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
763 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
764 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
765 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
766 time_reduce=time_reduce+MPI_Wtime()-time00
767 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
768 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
769 time_reduce=time_reduce+MPI_Wtime()-time00
772 write (iout,*) "gloc_sc after reduce"
775 write (iout,*) i,j,gloc_sc(j,i,icg)
781 write (iout,*) "gloc after reduce"
783 write (iout,*) i,gloc(i,icg)
788 if (gnorm_check) then
790 c Compute the maximum elements of the gradient
800 gcorr3_turn_max=0.0d0
801 gcorr4_turn_max=0.0d0
804 gcorr6_turn_max=0.0d0
814 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
815 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
816 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
817 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
818 & gvdwc_scp_max=gvdwc_scp_norm
819 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
820 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
821 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
822 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
823 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
824 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
825 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
826 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
827 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
828 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
829 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
830 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
831 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
833 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
834 & gcorr3_turn_max=gcorr3_turn_norm
835 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
837 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
838 & gcorr4_turn_max=gcorr4_turn_norm
839 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
840 if (gradcorr5_norm.gt.gradcorr5_max)
841 & gradcorr5_max=gradcorr5_norm
842 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
843 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
844 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
846 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
847 & gcorr6_turn_max=gcorr6_turn_norm
848 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
849 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
850 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
851 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
852 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
853 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
854 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
855 if (gradx_scp_norm.gt.gradx_scp_max)
856 & gradx_scp_max=gradx_scp_norm
857 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
858 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
859 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
860 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
861 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
862 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
863 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
864 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
868 open(istat,file=statname,position="append")
870 open(istat,file=statname,access="append")
872 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
873 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
874 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
875 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
876 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
877 & gsccorx_max,gsclocx_max
879 if (gvdwc_max.gt.1.0d4) then
880 write (iout,*) "gvdwc gvdwx gradb gradbx"
882 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
883 & gradb(j,i),gradbx(j,i),j=1,3)
885 call pdbout(0.0d0,'cipiszcze',iout)
891 write (iout,*) "gradc gradx gloc"
893 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
894 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
898 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
902 c-------------------------------------------------------------------------------
903 subroutine rescale_weights(t_bath)
904 implicit real*8 (a-h,o-z)
906 include 'COMMON.IOUNITS'
907 include 'COMMON.FFIELD'
908 include 'COMMON.SBRIDGE'
909 double precision kfac /2.4d0/
910 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
912 c facT=2*temp0/(t_bath+temp0)
913 if (rescale_mode.eq.0) then
919 else if (rescale_mode.eq.1) then
920 facT=kfac/(kfac-1.0d0+t_bath/temp0)
921 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
922 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
923 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
924 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
925 else if (rescale_mode.eq.2) then
931 facT=licznik/dlog(dexp(x)+dexp(-x))
932 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
933 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
934 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
935 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
937 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
938 write (*,*) "Wrong RESCALE_MODE",rescale_mode
940 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
944 welec=weights(3)*fact
945 wcorr=weights(4)*fact3
946 wcorr5=weights(5)*fact4
947 wcorr6=weights(6)*fact5
948 wel_loc=weights(7)*fact2
949 wturn3=weights(8)*fact2
950 wturn4=weights(9)*fact3
951 wturn6=weights(10)*fact5
952 wtor=weights(13)*fact
953 wtor_d=weights(14)*fact2
954 wsccor=weights(21)*fact
958 C------------------------------------------------------------------------
959 subroutine enerprint(energia)
960 implicit real*8 (a-h,o-z)
962 include 'COMMON.IOUNITS'
963 include 'COMMON.FFIELD'
964 include 'COMMON.SBRIDGE'
966 double precision energia(0:n_ene)
971 evdw2=energia(2)+energia(18)
983 eello_turn3=energia(8)
984 eello_turn4=energia(9)
985 eello_turn6=energia(10)
991 edihcnstr=energia(19)
997 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
998 & estr,wbond,ebe,wang,
999 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1001 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1002 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1003 & edihcnstr,ebr*nss,
1004 & Uconst,eliptran,wliptran,etot
1005 10 format (/'Virtual-chain energies:'//
1006 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1007 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1008 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1009 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1010 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1011 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1012 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1013 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1014 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1015 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1016 & ' (SS bridges & dist. cnstr.)'/
1017 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1018 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1019 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1020 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1021 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1022 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1023 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1024 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1025 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1026 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1027 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1028 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1029 & 'ETOT= ',1pE16.6,' (total)')
1031 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1032 & estr,wbond,ebe,wang,
1033 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1035 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1036 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1037 & ebr*nss,Uconst,eliptran,wliptran,etot
1038 10 format (/'Virtual-chain energies:'//
1039 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1040 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1041 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1042 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1043 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1044 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1045 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1046 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1047 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1048 & ' (SS bridges & dist. cnstr.)'/
1049 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1050 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1051 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1052 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1053 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1054 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1055 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1056 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1057 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1058 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1059 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1060 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1061 & 'ETOT= ',1pE16.6,' (total)')
1065 C-----------------------------------------------------------------------
1066 subroutine elj(evdw)
1068 C This subroutine calculates the interaction energy of nonbonded side chains
1069 C assuming the LJ potential of interaction.
1071 implicit real*8 (a-h,o-z)
1072 include 'DIMENSIONS'
1073 parameter (accur=1.0d-10)
1074 include 'COMMON.GEO'
1075 include 'COMMON.VAR'
1076 include 'COMMON.LOCAL'
1077 include 'COMMON.CHAIN'
1078 include 'COMMON.DERIV'
1079 include 'COMMON.INTERACT'
1080 include 'COMMON.TORSION'
1081 include 'COMMON.SBRIDGE'
1082 include 'COMMON.NAMES'
1083 include 'COMMON.IOUNITS'
1084 include 'COMMON.CONTACTS'
1086 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1088 do i=iatsc_s,iatsc_e
1089 itypi=iabs(itype(i))
1090 if (itypi.eq.ntyp1) cycle
1091 itypi1=iabs(itype(i+1))
1098 C Calculate SC interaction energy.
1100 do iint=1,nint_gr(i)
1101 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1102 cd & 'iend=',iend(i,iint)
1103 do j=istart(i,iint),iend(i,iint)
1104 itypj=iabs(itype(j))
1105 if (itypj.eq.ntyp1) cycle
1109 C Change 12/1/95 to calculate four-body interactions
1110 rij=xj*xj+yj*yj+zj*zj
1112 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1113 eps0ij=eps(itypi,itypj)
1115 C have you changed here?
1119 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1120 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1121 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1122 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1123 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1124 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1127 C Calculate the components of the gradient in DC and X
1129 fac=-rrij*(e1+evdwij)
1134 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1135 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1136 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1137 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1141 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1145 C 12/1/95, revised on 5/20/97
1147 C Calculate the contact function. The ith column of the array JCONT will
1148 C contain the numbers of atoms that make contacts with the atom I (of numbers
1149 C greater than I). The arrays FACONT and GACONT will contain the values of
1150 C the contact function and its derivative.
1152 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1153 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1154 C Uncomment next line, if the correlation interactions are contact function only
1155 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1157 sigij=sigma(itypi,itypj)
1158 r0ij=rs0(itypi,itypj)
1160 C Check whether the SC's are not too far to make a contact.
1163 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1164 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1166 if (fcont.gt.0.0D0) then
1167 C If the SC-SC distance if close to sigma, apply spline.
1168 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1169 cAdam & fcont1,fprimcont1)
1170 cAdam fcont1=1.0d0-fcont1
1171 cAdam if (fcont1.gt.0.0d0) then
1172 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1173 cAdam fcont=fcont*fcont1
1175 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1176 cga eps0ij=1.0d0/dsqrt(eps0ij)
1178 cga gg(k)=gg(k)*eps0ij
1180 cga eps0ij=-evdwij*eps0ij
1181 C Uncomment for AL's type of SC correlation interactions.
1182 cadam eps0ij=-evdwij
1183 num_conti=num_conti+1
1184 jcont(num_conti,i)=j
1185 facont(num_conti,i)=fcont*eps0ij
1186 fprimcont=eps0ij*fprimcont/rij
1188 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1189 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1190 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1191 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1192 gacont(1,num_conti,i)=-fprimcont*xj
1193 gacont(2,num_conti,i)=-fprimcont*yj
1194 gacont(3,num_conti,i)=-fprimcont*zj
1195 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1196 cd write (iout,'(2i3,3f10.5)')
1197 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1203 num_cont(i)=num_conti
1207 gvdwc(j,i)=expon*gvdwc(j,i)
1208 gvdwx(j,i)=expon*gvdwx(j,i)
1211 C******************************************************************************
1215 C To save time, the factor of EXPON has been extracted from ALL components
1216 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1219 C******************************************************************************
1222 C-----------------------------------------------------------------------------
1223 subroutine eljk(evdw)
1225 C This subroutine calculates the interaction energy of nonbonded side chains
1226 C assuming the LJK potential of interaction.
1228 implicit real*8 (a-h,o-z)
1229 include 'DIMENSIONS'
1230 include 'COMMON.GEO'
1231 include 'COMMON.VAR'
1232 include 'COMMON.LOCAL'
1233 include 'COMMON.CHAIN'
1234 include 'COMMON.DERIV'
1235 include 'COMMON.INTERACT'
1236 include 'COMMON.IOUNITS'
1237 include 'COMMON.NAMES'
1240 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1242 do i=iatsc_s,iatsc_e
1243 itypi=iabs(itype(i))
1244 if (itypi.eq.ntyp1) cycle
1245 itypi1=iabs(itype(i+1))
1250 C Calculate SC interaction energy.
1252 do iint=1,nint_gr(i)
1253 do j=istart(i,iint),iend(i,iint)
1254 itypj=iabs(itype(j))
1255 if (itypj.eq.ntyp1) cycle
1259 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1260 fac_augm=rrij**expon
1261 e_augm=augm(itypi,itypj)*fac_augm
1262 r_inv_ij=dsqrt(rrij)
1264 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1265 fac=r_shift_inv**expon
1266 C have you changed here?
1270 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1271 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1272 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1273 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1274 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1275 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1276 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1279 C Calculate the components of the gradient in DC and X
1281 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1286 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1287 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1288 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1289 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1293 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1301 gvdwc(j,i)=expon*gvdwc(j,i)
1302 gvdwx(j,i)=expon*gvdwx(j,i)
1307 C-----------------------------------------------------------------------------
1308 subroutine ebp(evdw)
1310 C This subroutine calculates the interaction energy of nonbonded side chains
1311 C assuming the Berne-Pechukas potential of interaction.
1313 implicit real*8 (a-h,o-z)
1314 include 'DIMENSIONS'
1315 include 'COMMON.GEO'
1316 include 'COMMON.VAR'
1317 include 'COMMON.LOCAL'
1318 include 'COMMON.CHAIN'
1319 include 'COMMON.DERIV'
1320 include 'COMMON.NAMES'
1321 include 'COMMON.INTERACT'
1322 include 'COMMON.IOUNITS'
1323 include 'COMMON.CALC'
1324 common /srutu/ icall
1325 c double precision rrsave(maxdim)
1328 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1330 c if (icall.eq.0) then
1336 do i=iatsc_s,iatsc_e
1337 itypi=iabs(itype(i))
1338 if (itypi.eq.ntyp1) cycle
1339 itypi1=iabs(itype(i+1))
1343 dxi=dc_norm(1,nres+i)
1344 dyi=dc_norm(2,nres+i)
1345 dzi=dc_norm(3,nres+i)
1346 c dsci_inv=dsc_inv(itypi)
1347 dsci_inv=vbld_inv(i+nres)
1349 C Calculate SC interaction energy.
1351 do iint=1,nint_gr(i)
1352 do j=istart(i,iint),iend(i,iint)
1354 itypj=iabs(itype(j))
1355 if (itypj.eq.ntyp1) cycle
1356 c dscj_inv=dsc_inv(itypj)
1357 dscj_inv=vbld_inv(j+nres)
1358 chi1=chi(itypi,itypj)
1359 chi2=chi(itypj,itypi)
1366 alf12=0.5D0*(alf1+alf2)
1367 C For diagnostics only!!!
1380 dxj=dc_norm(1,nres+j)
1381 dyj=dc_norm(2,nres+j)
1382 dzj=dc_norm(3,nres+j)
1383 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1384 cd if (icall.eq.0) then
1390 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1392 C Calculate whole angle-dependent part of epsilon and contributions
1393 C to its derivatives
1394 C have you changed here?
1395 fac=(rrij*sigsq)**expon2
1398 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1399 eps2der=evdwij*eps3rt
1400 eps3der=evdwij*eps2rt
1401 evdwij=evdwij*eps2rt*eps3rt
1404 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1406 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1407 cd & restyp(itypi),i,restyp(itypj),j,
1408 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1409 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1410 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1413 C Calculate gradient components.
1414 e1=e1*eps1*eps2rt**2*eps3rt**2
1415 fac=-expon*(e1+evdwij)
1418 C Calculate radial part of the gradient
1422 C Calculate the angular part of the gradient and sum add the contributions
1423 C to the appropriate components of the Cartesian gradient.
1431 C-----------------------------------------------------------------------------
1432 subroutine egb(evdw)
1434 C This subroutine calculates the interaction energy of nonbonded side chains
1435 C assuming the Gay-Berne potential of interaction.
1437 implicit real*8 (a-h,o-z)
1438 include 'DIMENSIONS'
1439 include 'COMMON.GEO'
1440 include 'COMMON.VAR'
1441 include 'COMMON.LOCAL'
1442 include 'COMMON.CHAIN'
1443 include 'COMMON.DERIV'
1444 include 'COMMON.NAMES'
1445 include 'COMMON.INTERACT'
1446 include 'COMMON.IOUNITS'
1447 include 'COMMON.CALC'
1448 include 'COMMON.CONTROL'
1449 include 'COMMON.SPLITELE'
1450 include 'COMMON.SBRIDGE'
1452 integer xshift,yshift,zshift
1454 ccccc energy_dec=.false.
1455 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1458 c if (icall.eq.0) lprn=.false.
1460 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1461 C we have the original box)
1465 do i=iatsc_s,iatsc_e
1466 itypi=iabs(itype(i))
1467 if (itypi.eq.ntyp1) cycle
1468 itypi1=iabs(itype(i+1))
1472 C Return atom into box, boxxsize is size of box in x dimension
1474 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1475 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1476 C Condition for being inside the proper box
1477 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1478 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1482 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1483 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1484 C Condition for being inside the proper box
1485 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1486 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1490 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1491 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1492 C Condition for being inside the proper box
1493 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1494 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1498 if (xi.lt.0) xi=xi+boxxsize
1500 if (yi.lt.0) yi=yi+boxysize
1502 if (zi.lt.0) zi=zi+boxzsize
1503 C define scaling factor for lipids
1505 C if (positi.le.0) positi=positi+boxzsize
1507 C first for peptide groups
1508 c for each residue check if it is in lipid or lipid water border area
1509 if ((zi.gt.bordlipbot)
1510 &.and.(zi.lt.bordliptop)) then
1511 C the energy transfer exist
1512 if (zi.lt.buflipbot) then
1513 C what fraction I am in
1515 & ((zi-bordlipbot)/lipbufthick)
1516 C lipbufthick is thickenes of lipid buffore
1517 sslipi=sscalelip(fracinbuf)
1518 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1519 elseif (zi.gt.bufliptop) then
1520 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1521 sslipi=sscalelip(fracinbuf)
1522 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1532 C xi=xi+xshift*boxxsize
1533 C yi=yi+yshift*boxysize
1534 C zi=zi+zshift*boxzsize
1536 dxi=dc_norm(1,nres+i)
1537 dyi=dc_norm(2,nres+i)
1538 dzi=dc_norm(3,nres+i)
1539 c dsci_inv=dsc_inv(itypi)
1540 dsci_inv=vbld_inv(i+nres)
1541 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1542 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1544 C Calculate SC interaction energy.
1546 do iint=1,nint_gr(i)
1547 do j=istart(i,iint),iend(i,iint)
1548 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1549 call dyn_ssbond_ene(i,j,evdwij)
1551 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1552 & 'evdw',i,j,evdwij,' ss'
1555 itypj=iabs(itype(j))
1556 if (itypj.eq.ntyp1) cycle
1557 c dscj_inv=dsc_inv(itypj)
1558 dscj_inv=vbld_inv(j+nres)
1559 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1560 c & 1.0d0/vbld(j+nres)
1561 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1562 sig0ij=sigma(itypi,itypj)
1563 chi1=chi(itypi,itypj)
1564 chi2=chi(itypj,itypi)
1571 alf12=0.5D0*(alf1+alf2)
1572 C For diagnostics only!!!
1585 C Return atom J into box the original box
1587 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1588 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1589 C Condition for being inside the proper box
1590 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1591 c & (xj.lt.((-0.5d0)*boxxsize))) then
1595 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1596 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1597 C Condition for being inside the proper box
1598 c if ((yj.gt.((0.5d0)*boxysize)).or.
1599 c & (yj.lt.((-0.5d0)*boxysize))) then
1603 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1604 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1605 C Condition for being inside the proper box
1606 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1607 c & (zj.lt.((-0.5d0)*boxzsize))) then
1611 if (xj.lt.0) xj=xj+boxxsize
1613 if (yj.lt.0) yj=yj+boxysize
1615 if (zj.lt.0) zj=zj+boxzsize
1616 if ((zj.gt.bordlipbot)
1617 &.and.(zj.lt.bordliptop)) then
1618 C the energy transfer exist
1619 if (zj.lt.buflipbot) then
1620 C what fraction I am in
1622 & ((zj-bordlipbot)/lipbufthick)
1623 C lipbufthick is thickenes of lipid buffore
1624 sslipj=sscalelip(fracinbuf)
1625 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1626 elseif (zi.gt.bufliptop) then
1627 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1628 sslipj=sscalelip(fracinbuf)
1629 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1638 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1639 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1640 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1641 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1642 if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1643 &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1644 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1645 print *,sslipi,sslipj,bordlipbot,zi,zj
1646 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1654 xj=xj_safe+xshift*boxxsize
1655 yj=yj_safe+yshift*boxysize
1656 zj=zj_safe+zshift*boxzsize
1657 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1658 if(dist_temp.lt.dist_init) then
1668 if (subchap.eq.1) then
1677 dxj=dc_norm(1,nres+j)
1678 dyj=dc_norm(2,nres+j)
1679 dzj=dc_norm(3,nres+j)
1683 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1684 c write (iout,*) "j",j," dc_norm",
1685 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1686 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1688 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1689 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1691 c write (iout,'(a7,4f8.3)')
1692 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1693 if (sss.gt.0.0d0) then
1694 C Calculate angle-dependent terms of energy and contributions to their
1698 sig=sig0ij*dsqrt(sigsq)
1699 rij_shift=1.0D0/rij-sig+sig0ij
1700 c for diagnostics; uncomment
1701 c rij_shift=1.2*sig0ij
1702 C I hate to put IF's in the loops, but here don't have another choice!!!!
1703 if (rij_shift.le.0.0D0) then
1705 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1706 cd & restyp(itypi),i,restyp(itypj),j,
1707 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1711 c---------------------------------------------------------------
1712 rij_shift=1.0D0/rij_shift
1713 fac=rij_shift**expon
1714 C here to start with
1719 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1720 eps2der=evdwij*eps3rt
1721 eps3der=evdwij*eps2rt
1722 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1723 C &((sslipi+sslipj)/2.0d0+
1724 C &(2.0d0-sslipi-sslipj)/2.0d0)
1725 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1726 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1727 evdwij=evdwij*eps2rt*eps3rt
1728 evdw=evdw+evdwij*sss
1730 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1732 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1733 & restyp(itypi),i,restyp(itypj),j,
1734 & epsi,sigm,chi1,chi2,chip1,chip2,
1735 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1736 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1740 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1743 C Calculate gradient components.
1744 e1=e1*eps1*eps2rt**2*eps3rt**2
1745 fac=-expon*(e1+evdwij)*rij_shift
1748 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1749 c & evdwij,fac,sigma(itypi,itypj),expon
1750 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1752 C Calculate the radial part of the gradient
1753 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1754 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1755 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1756 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1757 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1758 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1764 C Calculate angular part of the gradient.
1774 c write (iout,*) "Number of loop steps in EGB:",ind
1775 cccc energy_dec=.false.
1778 C-----------------------------------------------------------------------------
1779 subroutine egbv(evdw)
1781 C This subroutine calculates the interaction energy of nonbonded side chains
1782 C assuming the Gay-Berne-Vorobjev potential of interaction.
1784 implicit real*8 (a-h,o-z)
1785 include 'DIMENSIONS'
1786 include 'COMMON.GEO'
1787 include 'COMMON.VAR'
1788 include 'COMMON.LOCAL'
1789 include 'COMMON.CHAIN'
1790 include 'COMMON.DERIV'
1791 include 'COMMON.NAMES'
1792 include 'COMMON.INTERACT'
1793 include 'COMMON.IOUNITS'
1794 include 'COMMON.CALC'
1795 common /srutu/ icall
1798 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1801 c if (icall.eq.0) lprn=.true.
1803 do i=iatsc_s,iatsc_e
1804 itypi=iabs(itype(i))
1805 if (itypi.eq.ntyp1) cycle
1806 itypi1=iabs(itype(i+1))
1811 if (xi.lt.0) xi=xi+boxxsize
1813 if (yi.lt.0) yi=yi+boxysize
1815 if (zi.lt.0) zi=zi+boxzsize
1816 C define scaling factor for lipids
1818 C if (positi.le.0) positi=positi+boxzsize
1820 C first for peptide groups
1821 c for each residue check if it is in lipid or lipid water border area
1822 if ((zi.gt.bordlipbot)
1823 &.and.(zi.lt.bordliptop)) then
1824 C the energy transfer exist
1825 if (zi.lt.buflipbot) then
1826 C what fraction I am in
1828 & ((positi-bordlipbot)/lipbufthick)
1829 C lipbufthick is thickenes of lipid buffore
1830 sslipi=sscalelip(fracinbuf)
1831 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1832 elseif (zi.gt.bufliptop) then
1833 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
1834 sslipi=sscalelip(fracinbuf)
1835 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1845 dxi=dc_norm(1,nres+i)
1846 dyi=dc_norm(2,nres+i)
1847 dzi=dc_norm(3,nres+i)
1848 c dsci_inv=dsc_inv(itypi)
1849 dsci_inv=vbld_inv(i+nres)
1851 C Calculate SC interaction energy.
1853 do iint=1,nint_gr(i)
1854 do j=istart(i,iint),iend(i,iint)
1856 itypj=iabs(itype(j))
1857 if (itypj.eq.ntyp1) cycle
1858 c dscj_inv=dsc_inv(itypj)
1859 dscj_inv=vbld_inv(j+nres)
1860 sig0ij=sigma(itypi,itypj)
1861 r0ij=r0(itypi,itypj)
1862 chi1=chi(itypi,itypj)
1863 chi2=chi(itypj,itypi)
1870 alf12=0.5D0*(alf1+alf2)
1871 C For diagnostics only!!!
1885 if (xj.lt.0) xj=xj+boxxsize
1887 if (yj.lt.0) yj=yj+boxysize
1889 if (zj.lt.0) zj=zj+boxzsize
1890 if ((zj.gt.bordlipbot)
1891 &.and.(zj.lt.bordliptop)) then
1892 C the energy transfer exist
1893 if (zj.lt.buflipbot) then
1894 C what fraction I am in
1896 & ((positi-bordlipbot)/lipbufthick)
1897 C lipbufthick is thickenes of lipid buffore
1898 sslipj=sscalelip(fracinbuf)
1899 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1900 elseif (zi.gt.bufliptop) then
1901 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
1902 sslipj=sscalelip(fracinbuf)
1903 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1912 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1913 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1914 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1915 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1916 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
1917 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1918 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1926 xj=xj_safe+xshift*boxxsize
1927 yj=yj_safe+yshift*boxysize
1928 zj=zj_safe+zshift*boxzsize
1929 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1930 if(dist_temp.lt.dist_init) then
1940 if (subchap.eq.1) then
1949 dxj=dc_norm(1,nres+j)
1950 dyj=dc_norm(2,nres+j)
1951 dzj=dc_norm(3,nres+j)
1952 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1954 C Calculate angle-dependent terms of energy and contributions to their
1958 sig=sig0ij*dsqrt(sigsq)
1959 rij_shift=1.0D0/rij-sig+r0ij
1960 C I hate to put IF's in the loops, but here don't have another choice!!!!
1961 if (rij_shift.le.0.0D0) then
1966 c---------------------------------------------------------------
1967 rij_shift=1.0D0/rij_shift
1968 fac=rij_shift**expon
1971 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1972 eps2der=evdwij*eps3rt
1973 eps3der=evdwij*eps2rt
1974 fac_augm=rrij**expon
1975 e_augm=augm(itypi,itypj)*fac_augm
1976 evdwij=evdwij*eps2rt*eps3rt
1977 evdw=evdw+evdwij+e_augm
1979 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1981 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1982 & restyp(itypi),i,restyp(itypj),j,
1983 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1984 & chi1,chi2,chip1,chip2,
1985 & eps1,eps2rt**2,eps3rt**2,
1986 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1989 C Calculate gradient components.
1990 e1=e1*eps1*eps2rt**2*eps3rt**2
1991 fac=-expon*(e1+evdwij)*rij_shift
1993 fac=rij*fac-2*expon*rrij*e_augm
1994 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1995 C Calculate the radial part of the gradient
1999 C Calculate angular part of the gradient.
2005 C-----------------------------------------------------------------------------
2006 subroutine sc_angular
2007 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2008 C om12. Called by ebp, egb, and egbv.
2010 include 'COMMON.CALC'
2011 include 'COMMON.IOUNITS'
2015 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2016 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2017 om12=dxi*dxj+dyi*dyj+dzi*dzj
2019 C Calculate eps1(om12) and its derivative in om12
2020 faceps1=1.0D0-om12*chiom12
2021 faceps1_inv=1.0D0/faceps1
2022 eps1=dsqrt(faceps1_inv)
2023 C Following variable is eps1*deps1/dom12
2024 eps1_om12=faceps1_inv*chiom12
2029 c write (iout,*) "om12",om12," eps1",eps1
2030 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2035 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2036 sigsq=1.0D0-facsig*faceps1_inv
2037 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2038 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2039 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2045 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2046 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2048 C Calculate eps2 and its derivatives in om1, om2, and om12.
2051 chipom12=chip12*om12
2052 facp=1.0D0-om12*chipom12
2054 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2055 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2056 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2057 C Following variable is the square root of eps2
2058 eps2rt=1.0D0-facp1*facp_inv
2059 C Following three variables are the derivatives of the square root of eps
2060 C in om1, om2, and om12.
2061 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2062 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2063 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2064 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2065 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2066 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2067 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2068 c & " eps2rt_om12",eps2rt_om12
2069 C Calculate whole angle-dependent part of epsilon and contributions
2070 C to its derivatives
2073 C----------------------------------------------------------------------------
2075 implicit real*8 (a-h,o-z)
2076 include 'DIMENSIONS'
2077 include 'COMMON.CHAIN'
2078 include 'COMMON.DERIV'
2079 include 'COMMON.CALC'
2080 include 'COMMON.IOUNITS'
2081 double precision dcosom1(3),dcosom2(3)
2082 cc print *,'sss=',sss
2083 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2084 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2085 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2086 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2090 c eom12=evdwij*eps1_om12
2092 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2093 c & " sigder",sigder
2094 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2095 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2097 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2098 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2101 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2103 c write (iout,*) "gg",(gg(k),k=1,3)
2105 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2106 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2107 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2108 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2109 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2110 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2111 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2112 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2113 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2114 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2117 C Calculate the components of the gradient in DC and X
2121 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2125 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2126 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2130 C-----------------------------------------------------------------------
2131 subroutine e_softsphere(evdw)
2133 C This subroutine calculates the interaction energy of nonbonded side chains
2134 C assuming the LJ potential of interaction.
2136 implicit real*8 (a-h,o-z)
2137 include 'DIMENSIONS'
2138 parameter (accur=1.0d-10)
2139 include 'COMMON.GEO'
2140 include 'COMMON.VAR'
2141 include 'COMMON.LOCAL'
2142 include 'COMMON.CHAIN'
2143 include 'COMMON.DERIV'
2144 include 'COMMON.INTERACT'
2145 include 'COMMON.TORSION'
2146 include 'COMMON.SBRIDGE'
2147 include 'COMMON.NAMES'
2148 include 'COMMON.IOUNITS'
2149 include 'COMMON.CONTACTS'
2151 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2153 do i=iatsc_s,iatsc_e
2154 itypi=iabs(itype(i))
2155 if (itypi.eq.ntyp1) cycle
2156 itypi1=iabs(itype(i+1))
2161 C Calculate SC interaction energy.
2163 do iint=1,nint_gr(i)
2164 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2165 cd & 'iend=',iend(i,iint)
2166 do j=istart(i,iint),iend(i,iint)
2167 itypj=iabs(itype(j))
2168 if (itypj.eq.ntyp1) cycle
2172 rij=xj*xj+yj*yj+zj*zj
2173 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2174 r0ij=r0(itypi,itypj)
2176 c print *,i,j,r0ij,dsqrt(rij)
2177 if (rij.lt.r0ijsq) then
2178 evdwij=0.25d0*(rij-r0ijsq)**2
2186 C Calculate the components of the gradient in DC and X
2192 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2193 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2194 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2195 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2199 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2207 C--------------------------------------------------------------------------
2208 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2211 C Soft-sphere potential of p-p interaction
2213 implicit real*8 (a-h,o-z)
2214 include 'DIMENSIONS'
2215 include 'COMMON.CONTROL'
2216 include 'COMMON.IOUNITS'
2217 include 'COMMON.GEO'
2218 include 'COMMON.VAR'
2219 include 'COMMON.LOCAL'
2220 include 'COMMON.CHAIN'
2221 include 'COMMON.DERIV'
2222 include 'COMMON.INTERACT'
2223 include 'COMMON.CONTACTS'
2224 include 'COMMON.TORSION'
2225 include 'COMMON.VECTORS'
2226 include 'COMMON.FFIELD'
2228 C write(iout,*) 'In EELEC_soft_sphere'
2235 do i=iatel_s,iatel_e
2236 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2240 xmedi=c(1,i)+0.5d0*dxi
2241 ymedi=c(2,i)+0.5d0*dyi
2242 zmedi=c(3,i)+0.5d0*dzi
2243 xmedi=mod(xmedi,boxxsize)
2244 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2245 ymedi=mod(ymedi,boxysize)
2246 if (ymedi.lt.0) ymedi=ymedi+boxysize
2247 zmedi=mod(zmedi,boxzsize)
2248 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2250 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2251 do j=ielstart(i),ielend(i)
2252 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2256 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2257 r0ij=rpp(iteli,itelj)
2266 if (xj.lt.0) xj=xj+boxxsize
2268 if (yj.lt.0) yj=yj+boxysize
2270 if (zj.lt.0) zj=zj+boxzsize
2271 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2279 xj=xj_safe+xshift*boxxsize
2280 yj=yj_safe+yshift*boxysize
2281 zj=zj_safe+zshift*boxzsize
2282 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2283 if(dist_temp.lt.dist_init) then
2293 if (isubchap.eq.1) then
2302 rij=xj*xj+yj*yj+zj*zj
2303 sss=sscale(sqrt(rij))
2304 sssgrad=sscagrad(sqrt(rij))
2305 if (rij.lt.r0ijsq) then
2306 evdw1ij=0.25d0*(rij-r0ijsq)**2
2312 evdw1=evdw1+evdw1ij*sss
2314 C Calculate contributions to the Cartesian gradient.
2316 ggg(1)=fac*xj*sssgrad
2317 ggg(2)=fac*yj*sssgrad
2318 ggg(3)=fac*zj*sssgrad
2320 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2321 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2324 * Loop over residues i+1 thru j-1.
2328 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2333 cgrad do i=nnt,nct-1
2335 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2337 cgrad do j=i+1,nct-1
2339 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2345 c------------------------------------------------------------------------------
2346 subroutine vec_and_deriv
2347 implicit real*8 (a-h,o-z)
2348 include 'DIMENSIONS'
2352 include 'COMMON.IOUNITS'
2353 include 'COMMON.GEO'
2354 include 'COMMON.VAR'
2355 include 'COMMON.LOCAL'
2356 include 'COMMON.CHAIN'
2357 include 'COMMON.VECTORS'
2358 include 'COMMON.SETUP'
2359 include 'COMMON.TIME1'
2360 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2361 C Compute the local reference systems. For reference system (i), the
2362 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2363 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2365 do i=ivec_start,ivec_end
2369 if (i.eq.nres-1) then
2370 C Case of the last full residue
2371 C Compute the Z-axis
2372 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2373 costh=dcos(pi-theta(nres))
2374 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2378 C Compute the derivatives of uz
2380 uzder(2,1,1)=-dc_norm(3,i-1)
2381 uzder(3,1,1)= dc_norm(2,i-1)
2382 uzder(1,2,1)= dc_norm(3,i-1)
2384 uzder(3,2,1)=-dc_norm(1,i-1)
2385 uzder(1,3,1)=-dc_norm(2,i-1)
2386 uzder(2,3,1)= dc_norm(1,i-1)
2389 uzder(2,1,2)= dc_norm(3,i)
2390 uzder(3,1,2)=-dc_norm(2,i)
2391 uzder(1,2,2)=-dc_norm(3,i)
2393 uzder(3,2,2)= dc_norm(1,i)
2394 uzder(1,3,2)= dc_norm(2,i)
2395 uzder(2,3,2)=-dc_norm(1,i)
2397 C Compute the Y-axis
2400 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2402 C Compute the derivatives of uy
2405 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2406 & -dc_norm(k,i)*dc_norm(j,i-1)
2407 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2409 uyder(j,j,1)=uyder(j,j,1)-costh
2410 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2415 uygrad(l,k,j,i)=uyder(l,k,j)
2416 uzgrad(l,k,j,i)=uzder(l,k,j)
2420 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2421 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2422 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2423 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2426 C Compute the Z-axis
2427 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2428 costh=dcos(pi-theta(i+2))
2429 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2433 C Compute the derivatives of uz
2435 uzder(2,1,1)=-dc_norm(3,i+1)
2436 uzder(3,1,1)= dc_norm(2,i+1)
2437 uzder(1,2,1)= dc_norm(3,i+1)
2439 uzder(3,2,1)=-dc_norm(1,i+1)
2440 uzder(1,3,1)=-dc_norm(2,i+1)
2441 uzder(2,3,1)= dc_norm(1,i+1)
2444 uzder(2,1,2)= dc_norm(3,i)
2445 uzder(3,1,2)=-dc_norm(2,i)
2446 uzder(1,2,2)=-dc_norm(3,i)
2448 uzder(3,2,2)= dc_norm(1,i)
2449 uzder(1,3,2)= dc_norm(2,i)
2450 uzder(2,3,2)=-dc_norm(1,i)
2452 C Compute the Y-axis
2455 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2457 C Compute the derivatives of uy
2460 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2461 & -dc_norm(k,i)*dc_norm(j,i+1)
2462 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2464 uyder(j,j,1)=uyder(j,j,1)-costh
2465 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2470 uygrad(l,k,j,i)=uyder(l,k,j)
2471 uzgrad(l,k,j,i)=uzder(l,k,j)
2475 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2476 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2477 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2478 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2482 vbld_inv_temp(1)=vbld_inv(i+1)
2483 if (i.lt.nres-1) then
2484 vbld_inv_temp(2)=vbld_inv(i+2)
2486 vbld_inv_temp(2)=vbld_inv(i)
2491 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2492 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2497 #if defined(PARVEC) && defined(MPI)
2498 if (nfgtasks1.gt.1) then
2500 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2501 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2502 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2503 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2504 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2506 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2507 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2509 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2510 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2511 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2512 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2513 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2514 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2515 time_gather=time_gather+MPI_Wtime()-time00
2517 c if (fg_rank.eq.0) then
2518 c write (iout,*) "Arrays UY and UZ"
2520 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2527 C-----------------------------------------------------------------------------
2528 subroutine check_vecgrad
2529 implicit real*8 (a-h,o-z)
2530 include 'DIMENSIONS'
2531 include 'COMMON.IOUNITS'
2532 include 'COMMON.GEO'
2533 include 'COMMON.VAR'
2534 include 'COMMON.LOCAL'
2535 include 'COMMON.CHAIN'
2536 include 'COMMON.VECTORS'
2537 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2538 dimension uyt(3,maxres),uzt(3,maxres)
2539 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2540 double precision delta /1.0d-7/
2543 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2544 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2545 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2546 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2547 cd & (dc_norm(if90,i),if90=1,3)
2548 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2549 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2550 cd write(iout,'(a)')
2556 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2557 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2570 cd write (iout,*) 'i=',i
2572 erij(k)=dc_norm(k,i)
2576 dc_norm(k,i)=erij(k)
2578 dc_norm(j,i)=dc_norm(j,i)+delta
2579 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2581 c dc_norm(k,i)=dc_norm(k,i)/fac
2583 c write (iout,*) (dc_norm(k,i),k=1,3)
2584 c write (iout,*) (erij(k),k=1,3)
2587 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2588 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2589 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2590 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2592 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2593 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2594 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2597 dc_norm(k,i)=erij(k)
2600 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2601 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2602 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2603 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2604 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2605 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2606 cd write (iout,'(a)')
2611 C--------------------------------------------------------------------------
2612 subroutine set_matrices
2613 implicit real*8 (a-h,o-z)
2614 include 'DIMENSIONS'
2617 include "COMMON.SETUP"
2619 integer status(MPI_STATUS_SIZE)
2621 include 'COMMON.IOUNITS'
2622 include 'COMMON.GEO'
2623 include 'COMMON.VAR'
2624 include 'COMMON.LOCAL'
2625 include 'COMMON.CHAIN'
2626 include 'COMMON.DERIV'
2627 include 'COMMON.INTERACT'
2628 include 'COMMON.CONTACTS'
2629 include 'COMMON.TORSION'
2630 include 'COMMON.VECTORS'
2631 include 'COMMON.FFIELD'
2632 double precision auxvec(2),auxmat(2,2)
2634 C Compute the virtual-bond-torsional-angle dependent quantities needed
2635 C to calculate the el-loc multibody terms of various order.
2638 do i=ivec_start+2,ivec_end+2
2642 if (i .lt. nres+1) then
2679 if (i .gt. 3 .and. i .lt. nres+1) then
2680 obrot_der(1,i-2)=-sin1
2681 obrot_der(2,i-2)= cos1
2682 Ugder(1,1,i-2)= sin1
2683 Ugder(1,2,i-2)=-cos1
2684 Ugder(2,1,i-2)=-cos1
2685 Ugder(2,2,i-2)=-sin1
2688 obrot2_der(1,i-2)=-dwasin2
2689 obrot2_der(2,i-2)= dwacos2
2690 Ug2der(1,1,i-2)= dwasin2
2691 Ug2der(1,2,i-2)=-dwacos2
2692 Ug2der(2,1,i-2)=-dwacos2
2693 Ug2der(2,2,i-2)=-dwasin2
2695 obrot_der(1,i-2)=0.0d0
2696 obrot_der(2,i-2)=0.0d0
2697 Ugder(1,1,i-2)=0.0d0
2698 Ugder(1,2,i-2)=0.0d0
2699 Ugder(2,1,i-2)=0.0d0
2700 Ugder(2,2,i-2)=0.0d0
2701 obrot2_der(1,i-2)=0.0d0
2702 obrot2_der(2,i-2)=0.0d0
2703 Ug2der(1,1,i-2)=0.0d0
2704 Ug2der(1,2,i-2)=0.0d0
2705 Ug2der(2,1,i-2)=0.0d0
2706 Ug2der(2,2,i-2)=0.0d0
2708 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2709 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2710 iti = itortyp(itype(i-2))
2714 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2715 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2716 iti1 = itortyp(itype(i-1))
2720 cd write (iout,*) '*******i',i,' iti1',iti
2721 cd write (iout,*) 'b1',b1(:,iti)
2722 cd write (iout,*) 'b2',b2(:,iti)
2723 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2724 c if (i .gt. iatel_s+2) then
2725 if (i .gt. nnt+2) then
2726 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2727 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2728 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2730 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2731 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2732 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2733 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2734 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2745 DtUg2(l,k,i-2)=0.0d0
2749 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2750 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2752 muder(k,i-2)=Ub2der(k,i-2)
2754 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2755 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2756 if (itype(i-1).le.ntyp) then
2757 iti1 = itortyp(itype(i-1))
2765 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2767 cd write (iout,*) 'mu ',mu(:,i-2)
2768 cd write (iout,*) 'mu1',mu1(:,i-2)
2769 cd write (iout,*) 'mu2',mu2(:,i-2)
2770 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2772 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2773 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2774 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2775 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2776 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2777 C Vectors and matrices dependent on a single virtual-bond dihedral.
2778 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2779 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2780 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2781 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2782 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2783 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2784 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2785 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2786 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2789 C Matrices dependent on two consecutive virtual-bond dihedrals.
2790 C The order of matrices is from left to right.
2791 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2793 c do i=max0(ivec_start,2),ivec_end
2795 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2796 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2797 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2798 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2799 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2800 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2801 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2802 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2805 #if defined(MPI) && defined(PARMAT)
2807 c if (fg_rank.eq.0) then
2808 write (iout,*) "Arrays UG and UGDER before GATHER"
2810 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2811 & ((ug(l,k,i),l=1,2),k=1,2),
2812 & ((ugder(l,k,i),l=1,2),k=1,2)
2814 write (iout,*) "Arrays UG2 and UG2DER"
2816 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2817 & ((ug2(l,k,i),l=1,2),k=1,2),
2818 & ((ug2der(l,k,i),l=1,2),k=1,2)
2820 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2822 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2823 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2824 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2826 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2828 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2829 & costab(i),sintab(i),costab2(i),sintab2(i)
2831 write (iout,*) "Array MUDER"
2833 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2837 if (nfgtasks.gt.1) then
2839 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2840 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2841 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2843 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2844 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2846 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2847 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2849 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2850 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2852 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2853 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2855 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2856 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2858 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2859 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2861 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2862 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2863 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2864 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2865 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2866 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2867 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2868 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2869 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2870 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2871 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2872 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2873 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2875 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2876 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2878 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2879 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2881 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2882 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2884 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2885 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2887 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2888 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2890 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2891 & ivec_count(fg_rank1),
2892 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2894 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2895 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2897 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2898 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2900 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2901 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2903 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2904 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2906 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2907 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2909 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2910 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2912 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2913 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2915 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2916 & ivec_count(fg_rank1),
2917 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2919 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2920 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2922 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2923 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2925 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2926 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2928 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2929 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2931 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2932 & ivec_count(fg_rank1),
2933 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2935 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2936 & ivec_count(fg_rank1),
2937 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2939 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2940 & ivec_count(fg_rank1),
2941 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2942 & MPI_MAT2,FG_COMM1,IERR)
2943 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2944 & ivec_count(fg_rank1),
2945 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2946 & MPI_MAT2,FG_COMM1,IERR)
2949 c Passes matrix info through the ring
2952 if (irecv.lt.0) irecv=nfgtasks1-1
2955 if (inext.ge.nfgtasks1) inext=0
2957 c write (iout,*) "isend",isend," irecv",irecv
2959 lensend=lentyp(isend)
2960 lenrecv=lentyp(irecv)
2961 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2962 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2963 c & MPI_ROTAT1(lensend),inext,2200+isend,
2964 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2965 c & iprev,2200+irecv,FG_COMM,status,IERR)
2966 c write (iout,*) "Gather ROTAT1"
2968 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2969 c & MPI_ROTAT2(lensend),inext,3300+isend,
2970 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2971 c & iprev,3300+irecv,FG_COMM,status,IERR)
2972 c write (iout,*) "Gather ROTAT2"
2974 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2975 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2976 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2977 & iprev,4400+irecv,FG_COMM,status,IERR)
2978 c write (iout,*) "Gather ROTAT_OLD"
2980 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2981 & MPI_PRECOMP11(lensend),inext,5500+isend,
2982 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2983 & iprev,5500+irecv,FG_COMM,status,IERR)
2984 c write (iout,*) "Gather PRECOMP11"
2986 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2987 & MPI_PRECOMP12(lensend),inext,6600+isend,
2988 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2989 & iprev,6600+irecv,FG_COMM,status,IERR)
2990 c write (iout,*) "Gather PRECOMP12"
2992 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2994 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2995 & MPI_ROTAT2(lensend),inext,7700+isend,
2996 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2997 & iprev,7700+irecv,FG_COMM,status,IERR)
2998 c write (iout,*) "Gather PRECOMP21"
3000 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3001 & MPI_PRECOMP22(lensend),inext,8800+isend,
3002 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3003 & iprev,8800+irecv,FG_COMM,status,IERR)
3004 c write (iout,*) "Gather PRECOMP22"
3006 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3007 & MPI_PRECOMP23(lensend),inext,9900+isend,
3008 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3009 & MPI_PRECOMP23(lenrecv),
3010 & iprev,9900+irecv,FG_COMM,status,IERR)
3011 c write (iout,*) "Gather PRECOMP23"
3016 if (irecv.lt.0) irecv=nfgtasks1-1
3019 time_gather=time_gather+MPI_Wtime()-time00
3022 c if (fg_rank.eq.0) then
3023 write (iout,*) "Arrays UG and UGDER"
3025 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3026 & ((ug(l,k,i),l=1,2),k=1,2),
3027 & ((ugder(l,k,i),l=1,2),k=1,2)
3029 write (iout,*) "Arrays UG2 and UG2DER"
3031 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3032 & ((ug2(l,k,i),l=1,2),k=1,2),
3033 & ((ug2der(l,k,i),l=1,2),k=1,2)
3035 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3037 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3038 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3039 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3041 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3043 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3044 & costab(i),sintab(i),costab2(i),sintab2(i)
3046 write (iout,*) "Array MUDER"
3048 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3054 cd iti = itortyp(itype(i))
3057 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3058 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3063 C--------------------------------------------------------------------------
3064 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3066 C This subroutine calculates the average interaction energy and its gradient
3067 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3068 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3069 C The potential depends both on the distance of peptide-group centers and on
3070 C the orientation of the CA-CA virtual bonds.
3072 implicit real*8 (a-h,o-z)
3076 include 'DIMENSIONS'
3077 include 'COMMON.CONTROL'
3078 include 'COMMON.SETUP'
3079 include 'COMMON.IOUNITS'
3080 include 'COMMON.GEO'
3081 include 'COMMON.VAR'
3082 include 'COMMON.LOCAL'
3083 include 'COMMON.CHAIN'
3084 include 'COMMON.DERIV'
3085 include 'COMMON.INTERACT'
3086 include 'COMMON.CONTACTS'
3087 include 'COMMON.TORSION'
3088 include 'COMMON.VECTORS'
3089 include 'COMMON.FFIELD'
3090 include 'COMMON.TIME1'
3091 include 'COMMON.SPLITELE'
3092 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3093 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3094 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3095 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3096 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3097 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3099 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3101 double precision scal_el /1.0d0/
3103 double precision scal_el /0.5d0/
3106 C 13-go grudnia roku pamietnego...
3107 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3108 & 0.0d0,1.0d0,0.0d0,
3109 & 0.0d0,0.0d0,1.0d0/
3110 cd write(iout,*) 'In EELEC'
3112 cd write(iout,*) 'Type',i
3113 cd write(iout,*) 'B1',B1(:,i)
3114 cd write(iout,*) 'B2',B2(:,i)
3115 cd write(iout,*) 'CC',CC(:,:,i)
3116 cd write(iout,*) 'DD',DD(:,:,i)
3117 cd write(iout,*) 'EE',EE(:,:,i)
3119 cd call check_vecgrad
3121 if (icheckgrad.eq.1) then
3123 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3125 dc_norm(k,i)=dc(k,i)*fac
3127 c write (iout,*) 'i',i,' fac',fac
3130 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3131 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3132 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3133 c call vec_and_deriv
3139 time_mat=time_mat+MPI_Wtime()-time01
3143 cd write (iout,*) 'i=',i
3145 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3148 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3149 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3162 cd print '(a)','Enter EELEC'
3163 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3165 gel_loc_loc(i)=0.0d0
3170 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3172 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3174 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3175 do i=iturn3_start,iturn3_end
3177 C write(iout,*) "tu jest i",i
3178 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3179 & .or. itype(i+2).eq.ntyp1
3180 & .or. itype(i+3).eq.ntyp1
3181 & .or. itype(i-1).eq.ntyp1
3182 & .or. itype(i+4).eq.ntyp1
3187 dx_normi=dc_norm(1,i)
3188 dy_normi=dc_norm(2,i)
3189 dz_normi=dc_norm(3,i)
3190 xmedi=c(1,i)+0.5d0*dxi
3191 ymedi=c(2,i)+0.5d0*dyi
3192 zmedi=c(3,i)+0.5d0*dzi
3193 xmedi=mod(xmedi,boxxsize)
3194 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3195 ymedi=mod(ymedi,boxysize)
3196 if (ymedi.lt.0) ymedi=ymedi+boxysize
3197 zmedi=mod(zmedi,boxzsize)
3198 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3200 call eelecij(i,i+2,ees,evdw1,eel_loc)
3201 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3202 num_cont_hb(i)=num_conti
3204 do i=iturn4_start,iturn4_end
3206 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3207 & .or. itype(i+3).eq.ntyp1
3208 & .or. itype(i+4).eq.ntyp1
3209 & .or. itype(i+5).eq.ntyp1
3210 & .or. itype(i).eq.ntyp1
3211 & .or. itype(i-1).eq.ntyp1
3216 dx_normi=dc_norm(1,i)
3217 dy_normi=dc_norm(2,i)
3218 dz_normi=dc_norm(3,i)
3219 xmedi=c(1,i)+0.5d0*dxi
3220 ymedi=c(2,i)+0.5d0*dyi
3221 zmedi=c(3,i)+0.5d0*dzi
3222 C Return atom into box, boxxsize is size of box in x dimension
3224 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3225 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3226 C Condition for being inside the proper box
3227 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3228 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3232 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3233 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3234 C Condition for being inside the proper box
3235 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3236 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3240 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3241 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3242 C Condition for being inside the proper box
3243 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3244 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3247 xmedi=mod(xmedi,boxxsize)
3248 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3249 ymedi=mod(ymedi,boxysize)
3250 if (ymedi.lt.0) ymedi=ymedi+boxysize
3251 zmedi=mod(zmedi,boxzsize)
3252 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3254 num_conti=num_cont_hb(i)
3255 call eelecij(i,i+3,ees,evdw1,eel_loc)
3256 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3257 & call eturn4(i,eello_turn4)
3258 num_cont_hb(i)=num_conti
3260 C Loop over all neighbouring boxes
3265 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3267 do i=iatel_s,iatel_e
3269 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3270 & .or. itype(i+2).eq.ntyp1
3271 & .or. itype(i-1).eq.ntyp1
3276 dx_normi=dc_norm(1,i)
3277 dy_normi=dc_norm(2,i)
3278 dz_normi=dc_norm(3,i)
3279 xmedi=c(1,i)+0.5d0*dxi
3280 ymedi=c(2,i)+0.5d0*dyi
3281 zmedi=c(3,i)+0.5d0*dzi
3282 xmedi=mod(xmedi,boxxsize)
3283 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3284 ymedi=mod(ymedi,boxysize)
3285 if (ymedi.lt.0) ymedi=ymedi+boxysize
3286 zmedi=mod(zmedi,boxzsize)
3287 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3288 C xmedi=xmedi+xshift*boxxsize
3289 C ymedi=ymedi+yshift*boxysize
3290 C zmedi=zmedi+zshift*boxzsize
3292 C Return tom into box, boxxsize is size of box in x dimension
3294 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3295 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3296 C Condition for being inside the proper box
3297 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3298 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3302 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3303 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3304 C Condition for being inside the proper box
3305 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3306 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3310 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3311 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3312 cC Condition for being inside the proper box
3313 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3314 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3318 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3319 num_conti=num_cont_hb(i)
3320 do j=ielstart(i),ielend(i)
3321 C write (iout,*) i,j
3323 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3324 & .or.itype(j+2).eq.ntyp1
3325 & .or.itype(j-1).eq.ntyp1
3327 call eelecij(i,j,ees,evdw1,eel_loc)
3329 num_cont_hb(i)=num_conti
3335 c write (iout,*) "Number of loop steps in EELEC:",ind
3337 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3338 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3340 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3341 ccc eel_loc=eel_loc+eello_turn3
3342 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3345 C-------------------------------------------------------------------------------
3346 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3347 implicit real*8 (a-h,o-z)
3348 include 'DIMENSIONS'
3352 include 'COMMON.CONTROL'
3353 include 'COMMON.IOUNITS'
3354 include 'COMMON.GEO'
3355 include 'COMMON.VAR'
3356 include 'COMMON.LOCAL'
3357 include 'COMMON.CHAIN'
3358 include 'COMMON.DERIV'
3359 include 'COMMON.INTERACT'
3360 include 'COMMON.CONTACTS'
3361 include 'COMMON.TORSION'
3362 include 'COMMON.VECTORS'
3363 include 'COMMON.FFIELD'
3364 include 'COMMON.TIME1'
3365 include 'COMMON.SPLITELE'
3366 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3367 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3368 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3369 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3370 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3371 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3373 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3375 double precision scal_el /1.0d0/
3377 double precision scal_el /0.5d0/
3380 C 13-go grudnia roku pamietnego...
3381 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3382 & 0.0d0,1.0d0,0.0d0,
3383 & 0.0d0,0.0d0,1.0d0/
3384 c time00=MPI_Wtime()
3385 cd write (iout,*) "eelecij",i,j
3389 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3390 aaa=app(iteli,itelj)
3391 bbb=bpp(iteli,itelj)
3392 ael6i=ael6(iteli,itelj)
3393 ael3i=ael3(iteli,itelj)
3397 dx_normj=dc_norm(1,j)
3398 dy_normj=dc_norm(2,j)
3399 dz_normj=dc_norm(3,j)
3400 C xj=c(1,j)+0.5D0*dxj-xmedi
3401 C yj=c(2,j)+0.5D0*dyj-ymedi
3402 C zj=c(3,j)+0.5D0*dzj-zmedi
3407 if (xj.lt.0) xj=xj+boxxsize
3409 if (yj.lt.0) yj=yj+boxysize
3411 if (zj.lt.0) zj=zj+boxzsize
3412 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3413 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3421 xj=xj_safe+xshift*boxxsize
3422 yj=yj_safe+yshift*boxysize
3423 zj=zj_safe+zshift*boxzsize
3424 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3425 if(dist_temp.lt.dist_init) then
3435 if (isubchap.eq.1) then
3444 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3446 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3447 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3448 C Condition for being inside the proper box
3449 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3450 c & (xj.lt.((-0.5d0)*boxxsize))) then
3454 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3455 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3456 C Condition for being inside the proper box
3457 c if ((yj.gt.((0.5d0)*boxysize)).or.
3458 c & (yj.lt.((-0.5d0)*boxysize))) then
3462 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3463 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3464 C Condition for being inside the proper box
3465 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3466 c & (zj.lt.((-0.5d0)*boxzsize))) then
3469 C endif !endPBC condintion
3473 rij=xj*xj+yj*yj+zj*zj
3475 sss=sscale(sqrt(rij))
3476 sssgrad=sscagrad(sqrt(rij))
3477 c if (sss.gt.0.0d0) then
3483 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3484 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3485 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3486 fac=cosa-3.0D0*cosb*cosg
3488 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3489 if (j.eq.i+2) ev1=scal_el*ev1
3494 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3498 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3499 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3501 evdw1=evdw1+evdwij*sss
3502 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3503 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3504 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3505 cd & xmedi,ymedi,zmedi,xj,yj,zj
3507 if (energy_dec) then
3508 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3510 &,iteli,itelj,aaa,evdw1
3511 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3515 C Calculate contributions to the Cartesian gradient.
3518 facvdw=-6*rrmij*(ev1+evdwij)*sss
3519 facel=-3*rrmij*(el1+eesij)
3525 * Radial derivatives. First process both termini of the fragment (i,j)
3531 c ghalf=0.5D0*ggg(k)
3532 c gelc(k,i)=gelc(k,i)+ghalf
3533 c gelc(k,j)=gelc(k,j)+ghalf
3535 c 9/28/08 AL Gradient compotents will be summed only at the end
3537 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3538 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3541 * Loop over residues i+1 thru j-1.
3545 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3548 if (sss.gt.0.0) then
3549 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3550 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3551 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3558 c ghalf=0.5D0*ggg(k)
3559 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3560 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3562 c 9/28/08 AL Gradient compotents will be summed only at the end
3564 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3565 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3568 * Loop over residues i+1 thru j-1.
3572 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3577 facvdw=(ev1+evdwij)*sss
3580 fac=-3*rrmij*(facvdw+facvdw+facel)
3585 * Radial derivatives. First process both termini of the fragment (i,j)
3591 c ghalf=0.5D0*ggg(k)
3592 c gelc(k,i)=gelc(k,i)+ghalf
3593 c gelc(k,j)=gelc(k,j)+ghalf
3595 c 9/28/08 AL Gradient compotents will be summed only at the end
3597 gelc_long(k,j)=gelc(k,j)+ggg(k)
3598 gelc_long(k,i)=gelc(k,i)-ggg(k)
3601 * Loop over residues i+1 thru j-1.
3605 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3608 c 9/28/08 AL Gradient compotents will be summed only at the end
3609 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3610 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3611 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3613 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3614 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3620 ecosa=2.0D0*fac3*fac1+fac4
3623 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3624 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3626 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3627 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3629 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3630 cd & (dcosg(k),k=1,3)
3632 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3635 c ghalf=0.5D0*ggg(k)
3636 c gelc(k,i)=gelc(k,i)+ghalf
3637 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3638 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3639 c gelc(k,j)=gelc(k,j)+ghalf
3640 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3641 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3645 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3650 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3651 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3653 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3654 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3655 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3656 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3660 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3661 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3662 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3664 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3665 C energy of a peptide unit is assumed in the form of a second-order
3666 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3667 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3668 C are computed for EVERY pair of non-contiguous peptide groups.
3670 if (j.lt.nres-1) then
3681 muij(kkk)=mu(k,i)*mu(l,j)
3684 cd write (iout,*) 'EELEC: i',i,' j',j
3685 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3686 cd write(iout,*) 'muij',muij
3687 ury=scalar(uy(1,i),erij)
3688 urz=scalar(uz(1,i),erij)
3689 vry=scalar(uy(1,j),erij)
3690 vrz=scalar(uz(1,j),erij)
3691 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3692 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3693 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3694 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3695 fac=dsqrt(-ael6i)*r3ij
3700 cd write (iout,'(4i5,4f10.5)')
3701 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3702 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3703 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3704 cd & uy(:,j),uz(:,j)
3705 cd write (iout,'(4f10.5)')
3706 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3707 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3708 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3709 cd write (iout,'(9f10.5/)')
3710 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3711 C Derivatives of the elements of A in virtual-bond vectors
3712 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3714 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3715 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3716 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3717 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3718 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3719 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3720 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3721 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3722 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3723 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3724 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3725 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3727 C Compute radial contributions to the gradient
3745 C Add the contributions coming from er
3748 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3749 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3750 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3751 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3754 C Derivatives in DC(i)
3755 cgrad ghalf1=0.5d0*agg(k,1)
3756 cgrad ghalf2=0.5d0*agg(k,2)
3757 cgrad ghalf3=0.5d0*agg(k,3)
3758 cgrad ghalf4=0.5d0*agg(k,4)
3759 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3760 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3761 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3762 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3763 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3764 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3765 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3766 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3767 C Derivatives in DC(i+1)
3768 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3769 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3770 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3771 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3772 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3773 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3774 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3775 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3776 C Derivatives in DC(j)
3777 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3778 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3779 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3780 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3781 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3782 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3783 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3784 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3785 C Derivatives in DC(j+1) or DC(nres-1)
3786 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3787 & -3.0d0*vryg(k,3)*ury)
3788 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3789 & -3.0d0*vrzg(k,3)*ury)
3790 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3791 & -3.0d0*vryg(k,3)*urz)
3792 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3793 & -3.0d0*vrzg(k,3)*urz)
3794 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3796 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3809 aggi(k,l)=-aggi(k,l)
3810 aggi1(k,l)=-aggi1(k,l)
3811 aggj(k,l)=-aggj(k,l)
3812 aggj1(k,l)=-aggj1(k,l)
3815 if (j.lt.nres-1) then
3821 aggi(k,l)=-aggi(k,l)
3822 aggi1(k,l)=-aggi1(k,l)
3823 aggj(k,l)=-aggj(k,l)
3824 aggj1(k,l)=-aggj1(k,l)
3835 aggi(k,l)=-aggi(k,l)
3836 aggi1(k,l)=-aggi1(k,l)
3837 aggj(k,l)=-aggj(k,l)
3838 aggj1(k,l)=-aggj1(k,l)
3843 IF (wel_loc.gt.0.0d0) THEN
3844 C Contribution to the local-electrostatic energy coming from the i-j pair
3845 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3847 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3848 c & ' eel_loc_ij',eel_loc_ij
3850 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3851 & 'eelloc',i,j,eel_loc_ij
3852 c if (eel_loc_ij.ne.0)
3853 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3854 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3856 eel_loc=eel_loc+eel_loc_ij
3857 C Partial derivatives in virtual-bond dihedral angles gamma
3859 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3860 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3861 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3862 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3863 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3864 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3865 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3867 ggg(l)=agg(l,1)*muij(1)+
3868 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3869 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3870 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3871 cgrad ghalf=0.5d0*ggg(l)
3872 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3873 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3877 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3880 C Remaining derivatives of eello
3882 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3883 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3884 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3885 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3886 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3887 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3888 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3889 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3892 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3893 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3894 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3895 & .and. num_conti.le.maxconts) then
3896 c write (iout,*) i,j," entered corr"
3898 C Calculate the contact function. The ith column of the array JCONT will
3899 C contain the numbers of atoms that make contacts with the atom I (of numbers
3900 C greater than I). The arrays FACONT and GACONT will contain the values of
3901 C the contact function and its derivative.
3902 c r0ij=1.02D0*rpp(iteli,itelj)
3903 c r0ij=1.11D0*rpp(iteli,itelj)
3904 r0ij=2.20D0*rpp(iteli,itelj)
3905 c r0ij=1.55D0*rpp(iteli,itelj)
3906 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3907 if (fcont.gt.0.0D0) then
3908 num_conti=num_conti+1
3909 if (num_conti.gt.maxconts) then
3910 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3911 & ' will skip next contacts for this conf.'
3913 jcont_hb(num_conti,i)=j
3914 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3915 cd & " jcont_hb",jcont_hb(num_conti,i)
3916 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3917 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3918 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3920 d_cont(num_conti,i)=rij
3921 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3922 C --- Electrostatic-interaction matrix ---
3923 a_chuj(1,1,num_conti,i)=a22
3924 a_chuj(1,2,num_conti,i)=a23
3925 a_chuj(2,1,num_conti,i)=a32
3926 a_chuj(2,2,num_conti,i)=a33
3927 C --- Gradient of rij
3929 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3936 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3937 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3938 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3939 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3940 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3945 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3946 C Calculate contact energies
3948 wij=cosa-3.0D0*cosb*cosg
3951 c fac3=dsqrt(-ael6i)/r0ij**3
3952 fac3=dsqrt(-ael6i)*r3ij
3953 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3954 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3955 if (ees0tmp.gt.0) then
3956 ees0pij=dsqrt(ees0tmp)
3960 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3961 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3962 if (ees0tmp.gt.0) then
3963 ees0mij=dsqrt(ees0tmp)
3968 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3969 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3970 C Diagnostics. Comment out or remove after debugging!
3971 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3972 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3973 c ees0m(num_conti,i)=0.0D0
3975 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3976 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3977 C Angular derivatives of the contact function
3978 ees0pij1=fac3/ees0pij
3979 ees0mij1=fac3/ees0mij
3980 fac3p=-3.0D0*fac3*rrmij
3981 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3982 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3984 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3985 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3986 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3987 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3988 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3989 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3990 ecosap=ecosa1+ecosa2
3991 ecosbp=ecosb1+ecosb2
3992 ecosgp=ecosg1+ecosg2
3993 ecosam=ecosa1-ecosa2
3994 ecosbm=ecosb1-ecosb2
3995 ecosgm=ecosg1-ecosg2
4004 facont_hb(num_conti,i)=fcont
4005 fprimcont=fprimcont/rij
4006 cd facont_hb(num_conti,i)=1.0D0
4007 C Following line is for diagnostics.
4010 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4011 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4014 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4015 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4017 gggp(1)=gggp(1)+ees0pijp*xj
4018 gggp(2)=gggp(2)+ees0pijp*yj
4019 gggp(3)=gggp(3)+ees0pijp*zj
4020 gggm(1)=gggm(1)+ees0mijp*xj
4021 gggm(2)=gggm(2)+ees0mijp*yj
4022 gggm(3)=gggm(3)+ees0mijp*zj
4023 C Derivatives due to the contact function
4024 gacont_hbr(1,num_conti,i)=fprimcont*xj
4025 gacont_hbr(2,num_conti,i)=fprimcont*yj
4026 gacont_hbr(3,num_conti,i)=fprimcont*zj
4029 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4030 c following the change of gradient-summation algorithm.
4032 cgrad ghalfp=0.5D0*gggp(k)
4033 cgrad ghalfm=0.5D0*gggm(k)
4034 gacontp_hb1(k,num_conti,i)=!ghalfp
4035 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4036 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4037 gacontp_hb2(k,num_conti,i)=!ghalfp
4038 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4039 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4040 gacontp_hb3(k,num_conti,i)=gggp(k)
4041 gacontm_hb1(k,num_conti,i)=!ghalfm
4042 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4043 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4044 gacontm_hb2(k,num_conti,i)=!ghalfm
4045 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4046 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4047 gacontm_hb3(k,num_conti,i)=gggm(k)
4049 C Diagnostics. Comment out or remove after debugging!
4051 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4052 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4053 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4054 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4055 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4056 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4059 endif ! num_conti.le.maxconts
4062 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4065 ghalf=0.5d0*agg(l,k)
4066 aggi(l,k)=aggi(l,k)+ghalf
4067 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4068 aggj(l,k)=aggj(l,k)+ghalf
4071 if (j.eq.nres-1 .and. i.lt.j-2) then
4074 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4079 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4082 C-----------------------------------------------------------------------------
4083 subroutine eturn3(i,eello_turn3)
4084 C Third- and fourth-order contributions from turns
4085 implicit real*8 (a-h,o-z)
4086 include 'DIMENSIONS'
4087 include 'COMMON.IOUNITS'
4088 include 'COMMON.GEO'
4089 include 'COMMON.VAR'
4090 include 'COMMON.LOCAL'
4091 include 'COMMON.CHAIN'
4092 include 'COMMON.DERIV'
4093 include 'COMMON.INTERACT'
4094 include 'COMMON.CONTACTS'
4095 include 'COMMON.TORSION'
4096 include 'COMMON.VECTORS'
4097 include 'COMMON.FFIELD'
4098 include 'COMMON.CONTROL'
4100 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4101 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4102 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
4103 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4104 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4105 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4106 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4109 c write (iout,*) "eturn3",i,j,j1,j2
4114 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4116 C Third-order contributions
4123 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4124 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4125 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4126 call transpose2(auxmat(1,1),auxmat1(1,1))
4127 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4128 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4129 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4130 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4131 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4132 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4133 cd & ' eello_turn3_num',4*eello_turn3_num
4134 C Derivatives in gamma(i)
4135 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4136 call transpose2(auxmat2(1,1),auxmat3(1,1))
4137 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4138 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4139 C Derivatives in gamma(i+1)
4140 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4141 call transpose2(auxmat2(1,1),auxmat3(1,1))
4142 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4143 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4144 & +0.5d0*(pizda(1,1)+pizda(2,2))
4145 C Cartesian derivatives
4147 c ghalf1=0.5d0*agg(l,1)
4148 c ghalf2=0.5d0*agg(l,2)
4149 c ghalf3=0.5d0*agg(l,3)
4150 c ghalf4=0.5d0*agg(l,4)
4151 a_temp(1,1)=aggi(l,1)!+ghalf1
4152 a_temp(1,2)=aggi(l,2)!+ghalf2
4153 a_temp(2,1)=aggi(l,3)!+ghalf3
4154 a_temp(2,2)=aggi(l,4)!+ghalf4
4155 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4156 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4157 & +0.5d0*(pizda(1,1)+pizda(2,2))
4158 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4159 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4160 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4161 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4162 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4163 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4164 & +0.5d0*(pizda(1,1)+pizda(2,2))
4165 a_temp(1,1)=aggj(l,1)!+ghalf1
4166 a_temp(1,2)=aggj(l,2)!+ghalf2
4167 a_temp(2,1)=aggj(l,3)!+ghalf3
4168 a_temp(2,2)=aggj(l,4)!+ghalf4
4169 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4170 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4171 & +0.5d0*(pizda(1,1)+pizda(2,2))
4172 a_temp(1,1)=aggj1(l,1)
4173 a_temp(1,2)=aggj1(l,2)
4174 a_temp(2,1)=aggj1(l,3)
4175 a_temp(2,2)=aggj1(l,4)
4176 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4177 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4178 & +0.5d0*(pizda(1,1)+pizda(2,2))
4182 C-------------------------------------------------------------------------------
4183 subroutine eturn4(i,eello_turn4)
4184 C Third- and fourth-order contributions from turns
4185 implicit real*8 (a-h,o-z)
4186 include 'DIMENSIONS'
4187 include 'COMMON.IOUNITS'
4188 include 'COMMON.GEO'
4189 include 'COMMON.VAR'
4190 include 'COMMON.LOCAL'
4191 include 'COMMON.CHAIN'
4192 include 'COMMON.DERIV'
4193 include 'COMMON.INTERACT'
4194 include 'COMMON.CONTACTS'
4195 include 'COMMON.TORSION'
4196 include 'COMMON.VECTORS'
4197 include 'COMMON.FFIELD'
4198 include 'COMMON.CONTROL'
4200 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4201 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4202 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
4203 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4204 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4205 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4206 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4209 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4211 C Fourth-order contributions
4219 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4220 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4221 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4226 iti1=itortyp(itype(i+1))
4227 iti2=itortyp(itype(i+2))
4228 iti3=itortyp(itype(i+3))
4229 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4230 call transpose2(EUg(1,1,i+1),e1t(1,1))
4231 call transpose2(Eug(1,1,i+2),e2t(1,1))
4232 call transpose2(Eug(1,1,i+3),e3t(1,1))
4233 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4234 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4235 s1=scalar2(b1(1,iti2),auxvec(1))
4236 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4237 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4238 s2=scalar2(b1(1,iti1),auxvec(1))
4239 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4240 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4241 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4242 eello_turn4=eello_turn4-(s1+s2+s3)
4243 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4244 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4245 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4246 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4247 cd & ' eello_turn4_num',8*eello_turn4_num
4248 C Derivatives in gamma(i)
4249 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4250 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4251 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4252 s1=scalar2(b1(1,iti2),auxvec(1))
4253 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4254 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4255 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4256 C Derivatives in gamma(i+1)
4257 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4258 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4259 s2=scalar2(b1(1,iti1),auxvec(1))
4260 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4261 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4262 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4263 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4264 C Derivatives in gamma(i+2)
4265 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4266 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4267 s1=scalar2(b1(1,iti2),auxvec(1))
4268 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4269 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4270 s2=scalar2(b1(1,iti1),auxvec(1))
4271 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4272 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4273 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4274 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4275 C Cartesian derivatives
4276 C Derivatives of this turn contributions in DC(i+2)
4277 if (j.lt.nres-1) then
4279 a_temp(1,1)=agg(l,1)
4280 a_temp(1,2)=agg(l,2)
4281 a_temp(2,1)=agg(l,3)
4282 a_temp(2,2)=agg(l,4)
4283 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4284 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4285 s1=scalar2(b1(1,iti2),auxvec(1))
4286 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4287 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4288 s2=scalar2(b1(1,iti1),auxvec(1))
4289 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4290 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4291 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4293 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4296 C Remaining derivatives of this turn contribution
4298 a_temp(1,1)=aggi(l,1)
4299 a_temp(1,2)=aggi(l,2)
4300 a_temp(2,1)=aggi(l,3)
4301 a_temp(2,2)=aggi(l,4)
4302 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4303 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4304 s1=scalar2(b1(1,iti2),auxvec(1))
4305 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4306 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4307 s2=scalar2(b1(1,iti1),auxvec(1))
4308 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4309 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4310 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4311 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4312 a_temp(1,1)=aggi1(l,1)
4313 a_temp(1,2)=aggi1(l,2)
4314 a_temp(2,1)=aggi1(l,3)
4315 a_temp(2,2)=aggi1(l,4)
4316 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4317 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4318 s1=scalar2(b1(1,iti2),auxvec(1))
4319 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4320 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4321 s2=scalar2(b1(1,iti1),auxvec(1))
4322 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4323 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4324 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4325 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4326 a_temp(1,1)=aggj(l,1)
4327 a_temp(1,2)=aggj(l,2)
4328 a_temp(2,1)=aggj(l,3)
4329 a_temp(2,2)=aggj(l,4)
4330 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4331 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4332 s1=scalar2(b1(1,iti2),auxvec(1))
4333 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4334 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4335 s2=scalar2(b1(1,iti1),auxvec(1))
4336 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4337 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4338 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4339 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4340 a_temp(1,1)=aggj1(l,1)
4341 a_temp(1,2)=aggj1(l,2)
4342 a_temp(2,1)=aggj1(l,3)
4343 a_temp(2,2)=aggj1(l,4)
4344 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4345 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4346 s1=scalar2(b1(1,iti2),auxvec(1))
4347 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4348 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4349 s2=scalar2(b1(1,iti1),auxvec(1))
4350 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4351 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4352 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4353 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4354 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4358 C-----------------------------------------------------------------------------
4359 subroutine vecpr(u,v,w)
4360 implicit real*8(a-h,o-z)
4361 dimension u(3),v(3),w(3)
4362 w(1)=u(2)*v(3)-u(3)*v(2)
4363 w(2)=-u(1)*v(3)+u(3)*v(1)
4364 w(3)=u(1)*v(2)-u(2)*v(1)
4367 C-----------------------------------------------------------------------------
4368 subroutine unormderiv(u,ugrad,unorm,ungrad)
4369 C This subroutine computes the derivatives of a normalized vector u, given
4370 C the derivatives computed without normalization conditions, ugrad. Returns
4373 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4374 double precision vec(3)
4375 double precision scalar
4377 c write (2,*) 'ugrad',ugrad
4380 vec(i)=scalar(ugrad(1,i),u(1))
4382 c write (2,*) 'vec',vec
4385 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4388 c write (2,*) 'ungrad',ungrad
4391 C-----------------------------------------------------------------------------
4392 subroutine escp_soft_sphere(evdw2,evdw2_14)
4394 C This subroutine calculates the excluded-volume interaction energy between
4395 C peptide-group centers and side chains and its gradient in virtual-bond and
4396 C side-chain vectors.
4398 implicit real*8 (a-h,o-z)
4399 include 'DIMENSIONS'
4400 include 'COMMON.GEO'
4401 include 'COMMON.VAR'
4402 include 'COMMON.LOCAL'
4403 include 'COMMON.CHAIN'
4404 include 'COMMON.DERIV'
4405 include 'COMMON.INTERACT'
4406 include 'COMMON.FFIELD'
4407 include 'COMMON.IOUNITS'
4408 include 'COMMON.CONTROL'
4413 cd print '(a)','Enter ESCP'
4414 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4418 do i=iatscp_s,iatscp_e
4419 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4421 xi=0.5D0*(c(1,i)+c(1,i+1))
4422 yi=0.5D0*(c(2,i)+c(2,i+1))
4423 zi=0.5D0*(c(3,i)+c(3,i+1))
4424 C Return atom into box, boxxsize is size of box in x dimension
4426 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4427 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4428 C Condition for being inside the proper box
4429 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4430 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4434 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4435 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4436 C Condition for being inside the proper box
4437 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4438 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4442 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4443 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4444 cC Condition for being inside the proper box
4445 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4446 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4450 if (xi.lt.0) xi=xi+boxxsize
4452 if (yi.lt.0) yi=yi+boxysize
4454 if (zi.lt.0) zi=zi+boxzsize
4455 C xi=xi+xshift*boxxsize
4456 C yi=yi+yshift*boxysize
4457 C zi=zi+zshift*boxzsize
4458 do iint=1,nscp_gr(i)
4460 do j=iscpstart(i,iint),iscpend(i,iint)
4461 if (itype(j).eq.ntyp1) cycle
4462 itypj=iabs(itype(j))
4463 C Uncomment following three lines for SC-p interactions
4467 C Uncomment following three lines for Ca-p interactions
4472 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4473 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4474 C Condition for being inside the proper box
4475 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4476 c & (xj.lt.((-0.5d0)*boxxsize))) then
4480 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4481 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4482 cC Condition for being inside the proper box
4483 c if ((yj.gt.((0.5d0)*boxysize)).or.
4484 c & (yj.lt.((-0.5d0)*boxysize))) then
4488 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4489 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4490 C Condition for being inside the proper box
4491 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4492 c & (zj.lt.((-0.5d0)*boxzsize))) then
4495 if (xj.lt.0) xj=xj+boxxsize
4497 if (yj.lt.0) yj=yj+boxysize
4499 if (zj.lt.0) zj=zj+boxzsize
4500 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4508 xj=xj_safe+xshift*boxxsize
4509 yj=yj_safe+yshift*boxysize
4510 zj=zj_safe+zshift*boxzsize
4511 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4512 if(dist_temp.lt.dist_init) then
4522 if (subchap.eq.1) then
4535 rij=xj*xj+yj*yj+zj*zj
4539 if (rij.lt.r0ijsq) then
4540 evdwij=0.25d0*(rij-r0ijsq)**2
4548 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4553 cgrad if (j.lt.i) then
4554 cd write (iout,*) 'j<i'
4555 C Uncomment following three lines for SC-p interactions
4557 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4560 cd write (iout,*) 'j>i'
4562 cgrad ggg(k)=-ggg(k)
4563 C Uncomment following line for SC-p interactions
4564 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4568 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4570 cgrad kstart=min0(i+1,j)
4571 cgrad kend=max0(i-1,j-1)
4572 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4573 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4574 cgrad do k=kstart,kend
4576 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4580 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4581 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4592 C-----------------------------------------------------------------------------
4593 subroutine escp(evdw2,evdw2_14)
4595 C This subroutine calculates the excluded-volume interaction energy between
4596 C peptide-group centers and side chains and its gradient in virtual-bond and
4597 C side-chain vectors.
4599 implicit real*8 (a-h,o-z)
4600 include 'DIMENSIONS'
4601 include 'COMMON.GEO'
4602 include 'COMMON.VAR'
4603 include 'COMMON.LOCAL'
4604 include 'COMMON.CHAIN'
4605 include 'COMMON.DERIV'
4606 include 'COMMON.INTERACT'
4607 include 'COMMON.FFIELD'
4608 include 'COMMON.IOUNITS'
4609 include 'COMMON.CONTROL'
4610 include 'COMMON.SPLITELE'
4614 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4615 cd print '(a)','Enter ESCP'
4616 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4620 do i=iatscp_s,iatscp_e
4621 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4623 xi=0.5D0*(c(1,i)+c(1,i+1))
4624 yi=0.5D0*(c(2,i)+c(2,i+1))
4625 zi=0.5D0*(c(3,i)+c(3,i+1))
4627 if (xi.lt.0) xi=xi+boxxsize
4629 if (yi.lt.0) yi=yi+boxysize
4631 if (zi.lt.0) zi=zi+boxzsize
4632 c xi=xi+xshift*boxxsize
4633 c yi=yi+yshift*boxysize
4634 c zi=zi+zshift*boxzsize
4635 c print *,xi,yi,zi,'polozenie i'
4636 C Return atom into box, boxxsize is size of box in x dimension
4638 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4639 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4640 C Condition for being inside the proper box
4641 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4642 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4646 c print *,xi,boxxsize,"pierwszy"
4648 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4649 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4650 C Condition for being inside the proper box
4651 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4652 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4656 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4657 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4658 C Condition for being inside the proper box
4659 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4660 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4663 do iint=1,nscp_gr(i)
4665 do j=iscpstart(i,iint),iscpend(i,iint)
4666 itypj=iabs(itype(j))
4667 if (itypj.eq.ntyp1) cycle
4668 C Uncomment following three lines for SC-p interactions
4672 C Uncomment following three lines for Ca-p interactions
4677 if (xj.lt.0) xj=xj+boxxsize
4679 if (yj.lt.0) yj=yj+boxysize
4681 if (zj.lt.0) zj=zj+boxzsize
4683 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4684 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4685 C Condition for being inside the proper box
4686 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4687 c & (xj.lt.((-0.5d0)*boxxsize))) then
4691 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4692 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4693 cC Condition for being inside the proper box
4694 c if ((yj.gt.((0.5d0)*boxysize)).or.
4695 c & (yj.lt.((-0.5d0)*boxysize))) then
4699 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4700 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4701 C Condition for being inside the proper box
4702 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4703 c & (zj.lt.((-0.5d0)*boxzsize))) then
4706 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
4707 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4715 xj=xj_safe+xshift*boxxsize
4716 yj=yj_safe+yshift*boxysize
4717 zj=zj_safe+zshift*boxzsize
4718 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4719 if(dist_temp.lt.dist_init) then
4729 if (subchap.eq.1) then
4738 c print *,xj,yj,zj,'polozenie j'
4739 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4741 sss=sscale(1.0d0/(dsqrt(rrij)))
4742 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
4743 c if (sss.eq.0) print *,'czasem jest OK'
4744 if (sss.le.0.0d0) cycle
4745 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4747 e1=fac*fac*aad(itypj,iteli)
4748 e2=fac*bad(itypj,iteli)
4749 if (iabs(j-i) .le. 2) then
4752 evdw2_14=evdw2_14+(e1+e2)*sss
4755 evdw2=evdw2+evdwij*sss
4756 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4757 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4760 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4762 fac=-(evdwij+e1)*rrij*sss
4763 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4767 cgrad if (j.lt.i) then
4768 cd write (iout,*) 'j<i'
4769 C Uncomment following three lines for SC-p interactions
4771 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4774 cd write (iout,*) 'j>i'
4776 cgrad ggg(k)=-ggg(k)
4777 C Uncomment following line for SC-p interactions
4778 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4779 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4783 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4785 cgrad kstart=min0(i+1,j)
4786 cgrad kend=max0(i-1,j-1)
4787 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4788 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4789 cgrad do k=kstart,kend
4791 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4795 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4796 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4798 c endif !endif for sscale cutoff
4808 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4809 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4810 gradx_scp(j,i)=expon*gradx_scp(j,i)
4813 C******************************************************************************
4817 C To save time the factor EXPON has been extracted from ALL components
4818 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4821 C******************************************************************************
4824 C--------------------------------------------------------------------------
4825 subroutine edis(ehpb)
4827 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4829 implicit real*8 (a-h,o-z)
4830 include 'DIMENSIONS'
4831 include 'COMMON.SBRIDGE'
4832 include 'COMMON.CHAIN'
4833 include 'COMMON.DERIV'
4834 include 'COMMON.VAR'
4835 include 'COMMON.INTERACT'
4836 include 'COMMON.IOUNITS'
4839 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4840 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4841 if (link_end.eq.0) return
4842 do i=link_start,link_end
4843 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4844 C CA-CA distance used in regularization of structure.
4847 C iii and jjj point to the residues for which the distance is assigned.
4848 if (ii.gt.nres) then
4855 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4856 c & dhpb(i),dhpb1(i),forcon(i)
4857 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4858 C distance and angle dependent SS bond potential.
4859 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4860 C & iabs(itype(jjj)).eq.1) then
4861 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4862 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4863 if (.not.dyn_ss .and. i.le.nss) then
4864 C 15/02/13 CC dynamic SSbond - additional check
4866 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4867 call ssbond_ene(iii,jjj,eij)
4870 cd write (iout,*) "eij",eij
4872 C Calculate the distance between the two points and its difference from the
4876 C Get the force constant corresponding to this distance.
4878 C Calculate the contribution to energy.
4879 ehpb=ehpb+waga*rdis*rdis
4881 C Evaluate gradient.
4884 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4885 cd & ' waga=',waga,' fac=',fac
4887 ggg(j)=fac*(c(j,jj)-c(j,ii))
4889 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4890 C If this is a SC-SC distance, we need to calculate the contributions to the
4891 C Cartesian gradient in the SC vectors (ghpbx).
4894 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4895 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4898 cgrad do j=iii,jjj-1
4900 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4904 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4905 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4912 C--------------------------------------------------------------------------
4913 subroutine ssbond_ene(i,j,eij)
4915 C Calculate the distance and angle dependent SS-bond potential energy
4916 C using a free-energy function derived based on RHF/6-31G** ab initio
4917 C calculations of diethyl disulfide.
4919 C A. Liwo and U. Kozlowska, 11/24/03
4921 implicit real*8 (a-h,o-z)
4922 include 'DIMENSIONS'
4923 include 'COMMON.SBRIDGE'
4924 include 'COMMON.CHAIN'
4925 include 'COMMON.DERIV'
4926 include 'COMMON.LOCAL'
4927 include 'COMMON.INTERACT'
4928 include 'COMMON.VAR'
4929 include 'COMMON.IOUNITS'
4930 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4931 itypi=iabs(itype(i))
4935 dxi=dc_norm(1,nres+i)
4936 dyi=dc_norm(2,nres+i)
4937 dzi=dc_norm(3,nres+i)
4938 c dsci_inv=dsc_inv(itypi)
4939 dsci_inv=vbld_inv(nres+i)
4940 itypj=iabs(itype(j))
4941 c dscj_inv=dsc_inv(itypj)
4942 dscj_inv=vbld_inv(nres+j)
4946 dxj=dc_norm(1,nres+j)
4947 dyj=dc_norm(2,nres+j)
4948 dzj=dc_norm(3,nres+j)
4949 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4954 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4955 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4956 om12=dxi*dxj+dyi*dyj+dzi*dzj
4958 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4959 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4965 deltat12=om2-om1+2.0d0
4967 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4968 & +akct*deltad*deltat12
4969 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4970 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4971 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4972 c & " deltat12",deltat12," eij",eij
4973 ed=2*akcm*deltad+akct*deltat12
4975 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4976 eom1=-2*akth*deltat1-pom1-om2*pom2
4977 eom2= 2*akth*deltat2+pom1-om1*pom2
4980 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4981 ghpbx(k,i)=ghpbx(k,i)-ggk
4982 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4983 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4984 ghpbx(k,j)=ghpbx(k,j)+ggk
4985 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4986 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4987 ghpbc(k,i)=ghpbc(k,i)-ggk
4988 ghpbc(k,j)=ghpbc(k,j)+ggk
4991 C Calculate the components of the gradient in DC and X
4995 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5000 C--------------------------------------------------------------------------
5001 subroutine ebond(estr)
5003 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5005 implicit real*8 (a-h,o-z)
5006 include 'DIMENSIONS'
5007 include 'COMMON.LOCAL'
5008 include 'COMMON.GEO'
5009 include 'COMMON.INTERACT'
5010 include 'COMMON.DERIV'
5011 include 'COMMON.VAR'
5012 include 'COMMON.CHAIN'
5013 include 'COMMON.IOUNITS'
5014 include 'COMMON.NAMES'
5015 include 'COMMON.FFIELD'
5016 include 'COMMON.CONTROL'
5017 include 'COMMON.SETUP'
5018 double precision u(3),ud(3)
5021 do i=ibondp_start,ibondp_end
5022 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5023 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5025 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5026 c & *dc(j,i-1)/vbld(i)
5028 c if (energy_dec) write(iout,*)
5029 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5031 C Checking if it involves dummy (NH3+ or COO-) group
5032 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5033 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5034 diff = vbld(i)-vbldpDUM
5036 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5037 diff = vbld(i)-vbldp0
5039 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5040 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5043 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5045 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5048 estr=0.5d0*AKP*estr+estr1
5050 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5052 do i=ibond_start,ibond_end
5054 if (iti.ne.10 .and. iti.ne.ntyp1) then
5057 diff=vbld(i+nres)-vbldsc0(1,iti)
5058 if (energy_dec) write (iout,*)
5059 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5060 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5061 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5063 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5067 diff=vbld(i+nres)-vbldsc0(j,iti)
5068 ud(j)=aksc(j,iti)*diff
5069 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5083 uprod2=uprod2*u(k)*u(k)
5087 usumsqder=usumsqder+ud(j)*uprod2
5089 estr=estr+uprod/usum
5091 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5099 C--------------------------------------------------------------------------
5100 subroutine ebend(etheta)
5102 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5103 C angles gamma and its derivatives in consecutive thetas and gammas.
5105 implicit real*8 (a-h,o-z)
5106 include 'DIMENSIONS'
5107 include 'COMMON.LOCAL'
5108 include 'COMMON.GEO'
5109 include 'COMMON.INTERACT'
5110 include 'COMMON.DERIV'
5111 include 'COMMON.VAR'
5112 include 'COMMON.CHAIN'
5113 include 'COMMON.IOUNITS'
5114 include 'COMMON.NAMES'
5115 include 'COMMON.FFIELD'
5116 include 'COMMON.CONTROL'
5117 common /calcthet/ term1,term2,termm,diffak,ratak,
5118 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5119 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5120 double precision y(2),z(2)
5122 c time11=dexp(-2*time)
5125 c write (*,'(a,i2)') 'EBEND ICG=',icg
5126 do i=ithet_start,ithet_end
5127 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5128 & .or.itype(i).eq.ntyp1) cycle
5129 C Zero the energy function and its derivative at 0 or pi.
5130 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5132 ichir1=isign(1,itype(i-2))
5133 ichir2=isign(1,itype(i))
5134 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5135 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5136 if (itype(i-1).eq.10) then
5137 itype1=isign(10,itype(i-2))
5138 ichir11=isign(1,itype(i-2))
5139 ichir12=isign(1,itype(i-2))
5140 itype2=isign(10,itype(i))
5141 ichir21=isign(1,itype(i))
5142 ichir22=isign(1,itype(i))
5145 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5148 if (phii.ne.phii) phii=150.0
5158 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5161 if (phii1.ne.phii1) phii1=150.0
5173 C Calculate the "mean" value of theta from the part of the distribution
5174 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5175 C In following comments this theta will be referred to as t_c.
5176 thet_pred_mean=0.0d0
5178 athetk=athet(k,it,ichir1,ichir2)
5179 bthetk=bthet(k,it,ichir1,ichir2)
5181 athetk=athet(k,itype1,ichir11,ichir12)
5182 bthetk=bthet(k,itype2,ichir21,ichir22)
5184 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5185 c write(iout,*) 'chuj tu', y(k),z(k)
5187 dthett=thet_pred_mean*ssd
5188 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5189 C Derivatives of the "mean" values in gamma1 and gamma2.
5190 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5191 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5192 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5193 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5195 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5196 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5197 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5198 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5200 if (theta(i).gt.pi-delta) then
5201 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5203 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5204 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5205 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5207 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5209 else if (theta(i).lt.delta) then
5210 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5211 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5212 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5214 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5215 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5218 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5221 etheta=etheta+ethetai
5222 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5223 & 'ebend',i,ethetai,theta(i),itype(i)
5224 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5225 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5226 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5228 C Ufff.... We've done all this!!!
5231 C---------------------------------------------------------------------------
5232 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5234 implicit real*8 (a-h,o-z)
5235 include 'DIMENSIONS'
5236 include 'COMMON.LOCAL'
5237 include 'COMMON.IOUNITS'
5238 common /calcthet/ term1,term2,termm,diffak,ratak,
5239 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5240 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5241 C Calculate the contributions to both Gaussian lobes.
5242 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5243 C The "polynomial part" of the "standard deviation" of this part of
5244 C the distributioni.
5245 ccc write (iout,*) thetai,thet_pred_mean
5248 sig=sig*thet_pred_mean+polthet(j,it)
5250 C Derivative of the "interior part" of the "standard deviation of the"
5251 C gamma-dependent Gaussian lobe in t_c.
5252 sigtc=3*polthet(3,it)
5254 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5257 C Set the parameters of both Gaussian lobes of the distribution.
5258 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5259 fac=sig*sig+sigc0(it)
5262 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5263 sigsqtc=-4.0D0*sigcsq*sigtc
5264 c print *,i,sig,sigtc,sigsqtc
5265 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5266 sigtc=-sigtc/(fac*fac)
5267 C Following variable is sigma(t_c)**(-2)
5268 sigcsq=sigcsq*sigcsq
5270 sig0inv=1.0D0/sig0i**2
5271 delthec=thetai-thet_pred_mean
5272 delthe0=thetai-theta0i
5273 term1=-0.5D0*sigcsq*delthec*delthec
5274 term2=-0.5D0*sig0inv*delthe0*delthe0
5275 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5276 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5277 C NaNs in taking the logarithm. We extract the largest exponent which is added
5278 C to the energy (this being the log of the distribution) at the end of energy
5279 C term evaluation for this virtual-bond angle.
5280 if (term1.gt.term2) then
5282 term2=dexp(term2-termm)
5286 term1=dexp(term1-termm)
5289 C The ratio between the gamma-independent and gamma-dependent lobes of
5290 C the distribution is a Gaussian function of thet_pred_mean too.
5291 diffak=gthet(2,it)-thet_pred_mean
5292 ratak=diffak/gthet(3,it)**2
5293 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5294 C Let's differentiate it in thet_pred_mean NOW.
5296 C Now put together the distribution terms to make complete distribution.
5297 termexp=term1+ak*term2
5298 termpre=sigc+ak*sig0i
5299 C Contribution of the bending energy from this theta is just the -log of
5300 C the sum of the contributions from the two lobes and the pre-exponential
5301 C factor. Simple enough, isn't it?
5302 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5303 C write (iout,*) 'termexp',termexp,termm,termpre,i
5304 C NOW the derivatives!!!
5305 C 6/6/97 Take into account the deformation.
5306 E_theta=(delthec*sigcsq*term1
5307 & +ak*delthe0*sig0inv*term2)/termexp
5308 E_tc=((sigtc+aktc*sig0i)/termpre
5309 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5310 & aktc*term2)/termexp)
5313 c-----------------------------------------------------------------------------
5314 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5315 implicit real*8 (a-h,o-z)
5316 include 'DIMENSIONS'
5317 include 'COMMON.LOCAL'
5318 include 'COMMON.IOUNITS'
5319 common /calcthet/ term1,term2,termm,diffak,ratak,
5320 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5321 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5322 delthec=thetai-thet_pred_mean
5323 delthe0=thetai-theta0i
5324 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5325 t3 = thetai-thet_pred_mean
5329 t14 = t12+t6*sigsqtc
5331 t21 = thetai-theta0i
5337 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5338 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5339 & *(-t12*t9-ak*sig0inv*t27)
5343 C--------------------------------------------------------------------------
5344 subroutine ebend(etheta)
5346 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5347 C angles gamma and its derivatives in consecutive thetas and gammas.
5348 C ab initio-derived potentials from
5349 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5351 implicit real*8 (a-h,o-z)
5352 include 'DIMENSIONS'
5353 include 'COMMON.LOCAL'
5354 include 'COMMON.GEO'
5355 include 'COMMON.INTERACT'
5356 include 'COMMON.DERIV'
5357 include 'COMMON.VAR'
5358 include 'COMMON.CHAIN'
5359 include 'COMMON.IOUNITS'
5360 include 'COMMON.NAMES'
5361 include 'COMMON.FFIELD'
5362 include 'COMMON.CONTROL'
5363 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5364 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5365 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5366 & sinph1ph2(maxdouble,maxdouble)
5367 logical lprn /.false./, lprn1 /.false./
5369 do i=ithet_start,ithet_end
5370 c print *,i,itype(i-1),itype(i),itype(i-2)
5371 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5372 & .or.itype(i).eq.ntyp1) cycle
5373 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5375 if (iabs(itype(i+1)).eq.20) iblock=2
5376 if (iabs(itype(i+1)).ne.20) iblock=1
5380 theti2=0.5d0*theta(i)
5381 ityp2=ithetyp((itype(i-1)))
5383 coskt(k)=dcos(k*theti2)
5384 sinkt(k)=dsin(k*theti2)
5386 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5389 if (phii.ne.phii) phii=150.0
5393 ityp1=ithetyp((itype(i-2)))
5394 C propagation of chirality for glycine type
5396 cosph1(k)=dcos(k*phii)
5397 sinph1(k)=dsin(k*phii)
5407 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5410 if (phii1.ne.phii1) phii1=150.0
5415 ityp3=ithetyp((itype(i)))
5417 cosph2(k)=dcos(k*phii1)
5418 sinph2(k)=dsin(k*phii1)
5428 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5431 ccl=cosph1(l)*cosph2(k-l)
5432 ssl=sinph1(l)*sinph2(k-l)
5433 scl=sinph1(l)*cosph2(k-l)
5434 csl=cosph1(l)*sinph2(k-l)
5435 cosph1ph2(l,k)=ccl-ssl
5436 cosph1ph2(k,l)=ccl+ssl
5437 sinph1ph2(l,k)=scl+csl
5438 sinph1ph2(k,l)=scl-csl
5442 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5443 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5444 write (iout,*) "coskt and sinkt"
5446 write (iout,*) k,coskt(k),sinkt(k)
5450 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5451 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5454 & write (iout,*) "k",k,"
5455 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5456 & " ethetai",ethetai
5459 write (iout,*) "cosph and sinph"
5461 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5463 write (iout,*) "cosph1ph2 and sinph2ph2"
5466 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5467 & sinph1ph2(l,k),sinph1ph2(k,l)
5470 write(iout,*) "ethetai",ethetai
5474 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5475 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5476 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5477 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5478 ethetai=ethetai+sinkt(m)*aux
5479 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5480 dephii=dephii+k*sinkt(m)*(
5481 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5482 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5483 dephii1=dephii1+k*sinkt(m)*(
5484 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5485 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5487 & write (iout,*) "m",m," k",k," bbthet",
5488 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5489 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5490 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5491 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5495 & write(iout,*) "ethetai",ethetai
5499 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5500 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5501 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5502 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5503 ethetai=ethetai+sinkt(m)*aux
5504 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5505 dephii=dephii+l*sinkt(m)*(
5506 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5507 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5508 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5509 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5510 dephii1=dephii1+(k-l)*sinkt(m)*(
5511 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5512 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5513 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5514 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5516 write (iout,*) "m",m," k",k," l",l," ffthet",
5517 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5518 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5519 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5520 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5521 & " ethetai",ethetai
5522 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5523 & cosph1ph2(k,l)*sinkt(m),
5524 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5532 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5533 & i,theta(i)*rad2deg,phii*rad2deg,
5534 & phii1*rad2deg,ethetai
5536 etheta=etheta+ethetai
5537 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5538 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5539 gloc(nphi+i-2,icg)=wang*dethetai+ gloc(nphi+i-2,icg)
5545 c-----------------------------------------------------------------------------
5546 subroutine esc(escloc)
5547 C Calculate the local energy of a side chain and its derivatives in the
5548 C corresponding virtual-bond valence angles THETA and the spherical angles
5550 implicit real*8 (a-h,o-z)
5551 include 'DIMENSIONS'
5552 include 'COMMON.GEO'
5553 include 'COMMON.LOCAL'
5554 include 'COMMON.VAR'
5555 include 'COMMON.INTERACT'
5556 include 'COMMON.DERIV'
5557 include 'COMMON.CHAIN'
5558 include 'COMMON.IOUNITS'
5559 include 'COMMON.NAMES'
5560 include 'COMMON.FFIELD'
5561 include 'COMMON.CONTROL'
5562 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5563 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5564 common /sccalc/ time11,time12,time112,theti,it,nlobit
5567 c write (iout,'(a)') 'ESC'
5568 do i=loc_start,loc_end
5570 if (it.eq.ntyp1) cycle
5571 if (it.eq.10) goto 1
5572 nlobit=nlob(iabs(it))
5573 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5574 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5575 theti=theta(i+1)-pipol
5580 if (x(2).gt.pi-delta) then
5584 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5586 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5587 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5589 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5590 & ddersc0(1),dersc(1))
5591 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5592 & ddersc0(3),dersc(3))
5594 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5596 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5597 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5598 & dersc0(2),esclocbi,dersc02)
5599 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5601 call splinthet(x(2),0.5d0*delta,ss,ssd)
5606 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5608 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5609 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5611 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5613 c write (iout,*) escloci
5614 else if (x(2).lt.delta) then
5618 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5620 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5621 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5623 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5624 & ddersc0(1),dersc(1))
5625 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5626 & ddersc0(3),dersc(3))
5628 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5630 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5631 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5632 & dersc0(2),esclocbi,dersc02)
5633 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5638 call splinthet(x(2),0.5d0*delta,ss,ssd)
5640 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5642 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5643 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5645 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5646 c write (iout,*) escloci
5648 call enesc(x,escloci,dersc,ddummy,.false.)
5651 escloc=escloc+escloci
5652 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5653 & 'escloc',i,escloci
5654 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5656 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5658 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5659 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5664 C---------------------------------------------------------------------------
5665 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5666 implicit real*8 (a-h,o-z)
5667 include 'DIMENSIONS'
5668 include 'COMMON.GEO'
5669 include 'COMMON.LOCAL'
5670 include 'COMMON.IOUNITS'
5671 common /sccalc/ time11,time12,time112,theti,it,nlobit
5672 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5673 double precision contr(maxlob,-1:1)
5675 c write (iout,*) 'it=',it,' nlobit=',nlobit
5679 if (mixed) ddersc(j)=0.0d0
5683 C Because of periodicity of the dependence of the SC energy in omega we have
5684 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5685 C To avoid underflows, first compute & store the exponents.
5693 z(k)=x(k)-censc(k,j,it)
5698 Axk=Axk+gaussc(l,k,j,it)*z(l)
5704 expfac=expfac+Ax(k,j,iii)*z(k)
5712 C As in the case of ebend, we want to avoid underflows in exponentiation and
5713 C subsequent NaNs and INFs in energy calculation.
5714 C Find the largest exponent
5718 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5722 cd print *,'it=',it,' emin=',emin
5724 C Compute the contribution to SC energy and derivatives
5729 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5730 if(adexp.ne.adexp) adexp=1.0
5733 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5735 cd print *,'j=',j,' expfac=',expfac
5736 escloc_i=escloc_i+expfac
5738 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5742 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5743 & +gaussc(k,2,j,it))*expfac
5750 dersc(1)=dersc(1)/cos(theti)**2
5751 ddersc(1)=ddersc(1)/cos(theti)**2
5754 escloci=-(dlog(escloc_i)-emin)
5756 dersc(j)=dersc(j)/escloc_i
5760 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5765 C------------------------------------------------------------------------------
5766 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5767 implicit real*8 (a-h,o-z)
5768 include 'DIMENSIONS'
5769 include 'COMMON.GEO'
5770 include 'COMMON.LOCAL'
5771 include 'COMMON.IOUNITS'
5772 common /sccalc/ time11,time12,time112,theti,it,nlobit
5773 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5774 double precision contr(maxlob)
5785 z(k)=x(k)-censc(k,j,it)
5791 Axk=Axk+gaussc(l,k,j,it)*z(l)
5797 expfac=expfac+Ax(k,j)*z(k)
5802 C As in the case of ebend, we want to avoid underflows in exponentiation and
5803 C subsequent NaNs and INFs in energy calculation.
5804 C Find the largest exponent
5807 if (emin.gt.contr(j)) emin=contr(j)
5811 C Compute the contribution to SC energy and derivatives
5815 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5816 escloc_i=escloc_i+expfac
5818 dersc(k)=dersc(k)+Ax(k,j)*expfac
5820 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5821 & +gaussc(1,2,j,it))*expfac
5825 dersc(1)=dersc(1)/cos(theti)**2
5826 dersc12=dersc12/cos(theti)**2
5827 escloci=-(dlog(escloc_i)-emin)
5829 dersc(j)=dersc(j)/escloc_i
5831 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5835 c----------------------------------------------------------------------------------
5836 subroutine esc(escloc)
5837 C Calculate the local energy of a side chain and its derivatives in the
5838 C corresponding virtual-bond valence angles THETA and the spherical angles
5839 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5840 C added by Urszula Kozlowska. 07/11/2007
5842 implicit real*8 (a-h,o-z)
5843 include 'DIMENSIONS'
5844 include 'COMMON.GEO'
5845 include 'COMMON.LOCAL'
5846 include 'COMMON.VAR'
5847 include 'COMMON.SCROT'
5848 include 'COMMON.INTERACT'
5849 include 'COMMON.DERIV'
5850 include 'COMMON.CHAIN'
5851 include 'COMMON.IOUNITS'
5852 include 'COMMON.NAMES'
5853 include 'COMMON.FFIELD'
5854 include 'COMMON.CONTROL'
5855 include 'COMMON.VECTORS'
5856 double precision x_prime(3),y_prime(3),z_prime(3)
5857 & , sumene,dsc_i,dp2_i,x(65),
5858 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5859 & de_dxx,de_dyy,de_dzz,de_dt
5860 double precision s1_t,s1_6_t,s2_t,s2_6_t
5862 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5863 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5864 & dt_dCi(3),dt_dCi1(3)
5865 common /sccalc/ time11,time12,time112,theti,it,nlobit
5868 do i=loc_start,loc_end
5869 if (itype(i).eq.ntyp1) cycle
5870 costtab(i+1) =dcos(theta(i+1))
5871 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5872 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5873 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5874 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5875 cosfac=dsqrt(cosfac2)
5876 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5877 sinfac=dsqrt(sinfac2)
5879 if (it.eq.10) goto 1
5881 C Compute the axes of tghe local cartesian coordinates system; store in
5882 c x_prime, y_prime and z_prime
5889 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5890 C & dc_norm(3,i+nres)
5892 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5893 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5896 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5899 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5900 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5901 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5902 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5903 c & " xy",scalar(x_prime(1),y_prime(1)),
5904 c & " xz",scalar(x_prime(1),z_prime(1)),
5905 c & " yy",scalar(y_prime(1),y_prime(1)),
5906 c & " yz",scalar(y_prime(1),z_prime(1)),
5907 c & " zz",scalar(z_prime(1),z_prime(1))
5909 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5910 C to local coordinate system. Store in xx, yy, zz.
5916 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5917 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5918 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5925 C Compute the energy of the ith side cbain
5927 c write (2,*) "xx",xx," yy",yy," zz",zz
5930 x(j) = sc_parmin(j,it)
5933 Cc diagnostics - remove later
5935 yy1 = dsin(alph(2))*dcos(omeg(2))
5936 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5937 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5938 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5940 C," --- ", xx_w,yy_w,zz_w
5943 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5944 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5946 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5947 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5949 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5950 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5951 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5952 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5953 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5955 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5956 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5957 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5958 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5959 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5961 dsc_i = 0.743d0+x(61)
5963 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5964 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5965 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5966 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5967 s1=(1+x(63))/(0.1d0 + dscp1)
5968 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5969 s2=(1+x(65))/(0.1d0 + dscp2)
5970 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5971 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5972 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5973 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5975 c & dscp1,dscp2,sumene
5976 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5977 escloc = escloc + sumene
5978 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5983 C This section to check the numerical derivatives of the energy of ith side
5984 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5985 C #define DEBUG in the code to turn it on.
5987 write (2,*) "sumene =",sumene
5991 write (2,*) xx,yy,zz
5992 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5993 de_dxx_num=(sumenep-sumene)/aincr
5995 write (2,*) "xx+ sumene from enesc=",sumenep
5998 write (2,*) xx,yy,zz
5999 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6000 de_dyy_num=(sumenep-sumene)/aincr
6002 write (2,*) "yy+ sumene from enesc=",sumenep
6005 write (2,*) xx,yy,zz
6006 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6007 de_dzz_num=(sumenep-sumene)/aincr
6009 write (2,*) "zz+ sumene from enesc=",sumenep
6010 costsave=cost2tab(i+1)
6011 sintsave=sint2tab(i+1)
6012 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6013 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6014 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6015 de_dt_num=(sumenep-sumene)/aincr
6016 write (2,*) " t+ sumene from enesc=",sumenep
6017 cost2tab(i+1)=costsave
6018 sint2tab(i+1)=sintsave
6019 C End of diagnostics section.
6022 C Compute the gradient of esc
6024 c zz=zz*dsign(1.0,dfloat(itype(i)))
6025 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6026 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6027 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6028 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6029 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6030 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6031 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6032 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6033 pom1=(sumene3*sint2tab(i+1)+sumene1)
6034 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6035 pom2=(sumene4*cost2tab(i+1)+sumene2)
6036 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6037 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6038 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6039 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6041 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6042 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6043 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6045 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6046 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6047 & +(pom1+pom2)*pom_dx
6049 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6052 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6053 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6054 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6056 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6057 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6058 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6059 & +x(59)*zz**2 +x(60)*xx*zz
6060 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6061 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6062 & +(pom1-pom2)*pom_dy
6064 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6067 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6068 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6069 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6070 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6071 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6072 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6073 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6074 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6076 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6079 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6080 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6081 & +pom1*pom_dt1+pom2*pom_dt2
6083 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6088 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6089 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6090 cosfac2xx=cosfac2*xx
6091 sinfac2yy=sinfac2*yy
6093 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6095 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6097 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6098 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6099 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6100 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6101 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6102 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6103 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6104 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6105 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6106 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6110 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6111 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6112 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6113 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6116 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6117 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6118 dZZ_XYZ(k)=vbld_inv(i+nres)*
6119 & (z_prime(k)-zz*dC_norm(k,i+nres))
6121 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6122 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6126 dXX_Ctab(k,i)=dXX_Ci(k)
6127 dXX_C1tab(k,i)=dXX_Ci1(k)
6128 dYY_Ctab(k,i)=dYY_Ci(k)
6129 dYY_C1tab(k,i)=dYY_Ci1(k)
6130 dZZ_Ctab(k,i)=dZZ_Ci(k)
6131 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6132 dXX_XYZtab(k,i)=dXX_XYZ(k)
6133 dYY_XYZtab(k,i)=dYY_XYZ(k)
6134 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6138 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6139 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6140 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6141 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6142 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6144 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6145 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6146 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6147 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6148 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6149 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6150 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6151 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6153 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6154 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6156 C to check gradient call subroutine check_grad
6162 c------------------------------------------------------------------------------
6163 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6165 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6166 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6167 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6168 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6170 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6171 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6173 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6174 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6175 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6176 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6177 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6179 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6180 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6181 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6182 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6183 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6185 dsc_i = 0.743d0+x(61)
6187 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6188 & *(xx*cost2+yy*sint2))
6189 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6190 & *(xx*cost2-yy*sint2))
6191 s1=(1+x(63))/(0.1d0 + dscp1)
6192 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6193 s2=(1+x(65))/(0.1d0 + dscp2)
6194 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6195 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6196 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6201 c------------------------------------------------------------------------------
6202 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6204 C This procedure calculates two-body contact function g(rij) and its derivative:
6207 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6210 C where x=(rij-r0ij)/delta
6212 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6215 double precision rij,r0ij,eps0ij,fcont,fprimcont
6216 double precision x,x2,x4,delta
6220 if (x.lt.-1.0D0) then
6223 else if (x.le.1.0D0) then
6226 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6227 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6234 c------------------------------------------------------------------------------
6235 subroutine splinthet(theti,delta,ss,ssder)
6236 implicit real*8 (a-h,o-z)
6237 include 'DIMENSIONS'
6238 include 'COMMON.VAR'
6239 include 'COMMON.GEO'
6242 if (theti.gt.pipol) then
6243 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6245 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6250 c------------------------------------------------------------------------------
6251 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6253 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6254 double precision ksi,ksi2,ksi3,a1,a2,a3
6255 a1=fprim0*delta/(f1-f0)
6261 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6262 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6265 c------------------------------------------------------------------------------
6266 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6268 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6269 double precision ksi,ksi2,ksi3,a1,a2,a3
6274 a2=3*(f1x-f0x)-2*fprim0x*delta
6275 a3=fprim0x*delta-2*(f1x-f0x)
6276 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6279 C-----------------------------------------------------------------------------
6281 C-----------------------------------------------------------------------------
6282 subroutine etor(etors,edihcnstr)
6283 implicit real*8 (a-h,o-z)
6284 include 'DIMENSIONS'
6285 include 'COMMON.VAR'
6286 include 'COMMON.GEO'
6287 include 'COMMON.LOCAL'
6288 include 'COMMON.TORSION'
6289 include 'COMMON.INTERACT'
6290 include 'COMMON.DERIV'
6291 include 'COMMON.CHAIN'
6292 include 'COMMON.NAMES'
6293 include 'COMMON.IOUNITS'
6294 include 'COMMON.FFIELD'
6295 include 'COMMON.TORCNSTR'
6296 include 'COMMON.CONTROL'
6298 C Set lprn=.true. for debugging
6302 do i=iphi_start,iphi_end
6304 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6305 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6306 itori=itortyp(itype(i-2))
6307 itori1=itortyp(itype(i-1))
6310 C Proline-Proline pair is a special case...
6311 if (itori.eq.3 .and. itori1.eq.3) then
6312 if (phii.gt.-dwapi3) then
6314 fac=1.0D0/(1.0D0-cosphi)
6315 etorsi=v1(1,3,3)*fac
6316 etorsi=etorsi+etorsi
6317 etors=etors+etorsi-v1(1,3,3)
6318 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6319 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6322 v1ij=v1(j+1,itori,itori1)
6323 v2ij=v2(j+1,itori,itori1)
6326 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6327 if (energy_dec) etors_ii=etors_ii+
6328 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6329 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6333 v1ij=v1(j,itori,itori1)
6334 v2ij=v2(j,itori,itori1)
6337 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6338 if (energy_dec) etors_ii=etors_ii+
6339 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6340 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6343 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6346 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6347 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6348 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6349 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6350 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6352 ! 6/20/98 - dihedral angle constraints
6355 itori=idih_constr(i)
6358 if (difi.gt.drange(i)) then
6360 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6361 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6362 else if (difi.lt.-drange(i)) then
6364 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6365 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6367 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6368 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6370 ! write (iout,*) 'edihcnstr',edihcnstr
6373 c------------------------------------------------------------------------------
6374 subroutine etor_d(etors_d)
6378 c----------------------------------------------------------------------------
6380 subroutine etor(etors,edihcnstr)
6381 implicit real*8 (a-h,o-z)
6382 include 'DIMENSIONS'
6383 include 'COMMON.VAR'
6384 include 'COMMON.GEO'
6385 include 'COMMON.LOCAL'
6386 include 'COMMON.TORSION'
6387 include 'COMMON.INTERACT'
6388 include 'COMMON.DERIV'
6389 include 'COMMON.CHAIN'
6390 include 'COMMON.NAMES'
6391 include 'COMMON.IOUNITS'
6392 include 'COMMON.FFIELD'
6393 include 'COMMON.TORCNSTR'
6394 include 'COMMON.CONTROL'
6396 C Set lprn=.true. for debugging
6400 do i=iphi_start,iphi_end
6401 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6402 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6403 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6404 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6405 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6406 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6407 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6408 C For introducing the NH3+ and COO- group please check the etor_d for reference
6411 if (iabs(itype(i)).eq.20) then
6416 itori=itortyp(itype(i-2))
6417 itori1=itortyp(itype(i-1))
6420 C Regular cosine and sine terms
6421 do j=1,nterm(itori,itori1,iblock)
6422 v1ij=v1(j,itori,itori1,iblock)
6423 v2ij=v2(j,itori,itori1,iblock)
6426 etors=etors+v1ij*cosphi+v2ij*sinphi
6427 if (energy_dec) etors_ii=etors_ii+
6428 & v1ij*cosphi+v2ij*sinphi
6429 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6433 C E = SUM ----------------------------------- - v1
6434 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6436 cosphi=dcos(0.5d0*phii)
6437 sinphi=dsin(0.5d0*phii)
6438 do j=1,nlor(itori,itori1,iblock)
6439 vl1ij=vlor1(j,itori,itori1)
6440 vl2ij=vlor2(j,itori,itori1)
6441 vl3ij=vlor3(j,itori,itori1)
6442 pom=vl2ij*cosphi+vl3ij*sinphi
6443 pom1=1.0d0/(pom*pom+1.0d0)
6444 etors=etors+vl1ij*pom1
6445 if (energy_dec) etors_ii=etors_ii+
6448 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6450 C Subtract the constant term
6451 etors=etors-v0(itori,itori1,iblock)
6452 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6453 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6455 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6456 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6457 & (v1(j,itori,itori1,iblock),j=1,6),
6458 & (v2(j,itori,itori1,iblock),j=1,6)
6459 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6460 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6462 ! 6/20/98 - dihedral angle constraints
6464 c do i=1,ndih_constr
6465 do i=idihconstr_start,idihconstr_end
6466 itori=idih_constr(i)
6468 difi=pinorm(phii-phi0(i))
6469 if (difi.gt.drange(i)) then
6471 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6472 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6473 else if (difi.lt.-drange(i)) then
6475 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6476 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6480 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6481 cd & rad2deg*phi0(i), rad2deg*drange(i),
6482 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6484 cd write (iout,*) 'edihcnstr',edihcnstr
6487 c----------------------------------------------------------------------------
6488 subroutine etor_d(etors_d)
6489 C 6/23/01 Compute double torsional energy
6490 implicit real*8 (a-h,o-z)
6491 include 'DIMENSIONS'
6492 include 'COMMON.VAR'
6493 include 'COMMON.GEO'
6494 include 'COMMON.LOCAL'
6495 include 'COMMON.TORSION'
6496 include 'COMMON.INTERACT'
6497 include 'COMMON.DERIV'
6498 include 'COMMON.CHAIN'
6499 include 'COMMON.NAMES'
6500 include 'COMMON.IOUNITS'
6501 include 'COMMON.FFIELD'
6502 include 'COMMON.TORCNSTR'
6504 C Set lprn=.true. for debugging
6508 c write(iout,*) "a tu??"
6509 do i=iphid_start,iphid_end
6510 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6511 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6512 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6513 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6514 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6515 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6516 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6517 & (itype(i+1).eq.ntyp1)) cycle
6518 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6519 itori=itortyp(itype(i-2))
6520 itori1=itortyp(itype(i-1))
6521 itori2=itortyp(itype(i))
6527 if (iabs(itype(i+1)).eq.20) iblock=2
6528 C Iblock=2 Proline type
6529 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6530 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6531 C if (itype(i+1).eq.ntyp1) iblock=3
6532 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6533 C IS or IS NOT need for this
6534 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6535 C is (itype(i-3).eq.ntyp1) ntblock=2
6536 C ntblock is N-terminal blocking group
6538 C Regular cosine and sine terms
6539 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6540 C Example of changes for NH3+ blocking group
6541 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6542 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6543 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6544 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6545 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6546 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6547 cosphi1=dcos(j*phii)
6548 sinphi1=dsin(j*phii)
6549 cosphi2=dcos(j*phii1)
6550 sinphi2=dsin(j*phii1)
6551 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6552 & v2cij*cosphi2+v2sij*sinphi2
6553 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6554 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6556 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6558 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6559 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6560 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6561 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6562 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6563 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6564 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6565 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6566 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6567 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6568 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6569 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6570 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6571 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6574 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6575 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6580 c------------------------------------------------------------------------------
6581 subroutine eback_sc_corr(esccor)
6582 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6583 c conformational states; temporarily implemented as differences
6584 c between UNRES torsional potentials (dependent on three types of
6585 c residues) and the torsional potentials dependent on all 20 types
6586 c of residues computed from AM1 energy surfaces of terminally-blocked
6587 c amino-acid residues.
6588 implicit real*8 (a-h,o-z)
6589 include 'DIMENSIONS'
6590 include 'COMMON.VAR'
6591 include 'COMMON.GEO'
6592 include 'COMMON.LOCAL'
6593 include 'COMMON.TORSION'
6594 include 'COMMON.SCCOR'
6595 include 'COMMON.INTERACT'
6596 include 'COMMON.DERIV'
6597 include 'COMMON.CHAIN'
6598 include 'COMMON.NAMES'
6599 include 'COMMON.IOUNITS'
6600 include 'COMMON.FFIELD'
6601 include 'COMMON.CONTROL'
6603 C Set lprn=.true. for debugging
6606 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6608 do i=itau_start,itau_end
6609 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6611 isccori=isccortyp(itype(i-2))
6612 isccori1=isccortyp(itype(i-1))
6613 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6615 do intertyp=1,3 !intertyp
6616 cc Added 09 May 2012 (Adasko)
6617 cc Intertyp means interaction type of backbone mainchain correlation:
6618 c 1 = SC...Ca...Ca...Ca
6619 c 2 = Ca...Ca...Ca...SC
6620 c 3 = SC...Ca...Ca...SCi
6622 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6623 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6624 & (itype(i-1).eq.ntyp1)))
6625 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6626 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6627 & .or.(itype(i).eq.ntyp1)))
6628 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6629 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6630 & (itype(i-3).eq.ntyp1)))) cycle
6631 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6632 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6634 do j=1,nterm_sccor(isccori,isccori1)
6635 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6636 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6637 cosphi=dcos(j*tauangle(intertyp,i))
6638 sinphi=dsin(j*tauangle(intertyp,i))
6639 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6640 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6642 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6643 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6645 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6646 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6647 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6648 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6649 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6655 c----------------------------------------------------------------------------
6656 subroutine multibody(ecorr)
6657 C This subroutine calculates multi-body contributions to energy following
6658 C the idea of Skolnick et al. If side chains I and J make a contact and
6659 C at the same time side chains I+1 and J+1 make a contact, an extra
6660 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6661 implicit real*8 (a-h,o-z)
6662 include 'DIMENSIONS'
6663 include 'COMMON.IOUNITS'
6664 include 'COMMON.DERIV'
6665 include 'COMMON.INTERACT'
6666 include 'COMMON.CONTACTS'
6667 double precision gx(3),gx1(3)
6670 C Set lprn=.true. for debugging
6674 write (iout,'(a)') 'Contact function values:'
6676 write (iout,'(i2,20(1x,i2,f10.5))')
6677 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6692 num_conti=num_cont(i)
6693 num_conti1=num_cont(i1)
6698 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6699 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6700 cd & ' ishift=',ishift
6701 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6702 C The system gains extra energy.
6703 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6704 endif ! j1==j+-ishift
6713 c------------------------------------------------------------------------------
6714 double precision function esccorr(i,j,k,l,jj,kk)
6715 implicit real*8 (a-h,o-z)
6716 include 'DIMENSIONS'
6717 include 'COMMON.IOUNITS'
6718 include 'COMMON.DERIV'
6719 include 'COMMON.INTERACT'
6720 include 'COMMON.CONTACTS'
6721 double precision gx(3),gx1(3)
6726 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6727 C Calculate the multi-body contribution to energy.
6728 C Calculate multi-body contributions to the gradient.
6729 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6730 cd & k,l,(gacont(m,kk,k),m=1,3)
6732 gx(m) =ekl*gacont(m,jj,i)
6733 gx1(m)=eij*gacont(m,kk,k)
6734 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6735 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6736 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6737 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6741 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6746 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6752 c------------------------------------------------------------------------------
6753 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6754 C This subroutine calculates multi-body contributions to hydrogen-bonding
6755 implicit real*8 (a-h,o-z)
6756 include 'DIMENSIONS'
6757 include 'COMMON.IOUNITS'
6760 parameter (max_cont=maxconts)
6761 parameter (max_dim=26)
6762 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6763 double precision zapas(max_dim,maxconts,max_fg_procs),
6764 & zapas_recv(max_dim,maxconts,max_fg_procs)
6765 common /przechowalnia/ zapas
6766 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6767 & status_array(MPI_STATUS_SIZE,maxconts*2)
6769 include 'COMMON.SETUP'
6770 include 'COMMON.FFIELD'
6771 include 'COMMON.DERIV'
6772 include 'COMMON.INTERACT'
6773 include 'COMMON.CONTACTS'
6774 include 'COMMON.CONTROL'
6775 include 'COMMON.LOCAL'
6776 double precision gx(3),gx1(3),time00
6779 C Set lprn=.true. for debugging
6784 if (nfgtasks.le.1) goto 30
6786 write (iout,'(a)') 'Contact function values before RECEIVE:'
6788 write (iout,'(2i3,50(1x,i2,f5.2))')
6789 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6790 & j=1,num_cont_hb(i))
6794 do i=1,ntask_cont_from
6797 do i=1,ntask_cont_to
6800 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6802 C Make the list of contacts to send to send to other procesors
6803 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6805 do i=iturn3_start,iturn3_end
6806 c write (iout,*) "make contact list turn3",i," num_cont",
6808 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6810 do i=iturn4_start,iturn4_end
6811 c write (iout,*) "make contact list turn4",i," num_cont",
6813 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6817 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6819 do j=1,num_cont_hb(i)
6822 iproc=iint_sent_local(k,jjc,ii)
6823 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6824 if (iproc.gt.0) then
6825 ncont_sent(iproc)=ncont_sent(iproc)+1
6826 nn=ncont_sent(iproc)
6828 zapas(2,nn,iproc)=jjc
6829 zapas(3,nn,iproc)=facont_hb(j,i)
6830 zapas(4,nn,iproc)=ees0p(j,i)
6831 zapas(5,nn,iproc)=ees0m(j,i)
6832 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6833 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6834 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6835 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6836 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6837 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6838 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6839 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6840 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6841 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6842 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6843 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6844 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6845 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6846 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6847 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6848 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6849 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6850 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6851 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6852 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6859 & "Numbers of contacts to be sent to other processors",
6860 & (ncont_sent(i),i=1,ntask_cont_to)
6861 write (iout,*) "Contacts sent"
6862 do ii=1,ntask_cont_to
6864 iproc=itask_cont_to(ii)
6865 write (iout,*) nn," contacts to processor",iproc,
6866 & " of CONT_TO_COMM group"
6868 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6876 CorrelID1=nfgtasks+fg_rank+1
6878 C Receive the numbers of needed contacts from other processors
6879 do ii=1,ntask_cont_from
6880 iproc=itask_cont_from(ii)
6882 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6883 & FG_COMM,req(ireq),IERR)
6885 c write (iout,*) "IRECV ended"
6887 C Send the number of contacts needed by other processors
6888 do ii=1,ntask_cont_to
6889 iproc=itask_cont_to(ii)
6891 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6892 & FG_COMM,req(ireq),IERR)
6894 c write (iout,*) "ISEND ended"
6895 c write (iout,*) "number of requests (nn)",ireq
6898 & call MPI_Waitall(ireq,req,status_array,ierr)
6900 c & "Numbers of contacts to be received from other processors",
6901 c & (ncont_recv(i),i=1,ntask_cont_from)
6905 do ii=1,ntask_cont_from
6906 iproc=itask_cont_from(ii)
6908 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6909 c & " of CONT_TO_COMM group"
6913 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6914 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6915 c write (iout,*) "ireq,req",ireq,req(ireq)
6918 C Send the contacts to processors that need them
6919 do ii=1,ntask_cont_to
6920 iproc=itask_cont_to(ii)
6922 c write (iout,*) nn," contacts to processor",iproc,
6923 c & " of CONT_TO_COMM group"
6926 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6927 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6928 c write (iout,*) "ireq,req",ireq,req(ireq)
6930 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6934 c write (iout,*) "number of requests (contacts)",ireq
6935 c write (iout,*) "req",(req(i),i=1,4)
6938 & call MPI_Waitall(ireq,req,status_array,ierr)
6939 do iii=1,ntask_cont_from
6940 iproc=itask_cont_from(iii)
6943 write (iout,*) "Received",nn," contacts from processor",iproc,
6944 & " of CONT_FROM_COMM group"
6947 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6952 ii=zapas_recv(1,i,iii)
6953 c Flag the received contacts to prevent double-counting
6954 jj=-zapas_recv(2,i,iii)
6955 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6957 nnn=num_cont_hb(ii)+1
6960 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6961 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6962 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6963 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6964 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6965 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6966 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6967 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6968 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6969 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6970 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6971 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6972 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6973 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6974 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6975 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6976 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6977 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6978 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6979 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6980 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6981 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6982 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6983 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6988 write (iout,'(a)') 'Contact function values after receive:'
6990 write (iout,'(2i3,50(1x,i3,f5.2))')
6991 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6992 & j=1,num_cont_hb(i))
6999 write (iout,'(a)') 'Contact function values:'
7001 write (iout,'(2i3,50(1x,i3,f5.2))')
7002 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7003 & j=1,num_cont_hb(i))
7007 C Remove the loop below after debugging !!!
7014 C Calculate the local-electrostatic correlation terms
7015 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7017 num_conti=num_cont_hb(i)
7018 num_conti1=num_cont_hb(i+1)
7025 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7026 c & ' jj=',jj,' kk=',kk
7027 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7028 & .or. j.lt.0 .and. j1.gt.0) .and.
7029 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7030 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7031 C The system gains extra energy.
7032 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7033 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7034 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7036 else if (j1.eq.j) then
7037 C Contacts I-J and I-(J+1) occur simultaneously.
7038 C The system loses extra energy.
7039 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7044 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7045 c & ' jj=',jj,' kk=',kk
7047 C Contacts I-J and (I+1)-J occur simultaneously.
7048 C The system loses extra energy.
7049 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7056 c------------------------------------------------------------------------------
7057 subroutine add_hb_contact(ii,jj,itask)
7058 implicit real*8 (a-h,o-z)
7059 include "DIMENSIONS"
7060 include "COMMON.IOUNITS"
7063 parameter (max_cont=maxconts)
7064 parameter (max_dim=26)
7065 include "COMMON.CONTACTS"
7066 double precision zapas(max_dim,maxconts,max_fg_procs),
7067 & zapas_recv(max_dim,maxconts,max_fg_procs)
7068 common /przechowalnia/ zapas
7069 integer i,j,ii,jj,iproc,itask(4),nn
7070 c write (iout,*) "itask",itask
7073 if (iproc.gt.0) then
7074 do j=1,num_cont_hb(ii)
7076 c write (iout,*) "i",ii," j",jj," jjc",jjc
7078 ncont_sent(iproc)=ncont_sent(iproc)+1
7079 nn=ncont_sent(iproc)
7080 zapas(1,nn,iproc)=ii
7081 zapas(2,nn,iproc)=jjc
7082 zapas(3,nn,iproc)=facont_hb(j,ii)
7083 zapas(4,nn,iproc)=ees0p(j,ii)
7084 zapas(5,nn,iproc)=ees0m(j,ii)
7085 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7086 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7087 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7088 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7089 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7090 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7091 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7092 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7093 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7094 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7095 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7096 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7097 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7098 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7099 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7100 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7101 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7102 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7103 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7104 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7105 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7113 c------------------------------------------------------------------------------
7114 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7116 C This subroutine calculates multi-body contributions to hydrogen-bonding
7117 implicit real*8 (a-h,o-z)
7118 include 'DIMENSIONS'
7119 include 'COMMON.IOUNITS'
7122 parameter (max_cont=maxconts)
7123 parameter (max_dim=70)
7124 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7125 double precision zapas(max_dim,maxconts,max_fg_procs),
7126 & zapas_recv(max_dim,maxconts,max_fg_procs)
7127 common /przechowalnia/ zapas
7128 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7129 & status_array(MPI_STATUS_SIZE,maxconts*2)
7131 include 'COMMON.SETUP'
7132 include 'COMMON.FFIELD'
7133 include 'COMMON.DERIV'
7134 include 'COMMON.LOCAL'
7135 include 'COMMON.INTERACT'
7136 include 'COMMON.CONTACTS'
7137 include 'COMMON.CHAIN'
7138 include 'COMMON.CONTROL'
7139 double precision gx(3),gx1(3)
7140 integer num_cont_hb_old(maxres)
7142 double precision eello4,eello5,eelo6,eello_turn6
7143 external eello4,eello5,eello6,eello_turn6
7144 C Set lprn=.true. for debugging
7149 num_cont_hb_old(i)=num_cont_hb(i)
7153 if (nfgtasks.le.1) goto 30
7155 write (iout,'(a)') 'Contact function values before RECEIVE:'
7157 write (iout,'(2i3,50(1x,i2,f5.2))')
7158 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7159 & j=1,num_cont_hb(i))
7163 do i=1,ntask_cont_from
7166 do i=1,ntask_cont_to
7169 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7171 C Make the list of contacts to send to send to other procesors
7172 do i=iturn3_start,iturn3_end
7173 c write (iout,*) "make contact list turn3",i," num_cont",
7175 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7177 do i=iturn4_start,iturn4_end
7178 c write (iout,*) "make contact list turn4",i," num_cont",
7180 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7184 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7186 do j=1,num_cont_hb(i)
7189 iproc=iint_sent_local(k,jjc,ii)
7190 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7191 if (iproc.ne.0) then
7192 ncont_sent(iproc)=ncont_sent(iproc)+1
7193 nn=ncont_sent(iproc)
7195 zapas(2,nn,iproc)=jjc
7196 zapas(3,nn,iproc)=d_cont(j,i)
7200 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7205 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7213 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7224 & "Numbers of contacts to be sent to other processors",
7225 & (ncont_sent(i),i=1,ntask_cont_to)
7226 write (iout,*) "Contacts sent"
7227 do ii=1,ntask_cont_to
7229 iproc=itask_cont_to(ii)
7230 write (iout,*) nn," contacts to processor",iproc,
7231 & " of CONT_TO_COMM group"
7233 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7241 CorrelID1=nfgtasks+fg_rank+1
7243 C Receive the numbers of needed contacts from other processors
7244 do ii=1,ntask_cont_from
7245 iproc=itask_cont_from(ii)
7247 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7248 & FG_COMM,req(ireq),IERR)
7250 c write (iout,*) "IRECV ended"
7252 C Send the number of contacts needed by other processors
7253 do ii=1,ntask_cont_to
7254 iproc=itask_cont_to(ii)
7256 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7257 & FG_COMM,req(ireq),IERR)
7259 c write (iout,*) "ISEND ended"
7260 c write (iout,*) "number of requests (nn)",ireq
7263 & call MPI_Waitall(ireq,req,status_array,ierr)
7265 c & "Numbers of contacts to be received from other processors",
7266 c & (ncont_recv(i),i=1,ntask_cont_from)
7270 do ii=1,ntask_cont_from
7271 iproc=itask_cont_from(ii)
7273 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7274 c & " of CONT_TO_COMM group"
7278 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7279 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7280 c write (iout,*) "ireq,req",ireq,req(ireq)
7283 C Send the contacts to processors that need them
7284 do ii=1,ntask_cont_to
7285 iproc=itask_cont_to(ii)
7287 c write (iout,*) nn," contacts to processor",iproc,
7288 c & " of CONT_TO_COMM group"
7291 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7292 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7293 c write (iout,*) "ireq,req",ireq,req(ireq)
7295 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7299 c write (iout,*) "number of requests (contacts)",ireq
7300 c write (iout,*) "req",(req(i),i=1,4)
7303 & call MPI_Waitall(ireq,req,status_array,ierr)
7304 do iii=1,ntask_cont_from
7305 iproc=itask_cont_from(iii)
7308 write (iout,*) "Received",nn," contacts from processor",iproc,
7309 & " of CONT_FROM_COMM group"
7312 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7317 ii=zapas_recv(1,i,iii)
7318 c Flag the received contacts to prevent double-counting
7319 jj=-zapas_recv(2,i,iii)
7320 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7322 nnn=num_cont_hb(ii)+1
7325 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7329 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7334 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7342 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7351 write (iout,'(a)') 'Contact function values after receive:'
7353 write (iout,'(2i3,50(1x,i3,5f6.3))')
7354 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7355 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7362 write (iout,'(a)') 'Contact function values:'
7364 write (iout,'(2i3,50(1x,i2,5f6.3))')
7365 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7366 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7372 C Remove the loop below after debugging !!!
7379 C Calculate the dipole-dipole interaction energies
7380 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7381 do i=iatel_s,iatel_e+1
7382 num_conti=num_cont_hb(i)
7391 C Calculate the local-electrostatic correlation terms
7392 c write (iout,*) "gradcorr5 in eello5 before loop"
7394 c write (iout,'(i5,3f10.5)')
7395 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7397 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7398 c write (iout,*) "corr loop i",i
7400 num_conti=num_cont_hb(i)
7401 num_conti1=num_cont_hb(i+1)
7408 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7409 c & ' jj=',jj,' kk=',kk
7410 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7411 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7412 & .or. j.lt.0 .and. j1.gt.0) .and.
7413 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7414 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7415 C The system gains extra energy.
7417 sqd1=dsqrt(d_cont(jj,i))
7418 sqd2=dsqrt(d_cont(kk,i1))
7419 sred_geom = sqd1*sqd2
7420 IF (sred_geom.lt.cutoff_corr) THEN
7421 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7423 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7424 cd & ' jj=',jj,' kk=',kk
7425 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7426 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7428 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7429 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7432 cd write (iout,*) 'sred_geom=',sred_geom,
7433 cd & ' ekont=',ekont,' fprim=',fprimcont,
7434 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7435 cd write (iout,*) "g_contij",g_contij
7436 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7437 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7438 call calc_eello(i,jp,i+1,jp1,jj,kk)
7439 if (wcorr4.gt.0.0d0)
7440 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7441 if (energy_dec.and.wcorr4.gt.0.0d0)
7442 1 write (iout,'(a6,4i5,0pf7.3)')
7443 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7444 c write (iout,*) "gradcorr5 before eello5"
7446 c write (iout,'(i5,3f10.5)')
7447 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7449 if (wcorr5.gt.0.0d0)
7450 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7451 c write (iout,*) "gradcorr5 after eello5"
7453 c write (iout,'(i5,3f10.5)')
7454 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7456 if (energy_dec.and.wcorr5.gt.0.0d0)
7457 1 write (iout,'(a6,4i5,0pf7.3)')
7458 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7459 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7460 cd write(2,*)'ijkl',i,jp,i+1,jp1
7461 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7462 & .or. wturn6.eq.0.0d0))then
7463 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7464 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7465 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7466 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7467 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7468 cd & 'ecorr6=',ecorr6
7469 cd write (iout,'(4e15.5)') sred_geom,
7470 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7471 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7472 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7473 else if (wturn6.gt.0.0d0
7474 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7475 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7476 eturn6=eturn6+eello_turn6(i,jj,kk)
7477 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7478 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7479 cd write (2,*) 'multibody_eello:eturn6',eturn6
7488 num_cont_hb(i)=num_cont_hb_old(i)
7490 c write (iout,*) "gradcorr5 in eello5"
7492 c write (iout,'(i5,3f10.5)')
7493 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7497 c------------------------------------------------------------------------------
7498 subroutine add_hb_contact_eello(ii,jj,itask)
7499 implicit real*8 (a-h,o-z)
7500 include "DIMENSIONS"
7501 include "COMMON.IOUNITS"
7504 parameter (max_cont=maxconts)
7505 parameter (max_dim=70)
7506 include "COMMON.CONTACTS"
7507 double precision zapas(max_dim,maxconts,max_fg_procs),
7508 & zapas_recv(max_dim,maxconts,max_fg_procs)
7509 common /przechowalnia/ zapas
7510 integer i,j,ii,jj,iproc,itask(4),nn
7511 c write (iout,*) "itask",itask
7514 if (iproc.gt.0) then
7515 do j=1,num_cont_hb(ii)
7517 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7519 ncont_sent(iproc)=ncont_sent(iproc)+1
7520 nn=ncont_sent(iproc)
7521 zapas(1,nn,iproc)=ii
7522 zapas(2,nn,iproc)=jjc
7523 zapas(3,nn,iproc)=d_cont(j,ii)
7527 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7532 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7540 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7552 c------------------------------------------------------------------------------
7553 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7554 implicit real*8 (a-h,o-z)
7555 include 'DIMENSIONS'
7556 include 'COMMON.IOUNITS'
7557 include 'COMMON.DERIV'
7558 include 'COMMON.INTERACT'
7559 include 'COMMON.CONTACTS'
7560 double precision gx(3),gx1(3)
7570 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7571 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7572 C Following 4 lines for diagnostics.
7577 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7578 c & 'Contacts ',i,j,
7579 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7580 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7582 C Calculate the multi-body contribution to energy.
7583 c ecorr=ecorr+ekont*ees
7584 C Calculate multi-body contributions to the gradient.
7585 coeffpees0pij=coeffp*ees0pij
7586 coeffmees0mij=coeffm*ees0mij
7587 coeffpees0pkl=coeffp*ees0pkl
7588 coeffmees0mkl=coeffm*ees0mkl
7590 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7591 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7592 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7593 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7594 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7595 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7596 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7597 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7598 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7599 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7600 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7601 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7602 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7603 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7604 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7605 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7606 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7607 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7608 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7609 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7610 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7611 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7612 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7613 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7614 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7619 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7620 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7621 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7622 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7627 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7628 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7629 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7630 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7633 c write (iout,*) "ehbcorr",ekont*ees
7638 C---------------------------------------------------------------------------
7639 subroutine dipole(i,j,jj)
7640 implicit real*8 (a-h,o-z)
7641 include 'DIMENSIONS'
7642 include 'COMMON.IOUNITS'
7643 include 'COMMON.CHAIN'
7644 include 'COMMON.FFIELD'
7645 include 'COMMON.DERIV'
7646 include 'COMMON.INTERACT'
7647 include 'COMMON.CONTACTS'
7648 include 'COMMON.TORSION'
7649 include 'COMMON.VAR'
7650 include 'COMMON.GEO'
7651 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7653 iti1 = itortyp(itype(i+1))
7654 if (j.lt.nres-1) then
7655 itj1 = itortyp(itype(j+1))
7660 dipi(iii,1)=Ub2(iii,i)
7661 dipderi(iii)=Ub2der(iii,i)
7662 dipi(iii,2)=b1(iii,iti1)
7663 dipj(iii,1)=Ub2(iii,j)
7664 dipderj(iii)=Ub2der(iii,j)
7665 dipj(iii,2)=b1(iii,itj1)
7669 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7672 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7679 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7683 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7688 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7689 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7691 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7693 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7695 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7700 C---------------------------------------------------------------------------
7701 subroutine calc_eello(i,j,k,l,jj,kk)
7703 C This subroutine computes matrices and vectors needed to calculate
7704 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7706 implicit real*8 (a-h,o-z)
7707 include 'DIMENSIONS'
7708 include 'COMMON.IOUNITS'
7709 include 'COMMON.CHAIN'
7710 include 'COMMON.DERIV'
7711 include 'COMMON.INTERACT'
7712 include 'COMMON.CONTACTS'
7713 include 'COMMON.TORSION'
7714 include 'COMMON.VAR'
7715 include 'COMMON.GEO'
7716 include 'COMMON.FFIELD'
7717 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7718 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7721 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7722 cd & ' jj=',jj,' kk=',kk
7723 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7724 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7725 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7728 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7729 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7732 call transpose2(aa1(1,1),aa1t(1,1))
7733 call transpose2(aa2(1,1),aa2t(1,1))
7736 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7737 & aa1tder(1,1,lll,kkk))
7738 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7739 & aa2tder(1,1,lll,kkk))
7743 C parallel orientation of the two CA-CA-CA frames.
7745 iti=itortyp(itype(i))
7749 itk1=itortyp(itype(k+1))
7750 itj=itortyp(itype(j))
7751 if (l.lt.nres-1) then
7752 itl1=itortyp(itype(l+1))
7756 C A1 kernel(j+1) A2T
7758 cd write (iout,'(3f10.5,5x,3f10.5)')
7759 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7761 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7762 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7763 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7764 C Following matrices are needed only for 6-th order cumulants
7765 IF (wcorr6.gt.0.0d0) THEN
7766 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7767 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7768 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7769 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7770 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7771 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7772 & ADtEAderx(1,1,1,1,1,1))
7774 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7775 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7776 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7777 & ADtEA1derx(1,1,1,1,1,1))
7779 C End 6-th order cumulants
7782 cd write (2,*) 'In calc_eello6'
7784 cd write (2,*) 'iii=',iii
7786 cd write (2,*) 'kkk=',kkk
7788 cd write (2,'(3(2f10.5),5x)')
7789 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7794 call transpose2(EUgder(1,1,k),auxmat(1,1))
7795 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7796 call transpose2(EUg(1,1,k),auxmat(1,1))
7797 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7798 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7802 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7803 & EAEAderx(1,1,lll,kkk,iii,1))
7807 C A1T kernel(i+1) A2
7808 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7809 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7810 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7811 C Following matrices are needed only for 6-th order cumulants
7812 IF (wcorr6.gt.0.0d0) THEN
7813 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7814 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7815 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7816 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7817 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7818 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7819 & ADtEAderx(1,1,1,1,1,2))
7820 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7821 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7822 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7823 & ADtEA1derx(1,1,1,1,1,2))
7825 C End 6-th order cumulants
7826 call transpose2(EUgder(1,1,l),auxmat(1,1))
7827 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7828 call transpose2(EUg(1,1,l),auxmat(1,1))
7829 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7830 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7834 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7835 & EAEAderx(1,1,lll,kkk,iii,2))
7840 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7841 C They are needed only when the fifth- or the sixth-order cumulants are
7843 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7844 call transpose2(AEA(1,1,1),auxmat(1,1))
7845 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7846 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7847 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7848 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7849 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7850 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7851 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7852 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7853 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7854 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7855 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7856 call transpose2(AEA(1,1,2),auxmat(1,1))
7857 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7858 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7859 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7860 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7861 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7862 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7863 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7864 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7865 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7866 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7867 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7868 C Calculate the Cartesian derivatives of the vectors.
7872 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7873 call matvec2(auxmat(1,1),b1(1,iti),
7874 & AEAb1derx(1,lll,kkk,iii,1,1))
7875 call matvec2(auxmat(1,1),Ub2(1,i),
7876 & AEAb2derx(1,lll,kkk,iii,1,1))
7877 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7878 & AEAb1derx(1,lll,kkk,iii,2,1))
7879 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7880 & AEAb2derx(1,lll,kkk,iii,2,1))
7881 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7882 call matvec2(auxmat(1,1),b1(1,itj),
7883 & AEAb1derx(1,lll,kkk,iii,1,2))
7884 call matvec2(auxmat(1,1),Ub2(1,j),
7885 & AEAb2derx(1,lll,kkk,iii,1,2))
7886 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7887 & AEAb1derx(1,lll,kkk,iii,2,2))
7888 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7889 & AEAb2derx(1,lll,kkk,iii,2,2))
7896 C Antiparallel orientation of the two CA-CA-CA frames.
7898 iti=itortyp(itype(i))
7902 itk1=itortyp(itype(k+1))
7903 itl=itortyp(itype(l))
7904 itj=itortyp(itype(j))
7905 if (j.lt.nres-1) then
7906 itj1=itortyp(itype(j+1))
7910 C A2 kernel(j-1)T A1T
7911 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7912 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7913 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7914 C Following matrices are needed only for 6-th order cumulants
7915 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7916 & j.eq.i+4 .and. l.eq.i+3)) THEN
7917 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7918 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7919 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7920 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7921 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7922 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7923 & ADtEAderx(1,1,1,1,1,1))
7924 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7925 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7926 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7927 & ADtEA1derx(1,1,1,1,1,1))
7929 C End 6-th order cumulants
7930 call transpose2(EUgder(1,1,k),auxmat(1,1))
7931 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7932 call transpose2(EUg(1,1,k),auxmat(1,1))
7933 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7934 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7938 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7939 & EAEAderx(1,1,lll,kkk,iii,1))
7943 C A2T kernel(i+1)T A1
7944 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7945 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7946 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7947 C Following matrices are needed only for 6-th order cumulants
7948 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7949 & j.eq.i+4 .and. l.eq.i+3)) THEN
7950 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7951 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7952 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7953 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7954 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7955 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7956 & ADtEAderx(1,1,1,1,1,2))
7957 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7958 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7959 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7960 & ADtEA1derx(1,1,1,1,1,2))
7962 C End 6-th order cumulants
7963 call transpose2(EUgder(1,1,j),auxmat(1,1))
7964 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7965 call transpose2(EUg(1,1,j),auxmat(1,1))
7966 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7967 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7971 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7972 & EAEAderx(1,1,lll,kkk,iii,2))
7977 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7978 C They are needed only when the fifth- or the sixth-order cumulants are
7980 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7981 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7982 call transpose2(AEA(1,1,1),auxmat(1,1))
7983 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7984 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7985 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7986 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7987 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7988 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7989 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7990 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7991 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7992 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7993 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7994 call transpose2(AEA(1,1,2),auxmat(1,1))
7995 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7996 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7997 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7998 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7999 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8000 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8001 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8002 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8003 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8004 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8005 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8006 C Calculate the Cartesian derivatives of the vectors.
8010 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8011 call matvec2(auxmat(1,1),b1(1,iti),
8012 & AEAb1derx(1,lll,kkk,iii,1,1))
8013 call matvec2(auxmat(1,1),Ub2(1,i),
8014 & AEAb2derx(1,lll,kkk,iii,1,1))
8015 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8016 & AEAb1derx(1,lll,kkk,iii,2,1))
8017 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8018 & AEAb2derx(1,lll,kkk,iii,2,1))
8019 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8020 call matvec2(auxmat(1,1),b1(1,itl),
8021 & AEAb1derx(1,lll,kkk,iii,1,2))
8022 call matvec2(auxmat(1,1),Ub2(1,l),
8023 & AEAb2derx(1,lll,kkk,iii,1,2))
8024 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
8025 & AEAb1derx(1,lll,kkk,iii,2,2))
8026 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8027 & AEAb2derx(1,lll,kkk,iii,2,2))
8036 C---------------------------------------------------------------------------
8037 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8038 & KK,KKderg,AKA,AKAderg,AKAderx)
8042 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8043 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8044 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8049 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8051 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8054 cd if (lprn) write (2,*) 'In kernel'
8056 cd if (lprn) write (2,*) 'kkk=',kkk
8058 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8059 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8061 cd write (2,*) 'lll=',lll
8062 cd write (2,*) 'iii=1'
8064 cd write (2,'(3(2f10.5),5x)')
8065 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8068 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8069 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8071 cd write (2,*) 'lll=',lll
8072 cd write (2,*) 'iii=2'
8074 cd write (2,'(3(2f10.5),5x)')
8075 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8082 C---------------------------------------------------------------------------
8083 double precision function eello4(i,j,k,l,jj,kk)
8084 implicit real*8 (a-h,o-z)
8085 include 'DIMENSIONS'
8086 include 'COMMON.IOUNITS'
8087 include 'COMMON.CHAIN'
8088 include 'COMMON.DERIV'
8089 include 'COMMON.INTERACT'
8090 include 'COMMON.CONTACTS'
8091 include 'COMMON.TORSION'
8092 include 'COMMON.VAR'
8093 include 'COMMON.GEO'
8094 double precision pizda(2,2),ggg1(3),ggg2(3)
8095 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8099 cd print *,'eello4:',i,j,k,l,jj,kk
8100 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8101 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8102 cold eij=facont_hb(jj,i)
8103 cold ekl=facont_hb(kk,k)
8105 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8106 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8107 gcorr_loc(k-1)=gcorr_loc(k-1)
8108 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8110 gcorr_loc(l-1)=gcorr_loc(l-1)
8111 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8113 gcorr_loc(j-1)=gcorr_loc(j-1)
8114 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8119 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8120 & -EAEAderx(2,2,lll,kkk,iii,1)
8121 cd derx(lll,kkk,iii)=0.0d0
8125 cd gcorr_loc(l-1)=0.0d0
8126 cd gcorr_loc(j-1)=0.0d0
8127 cd gcorr_loc(k-1)=0.0d0
8129 cd write (iout,*)'Contacts have occurred for peptide groups',
8130 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8131 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8132 if (j.lt.nres-1) then
8139 if (l.lt.nres-1) then
8147 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8148 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8149 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8150 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8151 cgrad ghalf=0.5d0*ggg1(ll)
8152 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8153 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8154 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8155 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8156 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8157 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8158 cgrad ghalf=0.5d0*ggg2(ll)
8159 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8160 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8161 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8162 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8163 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8164 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8168 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8173 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8178 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8183 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8187 cd write (2,*) iii,gcorr_loc(iii)
8190 cd write (2,*) 'ekont',ekont
8191 cd write (iout,*) 'eello4',ekont*eel4
8194 C---------------------------------------------------------------------------
8195 double precision function eello5(i,j,k,l,jj,kk)
8196 implicit real*8 (a-h,o-z)
8197 include 'DIMENSIONS'
8198 include 'COMMON.IOUNITS'
8199 include 'COMMON.CHAIN'
8200 include 'COMMON.DERIV'
8201 include 'COMMON.INTERACT'
8202 include 'COMMON.CONTACTS'
8203 include 'COMMON.TORSION'
8204 include 'COMMON.VAR'
8205 include 'COMMON.GEO'
8206 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8207 double precision ggg1(3),ggg2(3)
8208 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8213 C /l\ / \ \ / \ / \ / C
8214 C / \ / \ \ / \ / \ / C
8215 C j| o |l1 | o | o| o | | o |o C
8216 C \ |/k\| |/ \| / |/ \| |/ \| C
8217 C \i/ \ / \ / / \ / \ C
8219 C (I) (II) (III) (IV) C
8221 C eello5_1 eello5_2 eello5_3 eello5_4 C
8223 C Antiparallel chains C
8226 C /j\ / \ \ / \ / \ / C
8227 C / \ / \ \ / \ / \ / C
8228 C j1| o |l | o | o| o | | o |o C
8229 C \ |/k\| |/ \| / |/ \| |/ \| C
8230 C \i/ \ / \ / / \ / \ C
8232 C (I) (II) (III) (IV) C
8234 C eello5_1 eello5_2 eello5_3 eello5_4 C
8236 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8238 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8239 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8244 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8246 itk=itortyp(itype(k))
8247 itl=itortyp(itype(l))
8248 itj=itortyp(itype(j))
8253 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8254 cd & eel5_3_num,eel5_4_num)
8258 derx(lll,kkk,iii)=0.0d0
8262 cd eij=facont_hb(jj,i)
8263 cd ekl=facont_hb(kk,k)
8265 cd write (iout,*)'Contacts have occurred for peptide groups',
8266 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8268 C Contribution from the graph I.
8269 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8270 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8271 call transpose2(EUg(1,1,k),auxmat(1,1))
8272 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8273 vv(1)=pizda(1,1)-pizda(2,2)
8274 vv(2)=pizda(1,2)+pizda(2,1)
8275 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8276 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8277 C Explicit gradient in virtual-dihedral angles.
8278 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8279 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8280 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8281 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8282 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8283 vv(1)=pizda(1,1)-pizda(2,2)
8284 vv(2)=pizda(1,2)+pizda(2,1)
8285 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8286 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8287 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8288 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8289 vv(1)=pizda(1,1)-pizda(2,2)
8290 vv(2)=pizda(1,2)+pizda(2,1)
8292 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8293 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8294 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8296 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8297 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8298 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8300 C Cartesian gradient
8304 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8306 vv(1)=pizda(1,1)-pizda(2,2)
8307 vv(2)=pizda(1,2)+pizda(2,1)
8308 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8309 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8310 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8316 C Contribution from graph II
8317 call transpose2(EE(1,1,itk),auxmat(1,1))
8318 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8319 vv(1)=pizda(1,1)+pizda(2,2)
8320 vv(2)=pizda(2,1)-pizda(1,2)
8321 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
8322 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8323 C Explicit gradient in virtual-dihedral angles.
8324 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8325 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8326 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8327 vv(1)=pizda(1,1)+pizda(2,2)
8328 vv(2)=pizda(2,1)-pizda(1,2)
8330 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8331 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8332 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8334 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8335 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8336 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8338 C Cartesian gradient
8342 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8344 vv(1)=pizda(1,1)+pizda(2,2)
8345 vv(2)=pizda(2,1)-pizda(1,2)
8346 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8347 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
8348 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8356 C Parallel orientation
8357 C Contribution from graph III
8358 call transpose2(EUg(1,1,l),auxmat(1,1))
8359 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8360 vv(1)=pizda(1,1)-pizda(2,2)
8361 vv(2)=pizda(1,2)+pizda(2,1)
8362 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8363 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8364 C Explicit gradient in virtual-dihedral angles.
8365 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8366 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8367 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8368 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8369 vv(1)=pizda(1,1)-pizda(2,2)
8370 vv(2)=pizda(1,2)+pizda(2,1)
8371 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8372 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8373 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8374 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8375 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8376 vv(1)=pizda(1,1)-pizda(2,2)
8377 vv(2)=pizda(1,2)+pizda(2,1)
8378 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8379 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8380 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8381 C Cartesian gradient
8385 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8387 vv(1)=pizda(1,1)-pizda(2,2)
8388 vv(2)=pizda(1,2)+pizda(2,1)
8389 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8390 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8391 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8396 C Contribution from graph IV
8398 call transpose2(EE(1,1,itl),auxmat(1,1))
8399 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8400 vv(1)=pizda(1,1)+pizda(2,2)
8401 vv(2)=pizda(2,1)-pizda(1,2)
8402 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
8403 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8404 C Explicit gradient in virtual-dihedral angles.
8405 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8406 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8407 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8408 vv(1)=pizda(1,1)+pizda(2,2)
8409 vv(2)=pizda(2,1)-pizda(1,2)
8410 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8411 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
8412 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8413 C Cartesian gradient
8417 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8419 vv(1)=pizda(1,1)+pizda(2,2)
8420 vv(2)=pizda(2,1)-pizda(1,2)
8421 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8422 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
8423 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8428 C Antiparallel orientation
8429 C Contribution from graph III
8431 call transpose2(EUg(1,1,j),auxmat(1,1))
8432 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8433 vv(1)=pizda(1,1)-pizda(2,2)
8434 vv(2)=pizda(1,2)+pizda(2,1)
8435 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8436 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8437 C Explicit gradient in virtual-dihedral angles.
8438 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8439 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8440 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8441 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8442 vv(1)=pizda(1,1)-pizda(2,2)
8443 vv(2)=pizda(1,2)+pizda(2,1)
8444 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8445 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8446 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8447 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8448 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8449 vv(1)=pizda(1,1)-pizda(2,2)
8450 vv(2)=pizda(1,2)+pizda(2,1)
8451 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8452 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8453 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8454 C Cartesian gradient
8458 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8460 vv(1)=pizda(1,1)-pizda(2,2)
8461 vv(2)=pizda(1,2)+pizda(2,1)
8462 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8463 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8464 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8469 C Contribution from graph IV
8471 call transpose2(EE(1,1,itj),auxmat(1,1))
8472 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8473 vv(1)=pizda(1,1)+pizda(2,2)
8474 vv(2)=pizda(2,1)-pizda(1,2)
8475 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8476 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8477 C Explicit gradient in virtual-dihedral angles.
8478 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8479 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8480 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8481 vv(1)=pizda(1,1)+pizda(2,2)
8482 vv(2)=pizda(2,1)-pizda(1,2)
8483 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8484 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8485 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8486 C Cartesian gradient
8490 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8492 vv(1)=pizda(1,1)+pizda(2,2)
8493 vv(2)=pizda(2,1)-pizda(1,2)
8494 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8495 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8496 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8502 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8503 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8504 cd write (2,*) 'ijkl',i,j,k,l
8505 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8506 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8508 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8509 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8510 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8511 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8512 if (j.lt.nres-1) then
8519 if (l.lt.nres-1) then
8529 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8530 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8531 C summed up outside the subrouine as for the other subroutines
8532 C handling long-range interactions. The old code is commented out
8533 C with "cgrad" to keep track of changes.
8535 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8536 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8537 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8538 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8539 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8540 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8541 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8542 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8543 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8544 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8546 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8547 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8548 cgrad ghalf=0.5d0*ggg1(ll)
8550 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8551 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8552 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8553 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8554 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8555 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8556 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8557 cgrad ghalf=0.5d0*ggg2(ll)
8559 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8560 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8561 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8562 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8563 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8564 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8569 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8570 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8575 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8576 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8582 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8587 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8591 cd write (2,*) iii,g_corr5_loc(iii)
8594 cd write (2,*) 'ekont',ekont
8595 cd write (iout,*) 'eello5',ekont*eel5
8598 c--------------------------------------------------------------------------
8599 double precision function eello6(i,j,k,l,jj,kk)
8600 implicit real*8 (a-h,o-z)
8601 include 'DIMENSIONS'
8602 include 'COMMON.IOUNITS'
8603 include 'COMMON.CHAIN'
8604 include 'COMMON.DERIV'
8605 include 'COMMON.INTERACT'
8606 include 'COMMON.CONTACTS'
8607 include 'COMMON.TORSION'
8608 include 'COMMON.VAR'
8609 include 'COMMON.GEO'
8610 include 'COMMON.FFIELD'
8611 double precision ggg1(3),ggg2(3)
8612 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8617 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8625 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8626 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8630 derx(lll,kkk,iii)=0.0d0
8634 cd eij=facont_hb(jj,i)
8635 cd ekl=facont_hb(kk,k)
8641 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8642 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8643 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8644 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8645 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8646 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8648 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8649 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8650 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8651 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8652 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8653 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8657 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8659 C If turn contributions are considered, they will be handled separately.
8660 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8661 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8662 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8663 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8664 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8665 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8666 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8668 if (j.lt.nres-1) then
8675 if (l.lt.nres-1) then
8683 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8684 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8685 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8686 cgrad ghalf=0.5d0*ggg1(ll)
8688 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8689 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8690 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8691 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8692 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8693 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8694 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8695 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8696 cgrad ghalf=0.5d0*ggg2(ll)
8697 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8699 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8700 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8701 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8702 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8703 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8704 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8709 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8710 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8715 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8716 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8722 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8727 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8731 cd write (2,*) iii,g_corr6_loc(iii)
8734 cd write (2,*) 'ekont',ekont
8735 cd write (iout,*) 'eello6',ekont*eel6
8738 c--------------------------------------------------------------------------
8739 double precision function eello6_graph1(i,j,k,l,imat,swap)
8740 implicit real*8 (a-h,o-z)
8741 include 'DIMENSIONS'
8742 include 'COMMON.IOUNITS'
8743 include 'COMMON.CHAIN'
8744 include 'COMMON.DERIV'
8745 include 'COMMON.INTERACT'
8746 include 'COMMON.CONTACTS'
8747 include 'COMMON.TORSION'
8748 include 'COMMON.VAR'
8749 include 'COMMON.GEO'
8750 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8754 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8756 C Parallel Antiparallel C
8762 C \ j|/k\| / \ |/k\|l / C
8767 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8768 itk=itortyp(itype(k))
8769 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8770 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8771 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8772 call transpose2(EUgC(1,1,k),auxmat(1,1))
8773 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8774 vv1(1)=pizda1(1,1)-pizda1(2,2)
8775 vv1(2)=pizda1(1,2)+pizda1(2,1)
8776 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8777 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8778 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8779 s5=scalar2(vv(1),Dtobr2(1,i))
8780 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8781 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8782 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8783 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8784 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8785 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8786 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8787 & +scalar2(vv(1),Dtobr2der(1,i)))
8788 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8789 vv1(1)=pizda1(1,1)-pizda1(2,2)
8790 vv1(2)=pizda1(1,2)+pizda1(2,1)
8791 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8792 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8794 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8795 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8796 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8797 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8798 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8800 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8801 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8802 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8803 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8804 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8806 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8807 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8808 vv1(1)=pizda1(1,1)-pizda1(2,2)
8809 vv1(2)=pizda1(1,2)+pizda1(2,1)
8810 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8811 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8812 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8813 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8822 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8823 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8824 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8825 call transpose2(EUgC(1,1,k),auxmat(1,1))
8826 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8828 vv1(1)=pizda1(1,1)-pizda1(2,2)
8829 vv1(2)=pizda1(1,2)+pizda1(2,1)
8830 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8831 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8832 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8833 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8834 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8835 s5=scalar2(vv(1),Dtobr2(1,i))
8836 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8842 c----------------------------------------------------------------------------
8843 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8844 implicit real*8 (a-h,o-z)
8845 include 'DIMENSIONS'
8846 include 'COMMON.IOUNITS'
8847 include 'COMMON.CHAIN'
8848 include 'COMMON.DERIV'
8849 include 'COMMON.INTERACT'
8850 include 'COMMON.CONTACTS'
8851 include 'COMMON.TORSION'
8852 include 'COMMON.VAR'
8853 include 'COMMON.GEO'
8855 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8856 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8859 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8861 C Parallel Antiparallel C
8867 C \ j|/k\| \ |/k\|l C
8872 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8873 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8874 C AL 7/4/01 s1 would occur in the sixth-order moment,
8875 C but not in a cluster cumulant
8877 s1=dip(1,jj,i)*dip(1,kk,k)
8879 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8880 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8881 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8882 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8883 call transpose2(EUg(1,1,k),auxmat(1,1))
8884 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8885 vv(1)=pizda(1,1)-pizda(2,2)
8886 vv(2)=pizda(1,2)+pizda(2,1)
8887 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8888 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8890 eello6_graph2=-(s1+s2+s3+s4)
8892 eello6_graph2=-(s2+s3+s4)
8895 C Derivatives in gamma(i-1)
8898 s1=dipderg(1,jj,i)*dip(1,kk,k)
8900 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8901 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8902 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8903 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8905 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8907 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8909 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8911 C Derivatives in gamma(k-1)
8913 s1=dip(1,jj,i)*dipderg(1,kk,k)
8915 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8916 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8917 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8918 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8919 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8920 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8921 vv(1)=pizda(1,1)-pizda(2,2)
8922 vv(2)=pizda(1,2)+pizda(2,1)
8923 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8925 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8927 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8929 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8930 C Derivatives in gamma(j-1) or gamma(l-1)
8933 s1=dipderg(3,jj,i)*dip(1,kk,k)
8935 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8936 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8937 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8938 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8939 vv(1)=pizda(1,1)-pizda(2,2)
8940 vv(2)=pizda(1,2)+pizda(2,1)
8941 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8944 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8946 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8949 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8950 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8952 C Derivatives in gamma(l-1) or gamma(j-1)
8955 s1=dip(1,jj,i)*dipderg(3,kk,k)
8957 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8958 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8959 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8960 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8961 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8962 vv(1)=pizda(1,1)-pizda(2,2)
8963 vv(2)=pizda(1,2)+pizda(2,1)
8964 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8967 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8969 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8972 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8973 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8975 C Cartesian derivatives.
8977 write (2,*) 'In eello6_graph2'
8979 write (2,*) 'iii=',iii
8981 write (2,*) 'kkk=',kkk
8983 write (2,'(3(2f10.5),5x)')
8984 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8994 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8996 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8999 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9001 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9002 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9004 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9005 call transpose2(EUg(1,1,k),auxmat(1,1))
9006 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9008 vv(1)=pizda(1,1)-pizda(2,2)
9009 vv(2)=pizda(1,2)+pizda(2,1)
9010 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9011 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9013 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9015 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9018 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9020 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9027 c----------------------------------------------------------------------------
9028 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9029 implicit real*8 (a-h,o-z)
9030 include 'DIMENSIONS'
9031 include 'COMMON.IOUNITS'
9032 include 'COMMON.CHAIN'
9033 include 'COMMON.DERIV'
9034 include 'COMMON.INTERACT'
9035 include 'COMMON.CONTACTS'
9036 include 'COMMON.TORSION'
9037 include 'COMMON.VAR'
9038 include 'COMMON.GEO'
9039 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9041 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9043 C Parallel Antiparallel C
9049 C j|/k\| / |/k\|l / C
9054 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9056 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9057 C energy moment and not to the cluster cumulant.
9058 iti=itortyp(itype(i))
9059 if (j.lt.nres-1) then
9060 itj1=itortyp(itype(j+1))
9064 itk=itortyp(itype(k))
9065 itk1=itortyp(itype(k+1))
9066 if (l.lt.nres-1) then
9067 itl1=itortyp(itype(l+1))
9072 s1=dip(4,jj,i)*dip(4,kk,k)
9074 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9075 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9076 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9077 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9078 call transpose2(EE(1,1,itk),auxmat(1,1))
9079 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9080 vv(1)=pizda(1,1)+pizda(2,2)
9081 vv(2)=pizda(2,1)-pizda(1,2)
9082 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9083 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9084 cd & "sum",-(s2+s3+s4)
9086 eello6_graph3=-(s1+s2+s3+s4)
9088 eello6_graph3=-(s2+s3+s4)
9091 C Derivatives in gamma(k-1)
9092 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9093 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9094 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9095 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9096 C Derivatives in gamma(l-1)
9097 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9098 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9099 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9100 vv(1)=pizda(1,1)+pizda(2,2)
9101 vv(2)=pizda(2,1)-pizda(1,2)
9102 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9103 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9104 C Cartesian derivatives.
9110 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9112 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9115 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
9117 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9118 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
9120 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9121 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,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),Ctobr(1,k))
9127 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9129 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9132 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9134 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9136 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9142 c----------------------------------------------------------------------------
9143 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9144 implicit real*8 (a-h,o-z)
9145 include 'DIMENSIONS'
9146 include 'COMMON.IOUNITS'
9147 include 'COMMON.CHAIN'
9148 include 'COMMON.DERIV'
9149 include 'COMMON.INTERACT'
9150 include 'COMMON.CONTACTS'
9151 include 'COMMON.TORSION'
9152 include 'COMMON.VAR'
9153 include 'COMMON.GEO'
9154 include 'COMMON.FFIELD'
9155 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9156 & auxvec1(2),auxmat1(2,2)
9158 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9160 C Parallel Antiparallel C
9166 C \ j|/k\| \ |/k\|l C
9171 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9173 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9174 C energy moment and not to the cluster cumulant.
9175 cd write (2,*) 'eello_graph4: wturn6',wturn6
9176 iti=itortyp(itype(i))
9177 itj=itortyp(itype(j))
9178 if (j.lt.nres-1) then
9179 itj1=itortyp(itype(j+1))
9183 itk=itortyp(itype(k))
9184 if (k.lt.nres-1) then
9185 itk1=itortyp(itype(k+1))
9189 itl=itortyp(itype(l))
9190 if (l.lt.nres-1) then
9191 itl1=itortyp(itype(l+1))
9195 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9196 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9197 cd & ' itl',itl,' itl1',itl1
9200 s1=dip(3,jj,i)*dip(3,kk,k)
9202 s1=dip(2,jj,j)*dip(2,kk,l)
9205 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9206 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9208 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9209 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9211 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9212 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9214 call transpose2(EUg(1,1,k),auxmat(1,1))
9215 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9216 vv(1)=pizda(1,1)-pizda(2,2)
9217 vv(2)=pizda(2,1)+pizda(1,2)
9218 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9219 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9221 eello6_graph4=-(s1+s2+s3+s4)
9223 eello6_graph4=-(s2+s3+s4)
9225 C Derivatives in gamma(i-1)
9229 s1=dipderg(2,jj,i)*dip(3,kk,k)
9231 s1=dipderg(4,jj,j)*dip(2,kk,l)
9234 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9236 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9237 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9239 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9240 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9242 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9243 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9244 cd write (2,*) 'turn6 derivatives'
9246 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9248 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9252 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9254 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9258 C Derivatives in gamma(k-1)
9261 s1=dip(3,jj,i)*dipderg(2,kk,k)
9263 s1=dip(2,jj,j)*dipderg(4,kk,l)
9266 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9267 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9269 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9270 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9272 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9273 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9275 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9276 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9277 vv(1)=pizda(1,1)-pizda(2,2)
9278 vv(2)=pizda(2,1)+pizda(1,2)
9279 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9280 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9282 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9284 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9288 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9290 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9293 C Derivatives in gamma(j-1) or gamma(l-1)
9294 if (l.eq.j+1 .and. l.gt.1) then
9295 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9296 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9297 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9298 vv(1)=pizda(1,1)-pizda(2,2)
9299 vv(2)=pizda(2,1)+pizda(1,2)
9300 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9301 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9302 else if (j.gt.1) then
9303 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9304 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9305 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9306 vv(1)=pizda(1,1)-pizda(2,2)
9307 vv(2)=pizda(2,1)+pizda(1,2)
9308 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9309 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9310 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9312 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9315 C Cartesian derivatives.
9322 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9324 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9328 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9330 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9334 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9336 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9338 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9339 & b1(1,itj1),auxvec(1))
9340 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9342 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9343 & b1(1,itl1),auxvec(1))
9344 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9346 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9348 vv(1)=pizda(1,1)-pizda(2,2)
9349 vv(2)=pizda(2,1)+pizda(1,2)
9350 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9352 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9354 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9357 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9360 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9363 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9365 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9367 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9371 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9373 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9376 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9378 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9386 c----------------------------------------------------------------------------
9387 double precision function eello_turn6(i,jj,kk)
9388 implicit real*8 (a-h,o-z)
9389 include 'DIMENSIONS'
9390 include 'COMMON.IOUNITS'
9391 include 'COMMON.CHAIN'
9392 include 'COMMON.DERIV'
9393 include 'COMMON.INTERACT'
9394 include 'COMMON.CONTACTS'
9395 include 'COMMON.TORSION'
9396 include 'COMMON.VAR'
9397 include 'COMMON.GEO'
9398 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9399 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9401 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9402 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9403 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9404 C the respective energy moment and not to the cluster cumulant.
9413 iti=itortyp(itype(i))
9414 itk=itortyp(itype(k))
9415 itk1=itortyp(itype(k+1))
9416 itl=itortyp(itype(l))
9417 itj=itortyp(itype(j))
9418 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9419 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9420 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9425 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9427 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9431 derx_turn(lll,kkk,iii)=0.0d0
9438 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9440 cd write (2,*) 'eello6_5',eello6_5
9442 call transpose2(AEA(1,1,1),auxmat(1,1))
9443 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9444 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9445 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9447 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9448 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9449 s2 = scalar2(b1(1,itk),vtemp1(1))
9451 call transpose2(AEA(1,1,2),atemp(1,1))
9452 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9453 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9454 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9456 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9457 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9458 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9460 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9461 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9462 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9463 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9464 ss13 = scalar2(b1(1,itk),vtemp4(1))
9465 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9467 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9473 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9474 C Derivatives in gamma(i+2)
9478 call transpose2(AEA(1,1,1),auxmatd(1,1))
9479 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9480 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9481 call transpose2(AEAderg(1,1,2),atempd(1,1))
9482 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9483 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9485 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9486 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9487 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9493 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9494 C Derivatives in gamma(i+3)
9496 call transpose2(AEA(1,1,1),auxmatd(1,1))
9497 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9498 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9499 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9501 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9502 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9503 s2d = scalar2(b1(1,itk),vtemp1d(1))
9505 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9506 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9508 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9510 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9511 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9512 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9520 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9521 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9523 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9524 & -0.5d0*ekont*(s2d+s12d)
9526 C Derivatives in gamma(i+4)
9527 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9528 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9529 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9531 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9532 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9533 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9541 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9543 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9545 C Derivatives in gamma(i+5)
9547 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9548 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9549 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9551 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9552 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9553 s2d = scalar2(b1(1,itk),vtemp1d(1))
9555 call transpose2(AEA(1,1,2),atempd(1,1))
9556 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9557 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9559 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9560 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9562 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9563 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9564 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9572 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9573 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9575 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9576 & -0.5d0*ekont*(s2d+s12d)
9578 C Cartesian derivatives
9583 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9584 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9585 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9587 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9588 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9590 s2d = scalar2(b1(1,itk),vtemp1d(1))
9592 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9593 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9594 s8d = -(atempd(1,1)+atempd(2,2))*
9595 & scalar2(cc(1,1,itl),vtemp2(1))
9597 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9599 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9600 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9607 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9610 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9614 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9615 & - 0.5d0*(s8d+s12d)
9617 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9626 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9628 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9629 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9630 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9631 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9632 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9634 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9635 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9636 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9640 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9641 cd & 16*eel_turn6_num
9643 if (j.lt.nres-1) then
9650 if (l.lt.nres-1) then
9658 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9659 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9660 cgrad ghalf=0.5d0*ggg1(ll)
9662 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9663 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9664 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9665 & +ekont*derx_turn(ll,2,1)
9666 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9667 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9668 & +ekont*derx_turn(ll,4,1)
9669 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9670 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9671 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9672 cgrad ghalf=0.5d0*ggg2(ll)
9674 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9675 & +ekont*derx_turn(ll,2,2)
9676 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9677 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9678 & +ekont*derx_turn(ll,4,2)
9679 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9680 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9681 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9686 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9691 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9697 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9702 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9706 cd write (2,*) iii,g_corr6_loc(iii)
9708 eello_turn6=ekont*eel_turn6
9709 cd write (2,*) 'ekont',ekont
9710 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9714 C-----------------------------------------------------------------------------
9715 double precision function scalar(u,v)
9716 !DIR$ INLINEALWAYS scalar
9718 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9721 double precision u(3),v(3)
9722 cd double precision sc
9730 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9733 crc-------------------------------------------------
9734 SUBROUTINE MATVEC2(A1,V1,V2)
9735 !DIR$ INLINEALWAYS MATVEC2
9737 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9739 implicit real*8 (a-h,o-z)
9740 include 'DIMENSIONS'
9741 DIMENSION A1(2,2),V1(2),V2(2)
9745 c 3 VI=VI+A1(I,K)*V1(K)
9749 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9750 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9755 C---------------------------------------
9756 SUBROUTINE MATMAT2(A1,A2,A3)
9758 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9760 implicit real*8 (a-h,o-z)
9761 include 'DIMENSIONS'
9762 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9763 c DIMENSION AI3(2,2)
9767 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9773 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9774 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9775 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9776 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9784 c-------------------------------------------------------------------------
9785 double precision function scalar2(u,v)
9786 !DIR$ INLINEALWAYS scalar2
9788 double precision u(2),v(2)
9791 scalar2=u(1)*v(1)+u(2)*v(2)
9795 C-----------------------------------------------------------------------------
9797 subroutine transpose2(a,at)
9798 !DIR$ INLINEALWAYS transpose2
9800 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9803 double precision a(2,2),at(2,2)
9810 c--------------------------------------------------------------------------
9811 subroutine transpose(n,a,at)
9814 double precision a(n,n),at(n,n)
9822 C---------------------------------------------------------------------------
9823 subroutine prodmat3(a1,a2,kk,transp,prod)
9824 !DIR$ INLINEALWAYS prodmat3
9826 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9830 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9832 crc double precision auxmat(2,2),prod_(2,2)
9835 crc call transpose2(kk(1,1),auxmat(1,1))
9836 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9837 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9839 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9840 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9841 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9842 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9843 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9844 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9845 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9846 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9849 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9850 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9852 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9853 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9854 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9855 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9856 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9857 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9858 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9859 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9862 c call transpose2(a2(1,1),a2t(1,1))
9865 crc print *,((prod_(i,j),i=1,2),j=1,2)
9866 crc print *,((prod(i,j),i=1,2),j=1,2)
9870 CCC----------------------------------------------
9871 subroutine Eliptransfer(eliptran)
9872 implicit real*8 (a-h,o-z)
9873 include 'DIMENSIONS'
9874 include 'COMMON.GEO'
9875 include 'COMMON.VAR'
9876 include 'COMMON.LOCAL'
9877 include 'COMMON.CHAIN'
9878 include 'COMMON.DERIV'
9879 include 'COMMON.NAMES'
9880 include 'COMMON.INTERACT'
9881 include 'COMMON.IOUNITS'
9882 include 'COMMON.CALC'
9883 include 'COMMON.CONTROL'
9884 include 'COMMON.SPLITELE'
9885 include 'COMMON.SBRIDGE'
9886 C this is done by Adasko
9890 C--bordliptop-- buffore starts
9891 C--bufliptop--- here true lipid starts
9893 C--buflipbot--- lipid ends buffore starts
9894 C--bordlipbot--buffore ends
9896 do i=ilip_start,ilip_end
9898 if (itype(i).eq.ntyp1) cycle
9900 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
9901 if (positi.le.0) positi=positi+boxzsize
9903 C first for peptide groups
9904 c for each residue check if it is in lipid or lipid water border area
9905 if ((positi.gt.bordlipbot)
9906 &.and.(positi.lt.bordliptop)) then
9907 C the energy transfer exist
9908 if (positi.lt.buflipbot) then
9909 C what fraction I am in
9911 & ((positi-bordlipbot)/lipbufthick)
9912 C lipbufthick is thickenes of lipid buffore
9913 sslip=sscalelip(fracinbuf)
9914 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9915 eliptran=eliptran+sslip*pepliptran
9916 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9917 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9918 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9920 C print *,"doing sccale for lower part"
9921 elseif (positi.gt.bufliptop) then
9922 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
9923 sslip=sscalelip(fracinbuf)
9924 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9925 eliptran=eliptran+sslip*pepliptran
9926 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9927 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9928 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9929 C print *, "doing sscalefor top part"
9931 eliptran=eliptran+pepliptran
9932 C print *,"I am in true lipid"
9935 C eliptran=elpitran+0.0 ! I am in water
9938 C print *, "nic nie bylo w lipidzie?"
9939 C now multiply all by the peptide group transfer factor
9940 C eliptran=eliptran*pepliptran
9941 C now the same for side chains
9943 do i=ilip_start,ilip_end
9944 if (itype(i).eq.ntyp1) cycle
9945 positi=(mod(c(3,i+nres),boxzsize))
9946 if (positi.le.0) positi=positi+boxzsize
9947 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9948 c for each residue check if it is in lipid or lipid water border area
9949 C respos=mod(c(3,i+nres),boxzsize)
9950 C print *,positi,bordlipbot,buflipbot
9951 if ((positi.gt.bordlipbot)
9952 & .and.(positi.lt.bordliptop)) then
9953 C the energy transfer exist
9954 if (positi.lt.buflipbot) then
9956 & ((positi-bordlipbot)/lipbufthick)
9957 C lipbufthick is thickenes of lipid buffore
9958 sslip=sscalelip(fracinbuf)
9959 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9960 eliptran=eliptran+sslip*liptranene(itype(i))
9961 gliptranx(3,i)=gliptranx(3,i)
9962 &+ssgradlip*liptranene(itype(i))/2.0d0
9963 gliptranc(3,i-1)= gliptranc(3,i-1)
9964 &+ssgradlip*liptranene(itype(i))/2.0d0
9965 C print *,"doing sccale for lower part"
9966 elseif (positi.gt.bufliptop) then
9968 &((bordliptop-positi)/lipbufthick)
9969 sslip=sscalelip(fracinbuf)
9970 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9971 eliptran=eliptran+sslip*liptranene(itype(i))
9972 gliptranx(3,i)=gliptranx(3,i)
9973 &+ssgradlip*liptranene(itype(i))/2.0d0
9974 gliptranc(3,i-1)= gliptranc(3,i-1)
9975 &+ssgradlip*liptranene(itype(i))/2.0d0
9976 C print *, "doing sscalefor top part",sslip,fracinbuf
9978 eliptran=eliptran+liptranene(itype(i))
9979 C print *,"I am in true lipid"
9981 endif ! if in lipid or buffor
9983 C eliptran=elpitran+0.0 ! I am in water