1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
27 include 'COMMON.SPLITELE'
29 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
30 c & " nfgtasks",nfgtasks
31 if (nfgtasks.gt.1) then
33 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
34 if (fg_rank.eq.0) then
35 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
36 c print *,"Processor",myrank," BROADCAST iorder"
37 C FG master sets up the WEIGHTS_ array which will be broadcast to the
38 C FG slaves as WEIGHTS array.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
85 time_Bcast=time_Bcast+MPI_Wtime()-time00
86 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
87 c call chainbuild_cart
89 c print *,'Processor',myrank,' calling etotal ipot=',ipot
90 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
92 c if (modecalc.eq.12.or.modecalc.eq.14) then
93 c call int_from_cart1(.false.)
100 C Compute the side-chain and electrostatic interaction energy
102 goto (101,102,103,104,105,106) ipot
103 C Lennard-Jones potential.
105 cd print '(a)','Exit ELJ'
107 C Lennard-Jones-Kihara potential (shifted).
110 C Berne-Pechukas potential (dilated LJ, angular dependence).
113 C Gay-Berne potential (shifted LJ, angular dependence).
116 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
119 C Soft-sphere potential
120 106 call e_softsphere(evdw)
122 C Calculate electrostatic (H-bonding) energy of the main chain.
126 cmc Sep-06: egb takes care of dynamic ss bonds too
128 c if (dyn_ss) call dyn_set_nss
130 c print *,"Processor",myrank," computed USCSC"
136 time_vec=time_vec+MPI_Wtime()-time01
138 c print *,"Processor",myrank," left VEC_AND_DERIV"
141 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
142 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
143 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
144 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
146 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
147 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
148 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
149 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
151 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
160 write (iout,*) "Soft-spheer ELEC potential"
161 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
164 c print *,"Processor",myrank," computed UELEC"
166 C Calculate excluded-volume interaction energy between peptide groups
171 call escp(evdw2,evdw2_14)
177 c write (iout,*) "Soft-sphere SCP potential"
178 call escp_soft_sphere(evdw2,evdw2_14)
181 c Calculate the bond-stretching energy
185 C Calculate the disulfide-bridge and other energy and the contributions
186 C from other distance constraints.
187 cd print *,'Calling EHPB'
189 cd print *,'EHPB exitted succesfully.'
191 C Calculate the virtual-bond-angle energy.
193 if (wang.gt.0d0) then
198 c print *,"Processor",myrank," computed UB"
200 C Calculate the SC local energy.
203 c print *,"Processor",myrank," computed USC"
205 C Calculate the virtual-bond torsional energy.
207 cd print *,'nterm=',nterm
209 call etor(etors,edihcnstr)
214 c print *,"Processor",myrank," computed Utor"
216 C 6/23/01 Calculate double-torsional energy
218 if (wtor_d.gt.0) then
223 c print *,"Processor",myrank," computed Utord"
225 C 21/5/07 Calculate local sicdechain correlation energy
227 if (wsccor.gt.0.0d0) then
228 call eback_sc_corr(esccor)
232 c print *,"Processor",myrank," computed Usccorr"
234 C 12/1/95 Multi-body terms
238 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
239 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
240 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
241 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
242 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
249 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
250 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
251 cd write (iout,*) "multibody_hb ecorr",ecorr
253 c print *,"Processor",myrank," computed Ucorr"
255 C If performing constraint dynamics, call the constraint energy
256 C after the equilibration time
257 if(usampl.and.totT.gt.eq_time) then
265 time_enecalc=time_enecalc+MPI_Wtime()-time00
267 c print *,"Processor",myrank," computed Uconstr"
276 energia(2)=evdw2-evdw2_14
293 energia(8)=eello_turn3
294 energia(9)=eello_turn4
301 energia(19)=edihcnstr
303 energia(20)=Uconst+Uconst_back
305 c Here are the energies showed per procesor if the are more processors
306 c per molecule then we sum it up in sum_energy subroutine
307 c print *," Processor",myrank," calls SUM_ENERGY"
308 call sum_energy(energia,.true.)
309 if (dyn_ss) call dyn_set_nss
310 c print *," Processor",myrank," left SUM_ENERGY"
312 time_sumene=time_sumene+MPI_Wtime()-time00
316 c-------------------------------------------------------------------------------
317 subroutine sum_energy(energia,reduce)
318 implicit real*8 (a-h,o-z)
323 cMS$ATTRIBUTES C :: proc_proc
329 include 'COMMON.SETUP'
330 include 'COMMON.IOUNITS'
331 double precision energia(0:n_ene),enebuff(0:n_ene+1)
332 include 'COMMON.FFIELD'
333 include 'COMMON.DERIV'
334 include 'COMMON.INTERACT'
335 include 'COMMON.SBRIDGE'
336 include 'COMMON.CHAIN'
338 include 'COMMON.CONTROL'
339 include 'COMMON.TIME1'
342 if (nfgtasks.gt.1 .and. reduce) then
344 write (iout,*) "energies before REDUCE"
345 call enerprint(energia)
349 enebuff(i)=energia(i)
352 call MPI_Barrier(FG_COMM,IERR)
353 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
355 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
356 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
358 write (iout,*) "energies after REDUCE"
359 call enerprint(energia)
362 time_Reduce=time_Reduce+MPI_Wtime()-time00
364 if (fg_rank.eq.0) then
368 evdw2=energia(2)+energia(18)
384 eello_turn3=energia(8)
385 eello_turn4=energia(9)
392 edihcnstr=energia(19)
397 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
398 & +wang*ebe+wtor*etors+wscloc*escloc
399 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
400 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
401 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
402 & +wbond*estr+Uconst+wsccor*esccor
404 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
405 & +wang*ebe+wtor*etors+wscloc*escloc
406 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
407 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
408 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
409 & +wbond*estr+Uconst+wsccor*esccor
415 if (isnan(etot).ne.0) energia(0)=1.0d+99
417 if (isnan(etot)) energia(0)=1.0d+99
422 idumm=proc_proc(etot,i)
424 call proc_proc(etot,i)
426 if(i.eq.1)energia(0)=1.0d+99
433 c-------------------------------------------------------------------------------
434 subroutine sum_gradient
435 implicit real*8 (a-h,o-z)
440 cMS$ATTRIBUTES C :: proc_proc
446 double precision gradbufc(3,maxres),gradbufx(3,maxres),
447 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
448 include 'COMMON.SETUP'
449 include 'COMMON.IOUNITS'
450 include 'COMMON.FFIELD'
451 include 'COMMON.DERIV'
452 include 'COMMON.INTERACT'
453 include 'COMMON.SBRIDGE'
454 include 'COMMON.CHAIN'
456 include 'COMMON.CONTROL'
457 include 'COMMON.TIME1'
458 include 'COMMON.MAXGRAD'
459 include 'COMMON.SCCOR'
464 write (iout,*) "sum_gradient gvdwc, gvdwx"
466 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
467 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
472 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
473 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
474 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
477 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
478 C in virtual-bond-vector coordinates
481 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
483 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
484 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
486 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
488 c write (iout,'(i5,3f10.5,2x,f10.5)')
489 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
491 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
493 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
494 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
502 gradbufc(j,i)=wsc*gvdwc(j,i)+
503 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
504 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
505 & wel_loc*gel_loc_long(j,i)+
506 & wcorr*gradcorr_long(j,i)+
507 & wcorr5*gradcorr5_long(j,i)+
508 & wcorr6*gradcorr6_long(j,i)+
509 & wturn6*gcorr6_turn_long(j,i)+
516 gradbufc(j,i)=wsc*gvdwc(j,i)+
517 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
518 & welec*gelc_long(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)+
530 if (nfgtasks.gt.1) then
533 write (iout,*) "gradbufc before allreduce"
535 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
541 gradbufc_sum(j,i)=gradbufc(j,i)
544 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
545 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
546 c time_reduce=time_reduce+MPI_Wtime()-time00
548 c write (iout,*) "gradbufc_sum after allreduce"
550 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
555 c time_allreduce=time_allreduce+MPI_Wtime()-time00
563 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
564 write (iout,*) (i," jgrad_start",jgrad_start(i),
565 & " jgrad_end ",jgrad_end(i),
566 & i=igrad_start,igrad_end)
569 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
570 c do not parallelize this part.
572 c do i=igrad_start,igrad_end
573 c do j=jgrad_start(i),jgrad_end(i)
575 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
580 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
584 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
588 write (iout,*) "gradbufc after summing"
590 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
597 write (iout,*) "gradbufc"
599 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
605 gradbufc_sum(j,i)=gradbufc(j,i)
610 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
614 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
619 c gradbufc(k,i)=0.0d0
623 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
628 write (iout,*) "gradbufc after summing"
630 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
638 gradbufc(k,nres)=0.0d0
643 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
644 & wel_loc*gel_loc(j,i)+
645 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
646 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
647 & wel_loc*gel_loc_long(j,i)+
648 & wcorr*gradcorr_long(j,i)+
649 & wcorr5*gradcorr5_long(j,i)+
650 & wcorr6*gradcorr6_long(j,i)+
651 & wturn6*gcorr6_turn_long(j,i))+
653 & wcorr*gradcorr(j,i)+
654 & wturn3*gcorr3_turn(j,i)+
655 & wturn4*gcorr4_turn(j,i)+
656 & wcorr5*gradcorr5(j,i)+
657 & wcorr6*gradcorr6(j,i)+
658 & wturn6*gcorr6_turn(j,i)+
659 & wsccor*gsccorc(j,i)
660 & +wscloc*gscloc(j,i)
662 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
663 & wel_loc*gel_loc(j,i)+
664 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
665 & welec*gelc_long(j,i)
666 & wel_loc*gel_loc_long(j,i)+
667 & wcorr*gcorr_long(j,i)+
668 & wcorr5*gradcorr5_long(j,i)+
669 & wcorr6*gradcorr6_long(j,i)+
670 & wturn6*gcorr6_turn_long(j,i))+
672 & wcorr*gradcorr(j,i)+
673 & wturn3*gcorr3_turn(j,i)+
674 & wturn4*gcorr4_turn(j,i)+
675 & wcorr5*gradcorr5(j,i)+
676 & wcorr6*gradcorr6(j,i)+
677 & wturn6*gcorr6_turn(j,i)+
678 & wsccor*gsccorc(j,i)
679 & +wscloc*gscloc(j,i)
681 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
683 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
684 & wsccor*gsccorx(j,i)
685 & +wscloc*gsclocx(j,i)
689 write (iout,*) "gloc before adding corr"
691 write (iout,*) i,gloc(i,icg)
695 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
696 & +wcorr5*g_corr5_loc(i)
697 & +wcorr6*g_corr6_loc(i)
698 & +wturn4*gel_loc_turn4(i)
699 & +wturn3*gel_loc_turn3(i)
700 & +wturn6*gel_loc_turn6(i)
701 & +wel_loc*gel_loc_loc(i)
704 write (iout,*) "gloc after adding corr"
706 write (iout,*) i,gloc(i,icg)
710 if (nfgtasks.gt.1) then
713 gradbufc(j,i)=gradc(j,i,icg)
714 gradbufx(j,i)=gradx(j,i,icg)
718 glocbuf(i)=gloc(i,icg)
722 write (iout,*) "gloc_sc before reduce"
725 write (iout,*) i,j,gloc_sc(j,i,icg)
732 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
736 call MPI_Barrier(FG_COMM,IERR)
737 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
739 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
740 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
741 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
742 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
743 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
744 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
745 time_reduce=time_reduce+MPI_Wtime()-time00
746 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
747 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
748 time_reduce=time_reduce+MPI_Wtime()-time00
751 write (iout,*) "gloc_sc after reduce"
754 write (iout,*) i,j,gloc_sc(j,i,icg)
760 write (iout,*) "gloc after reduce"
762 write (iout,*) i,gloc(i,icg)
767 if (gnorm_check) then
769 c Compute the maximum elements of the gradient
779 gcorr3_turn_max=0.0d0
780 gcorr4_turn_max=0.0d0
783 gcorr6_turn_max=0.0d0
793 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
794 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
795 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
796 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
797 & gvdwc_scp_max=gvdwc_scp_norm
798 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
799 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
800 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
801 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
802 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
803 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
804 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
805 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
806 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
807 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
808 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
809 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
810 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
812 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
813 & gcorr3_turn_max=gcorr3_turn_norm
814 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
816 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
817 & gcorr4_turn_max=gcorr4_turn_norm
818 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
819 if (gradcorr5_norm.gt.gradcorr5_max)
820 & gradcorr5_max=gradcorr5_norm
821 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
822 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
823 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
825 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
826 & gcorr6_turn_max=gcorr6_turn_norm
827 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
828 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
829 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
830 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
831 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
832 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
833 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
834 if (gradx_scp_norm.gt.gradx_scp_max)
835 & gradx_scp_max=gradx_scp_norm
836 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
837 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
838 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
839 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
840 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
841 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
842 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
843 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
847 open(istat,file=statname,position="append")
849 open(istat,file=statname,access="append")
851 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
852 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
853 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
854 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
855 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
856 & gsccorx_max,gsclocx_max
858 if (gvdwc_max.gt.1.0d4) then
859 write (iout,*) "gvdwc gvdwx gradb gradbx"
861 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
862 & gradb(j,i),gradbx(j,i),j=1,3)
864 call pdbout(0.0d0,'cipiszcze',iout)
870 write (iout,*) "gradc gradx gloc"
872 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
873 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
877 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
881 c-------------------------------------------------------------------------------
882 subroutine rescale_weights(t_bath)
883 implicit real*8 (a-h,o-z)
885 include 'COMMON.IOUNITS'
886 include 'COMMON.FFIELD'
887 include 'COMMON.SBRIDGE'
888 double precision kfac /2.4d0/
889 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
891 c facT=2*temp0/(t_bath+temp0)
892 if (rescale_mode.eq.0) then
898 else if (rescale_mode.eq.1) then
899 facT=kfac/(kfac-1.0d0+t_bath/temp0)
900 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
901 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
902 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
903 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
904 else if (rescale_mode.eq.2) then
910 facT=licznik/dlog(dexp(x)+dexp(-x))
911 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
912 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
913 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
914 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
916 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
917 write (*,*) "Wrong RESCALE_MODE",rescale_mode
919 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
923 welec=weights(3)*fact
924 wcorr=weights(4)*fact3
925 wcorr5=weights(5)*fact4
926 wcorr6=weights(6)*fact5
927 wel_loc=weights(7)*fact2
928 wturn3=weights(8)*fact2
929 wturn4=weights(9)*fact3
930 wturn6=weights(10)*fact5
931 wtor=weights(13)*fact
932 wtor_d=weights(14)*fact2
933 wsccor=weights(21)*fact
937 C------------------------------------------------------------------------
938 subroutine enerprint(energia)
939 implicit real*8 (a-h,o-z)
941 include 'COMMON.IOUNITS'
942 include 'COMMON.FFIELD'
943 include 'COMMON.SBRIDGE'
945 double precision energia(0:n_ene)
950 evdw2=energia(2)+energia(18)
962 eello_turn3=energia(8)
963 eello_turn4=energia(9)
964 eello_turn6=energia(10)
970 edihcnstr=energia(19)
975 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
976 & estr,wbond,ebe,wang,
977 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
979 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
980 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
983 10 format (/'Virtual-chain energies:'//
984 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
985 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
986 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
987 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
988 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
989 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
990 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
991 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
992 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
993 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
994 & ' (SS bridges & dist. cnstr.)'/
995 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
996 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
997 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
998 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
999 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1000 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1001 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1002 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1003 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1004 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1005 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1006 & 'ETOT= ',1pE16.6,' (total)')
1008 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1009 & estr,wbond,ebe,wang,
1010 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1012 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1013 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1014 & ebr*nss,Uconst,etot
1015 10 format (/'Virtual-chain energies:'//
1016 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1017 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1018 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1019 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1020 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1021 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1022 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1023 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1024 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1025 & ' (SS bridges & dist. cnstr.)'/
1026 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1027 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1028 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1029 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1030 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1031 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1032 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1033 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1034 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1035 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1036 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1037 & 'ETOT= ',1pE16.6,' (total)')
1041 C-----------------------------------------------------------------------
1042 subroutine elj(evdw)
1044 C This subroutine calculates the interaction energy of nonbonded side chains
1045 C assuming the LJ potential of interaction.
1047 implicit real*8 (a-h,o-z)
1048 include 'DIMENSIONS'
1049 parameter (accur=1.0d-10)
1050 include 'COMMON.GEO'
1051 include 'COMMON.VAR'
1052 include 'COMMON.LOCAL'
1053 include 'COMMON.CHAIN'
1054 include 'COMMON.DERIV'
1055 include 'COMMON.INTERACT'
1056 include 'COMMON.TORSION'
1057 include 'COMMON.SBRIDGE'
1058 include 'COMMON.NAMES'
1059 include 'COMMON.IOUNITS'
1060 include 'COMMON.CONTACTS'
1062 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1064 do i=iatsc_s,iatsc_e
1065 itypi=iabs(itype(i))
1066 if (itypi.eq.ntyp1) cycle
1067 itypi1=iabs(itype(i+1))
1074 C Calculate SC interaction energy.
1076 do iint=1,nint_gr(i)
1077 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1078 cd & 'iend=',iend(i,iint)
1079 do j=istart(i,iint),iend(i,iint)
1080 itypj=iabs(itype(j))
1081 if (itypj.eq.ntyp1) cycle
1085 C Change 12/1/95 to calculate four-body interactions
1086 rij=xj*xj+yj*yj+zj*zj
1088 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1089 eps0ij=eps(itypi,itypj)
1091 e1=fac*fac*aa(itypi,itypj)
1092 e2=fac*bb(itypi,itypj)
1094 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1095 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1096 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1097 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1098 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1099 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1102 C Calculate the components of the gradient in DC and X
1104 fac=-rrij*(e1+evdwij)
1109 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1110 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1111 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1112 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1116 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1120 C 12/1/95, revised on 5/20/97
1122 C Calculate the contact function. The ith column of the array JCONT will
1123 C contain the numbers of atoms that make contacts with the atom I (of numbers
1124 C greater than I). The arrays FACONT and GACONT will contain the values of
1125 C the contact function and its derivative.
1127 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1128 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1129 C Uncomment next line, if the correlation interactions are contact function only
1130 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1132 sigij=sigma(itypi,itypj)
1133 r0ij=rs0(itypi,itypj)
1135 C Check whether the SC's are not too far to make a contact.
1138 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1139 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1141 if (fcont.gt.0.0D0) then
1142 C If the SC-SC distance if close to sigma, apply spline.
1143 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1144 cAdam & fcont1,fprimcont1)
1145 cAdam fcont1=1.0d0-fcont1
1146 cAdam if (fcont1.gt.0.0d0) then
1147 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1148 cAdam fcont=fcont*fcont1
1150 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1151 cga eps0ij=1.0d0/dsqrt(eps0ij)
1153 cga gg(k)=gg(k)*eps0ij
1155 cga eps0ij=-evdwij*eps0ij
1156 C Uncomment for AL's type of SC correlation interactions.
1157 cadam eps0ij=-evdwij
1158 num_conti=num_conti+1
1159 jcont(num_conti,i)=j
1160 facont(num_conti,i)=fcont*eps0ij
1161 fprimcont=eps0ij*fprimcont/rij
1163 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1164 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1165 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1166 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1167 gacont(1,num_conti,i)=-fprimcont*xj
1168 gacont(2,num_conti,i)=-fprimcont*yj
1169 gacont(3,num_conti,i)=-fprimcont*zj
1170 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1171 cd write (iout,'(2i3,3f10.5)')
1172 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1178 num_cont(i)=num_conti
1182 gvdwc(j,i)=expon*gvdwc(j,i)
1183 gvdwx(j,i)=expon*gvdwx(j,i)
1186 C******************************************************************************
1190 C To save time, the factor of EXPON has been extracted from ALL components
1191 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1194 C******************************************************************************
1197 C-----------------------------------------------------------------------------
1198 subroutine eljk(evdw)
1200 C This subroutine calculates the interaction energy of nonbonded side chains
1201 C assuming the LJK potential of interaction.
1203 implicit real*8 (a-h,o-z)
1204 include 'DIMENSIONS'
1205 include 'COMMON.GEO'
1206 include 'COMMON.VAR'
1207 include 'COMMON.LOCAL'
1208 include 'COMMON.CHAIN'
1209 include 'COMMON.DERIV'
1210 include 'COMMON.INTERACT'
1211 include 'COMMON.IOUNITS'
1212 include 'COMMON.NAMES'
1215 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1217 do i=iatsc_s,iatsc_e
1218 itypi=iabs(itype(i))
1219 if (itypi.eq.ntyp1) cycle
1220 itypi1=iabs(itype(i+1))
1225 C Calculate SC interaction energy.
1227 do iint=1,nint_gr(i)
1228 do j=istart(i,iint),iend(i,iint)
1229 itypj=iabs(itype(j))
1230 if (itypj.eq.ntyp1) cycle
1234 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1235 fac_augm=rrij**expon
1236 e_augm=augm(itypi,itypj)*fac_augm
1237 r_inv_ij=dsqrt(rrij)
1239 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1240 fac=r_shift_inv**expon
1241 e1=fac*fac*aa(itypi,itypj)
1242 e2=fac*bb(itypi,itypj)
1244 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1245 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1246 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1247 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1248 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1249 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1250 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1253 C Calculate the components of the gradient in DC and X
1255 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1260 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1261 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1262 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1263 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1267 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1275 gvdwc(j,i)=expon*gvdwc(j,i)
1276 gvdwx(j,i)=expon*gvdwx(j,i)
1281 C-----------------------------------------------------------------------------
1282 subroutine ebp(evdw)
1284 C This subroutine calculates the interaction energy of nonbonded side chains
1285 C assuming the Berne-Pechukas potential of interaction.
1287 implicit real*8 (a-h,o-z)
1288 include 'DIMENSIONS'
1289 include 'COMMON.GEO'
1290 include 'COMMON.VAR'
1291 include 'COMMON.LOCAL'
1292 include 'COMMON.CHAIN'
1293 include 'COMMON.DERIV'
1294 include 'COMMON.NAMES'
1295 include 'COMMON.INTERACT'
1296 include 'COMMON.IOUNITS'
1297 include 'COMMON.CALC'
1298 common /srutu/ icall
1299 c double precision rrsave(maxdim)
1302 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1304 c if (icall.eq.0) then
1310 do i=iatsc_s,iatsc_e
1311 itypi=iabs(itype(i))
1312 if (itypi.eq.ntyp1) cycle
1313 itypi1=iabs(itype(i+1))
1317 dxi=dc_norm(1,nres+i)
1318 dyi=dc_norm(2,nres+i)
1319 dzi=dc_norm(3,nres+i)
1320 c dsci_inv=dsc_inv(itypi)
1321 dsci_inv=vbld_inv(i+nres)
1323 C Calculate SC interaction energy.
1325 do iint=1,nint_gr(i)
1326 do j=istart(i,iint),iend(i,iint)
1328 itypj=iabs(itype(j))
1329 if (itypj.eq.ntyp1) cycle
1330 c dscj_inv=dsc_inv(itypj)
1331 dscj_inv=vbld_inv(j+nres)
1332 chi1=chi(itypi,itypj)
1333 chi2=chi(itypj,itypi)
1340 alf12=0.5D0*(alf1+alf2)
1341 C For diagnostics only!!!
1354 dxj=dc_norm(1,nres+j)
1355 dyj=dc_norm(2,nres+j)
1356 dzj=dc_norm(3,nres+j)
1357 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1358 cd if (icall.eq.0) then
1364 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1366 C Calculate whole angle-dependent part of epsilon and contributions
1367 C to its derivatives
1368 fac=(rrij*sigsq)**expon2
1369 e1=fac*fac*aa(itypi,itypj)
1370 e2=fac*bb(itypi,itypj)
1371 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1372 eps2der=evdwij*eps3rt
1373 eps3der=evdwij*eps2rt
1374 evdwij=evdwij*eps2rt*eps3rt
1377 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1378 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1379 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1380 cd & restyp(itypi),i,restyp(itypj),j,
1381 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1382 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1383 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1386 C Calculate gradient components.
1387 e1=e1*eps1*eps2rt**2*eps3rt**2
1388 fac=-expon*(e1+evdwij)
1391 C Calculate radial part of the gradient
1395 C Calculate the angular part of the gradient and sum add the contributions
1396 C to the appropriate components of the Cartesian gradient.
1404 C-----------------------------------------------------------------------------
1405 subroutine egb(evdw)
1407 C This subroutine calculates the interaction energy of nonbonded side chains
1408 C assuming the Gay-Berne potential of interaction.
1410 implicit real*8 (a-h,o-z)
1411 include 'DIMENSIONS'
1412 include 'COMMON.GEO'
1413 include 'COMMON.VAR'
1414 include 'COMMON.LOCAL'
1415 include 'COMMON.CHAIN'
1416 include 'COMMON.DERIV'
1417 include 'COMMON.NAMES'
1418 include 'COMMON.INTERACT'
1419 include 'COMMON.IOUNITS'
1420 include 'COMMON.CALC'
1421 include 'COMMON.CONTROL'
1422 include 'COMMON.SPLITELE'
1423 include 'COMMON.SBRIDGE'
1425 integer xshift,yshift,zshift
1427 ccccc energy_dec=.false.
1428 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1431 c if (icall.eq.0) lprn=.false.
1433 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1434 C we have the original box)
1438 do i=iatsc_s,iatsc_e
1439 itypi=iabs(itype(i))
1440 if (itypi.eq.ntyp1) cycle
1441 itypi1=iabs(itype(i+1))
1445 C Return atom into box, boxxsize is size of box in x dimension
1447 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1448 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1449 C Condition for being inside the proper box
1450 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1451 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1455 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1456 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1457 C Condition for being inside the proper box
1458 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1459 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1463 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1464 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1465 C Condition for being inside the proper box
1466 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1467 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1471 if (xi.lt.0) xi=xi+boxxsize
1473 if (yi.lt.0) yi=yi+boxysize
1475 if (zi.lt.0) zi=zi+boxzsize
1476 C xi=xi+xshift*boxxsize
1477 C yi=yi+yshift*boxysize
1478 C zi=zi+zshift*boxzsize
1480 dxi=dc_norm(1,nres+i)
1481 dyi=dc_norm(2,nres+i)
1482 dzi=dc_norm(3,nres+i)
1483 c dsci_inv=dsc_inv(itypi)
1484 dsci_inv=vbld_inv(i+nres)
1485 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1486 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1488 C Calculate SC interaction energy.
1490 do iint=1,nint_gr(i)
1491 do j=istart(i,iint),iend(i,iint)
1492 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1493 call dyn_ssbond_ene(i,j,evdwij)
1495 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1496 & 'evdw',i,j,evdwij,' ss'
1499 itypj=iabs(itype(j))
1500 if (itypj.eq.ntyp1) cycle
1501 c dscj_inv=dsc_inv(itypj)
1502 dscj_inv=vbld_inv(j+nres)
1503 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1504 c & 1.0d0/vbld(j+nres)
1505 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1506 sig0ij=sigma(itypi,itypj)
1507 chi1=chi(itypi,itypj)
1508 chi2=chi(itypj,itypi)
1515 alf12=0.5D0*(alf1+alf2)
1516 C For diagnostics only!!!
1529 C Return atom J into box the original box
1531 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1532 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1533 C Condition for being inside the proper box
1534 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1535 c & (xj.lt.((-0.5d0)*boxxsize))) then
1539 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1540 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1541 C Condition for being inside the proper box
1542 c if ((yj.gt.((0.5d0)*boxysize)).or.
1543 c & (yj.lt.((-0.5d0)*boxysize))) then
1547 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1548 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1549 C Condition for being inside the proper box
1550 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1551 c & (zj.lt.((-0.5d0)*boxzsize))) then
1555 if (xj.lt.0) xj=xj+boxxsize
1557 if (yj.lt.0) yj=yj+boxysize
1559 if (zj.lt.0) zj=zj+boxzsize
1560 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1568 xj=xj_safe+xshift*boxxsize
1569 yj=yj_safe+yshift*boxysize
1570 zj=zj_safe+zshift*boxzsize
1571 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1572 if(dist_temp.lt.dist_init) then
1582 if (subchap.eq.1) then
1591 dxj=dc_norm(1,nres+j)
1592 dyj=dc_norm(2,nres+j)
1593 dzj=dc_norm(3,nres+j)
1597 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1598 c write (iout,*) "j",j," dc_norm",
1599 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1600 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1602 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1603 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1605 c write (iout,'(a7,4f8.3)')
1606 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1607 if (sss.gt.0.0d0) then
1608 C Calculate angle-dependent terms of energy and contributions to their
1612 sig=sig0ij*dsqrt(sigsq)
1613 rij_shift=1.0D0/rij-sig+sig0ij
1614 c for diagnostics; uncomment
1615 c rij_shift=1.2*sig0ij
1616 C I hate to put IF's in the loops, but here don't have another choice!!!!
1617 if (rij_shift.le.0.0D0) then
1619 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1620 cd & restyp(itypi),i,restyp(itypj),j,
1621 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1625 c---------------------------------------------------------------
1626 rij_shift=1.0D0/rij_shift
1627 fac=rij_shift**expon
1628 e1=fac*fac*aa(itypi,itypj)
1629 e2=fac*bb(itypi,itypj)
1630 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1631 eps2der=evdwij*eps3rt
1632 eps3der=evdwij*eps2rt
1633 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1634 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1635 evdwij=evdwij*eps2rt*eps3rt
1636 evdw=evdw+evdwij*sss
1638 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1639 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1640 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1641 & restyp(itypi),i,restyp(itypj),j,
1642 & epsi,sigm,chi1,chi2,chip1,chip2,
1643 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1644 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1648 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1651 C Calculate gradient components.
1652 e1=e1*eps1*eps2rt**2*eps3rt**2
1653 fac=-expon*(e1+evdwij)*rij_shift
1656 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1657 c & evdwij,fac,sigma(itypi,itypj),expon
1658 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1660 C Calculate the radial part of the gradient
1664 C Calculate angular part of the gradient.
1674 c write (iout,*) "Number of loop steps in EGB:",ind
1675 cccc energy_dec=.false.
1678 C-----------------------------------------------------------------------------
1679 subroutine egbv(evdw)
1681 C This subroutine calculates the interaction energy of nonbonded side chains
1682 C assuming the Gay-Berne-Vorobjev potential of interaction.
1684 implicit real*8 (a-h,o-z)
1685 include 'DIMENSIONS'
1686 include 'COMMON.GEO'
1687 include 'COMMON.VAR'
1688 include 'COMMON.LOCAL'
1689 include 'COMMON.CHAIN'
1690 include 'COMMON.DERIV'
1691 include 'COMMON.NAMES'
1692 include 'COMMON.INTERACT'
1693 include 'COMMON.IOUNITS'
1694 include 'COMMON.CALC'
1695 common /srutu/ icall
1698 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1701 c if (icall.eq.0) lprn=.true.
1703 do i=iatsc_s,iatsc_e
1704 itypi=iabs(itype(i))
1705 if (itypi.eq.ntyp1) cycle
1706 itypi1=iabs(itype(i+1))
1710 dxi=dc_norm(1,nres+i)
1711 dyi=dc_norm(2,nres+i)
1712 dzi=dc_norm(3,nres+i)
1713 c dsci_inv=dsc_inv(itypi)
1714 dsci_inv=vbld_inv(i+nres)
1716 C Calculate SC interaction energy.
1718 do iint=1,nint_gr(i)
1719 do j=istart(i,iint),iend(i,iint)
1721 itypj=iabs(itype(j))
1722 if (itypj.eq.ntyp1) cycle
1723 c dscj_inv=dsc_inv(itypj)
1724 dscj_inv=vbld_inv(j+nres)
1725 sig0ij=sigma(itypi,itypj)
1726 r0ij=r0(itypi,itypj)
1727 chi1=chi(itypi,itypj)
1728 chi2=chi(itypj,itypi)
1735 alf12=0.5D0*(alf1+alf2)
1736 C For diagnostics only!!!
1749 dxj=dc_norm(1,nres+j)
1750 dyj=dc_norm(2,nres+j)
1751 dzj=dc_norm(3,nres+j)
1752 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1754 C Calculate angle-dependent terms of energy and contributions to their
1758 sig=sig0ij*dsqrt(sigsq)
1759 rij_shift=1.0D0/rij-sig+r0ij
1760 C I hate to put IF's in the loops, but here don't have another choice!!!!
1761 if (rij_shift.le.0.0D0) then
1766 c---------------------------------------------------------------
1767 rij_shift=1.0D0/rij_shift
1768 fac=rij_shift**expon
1769 e1=fac*fac*aa(itypi,itypj)
1770 e2=fac*bb(itypi,itypj)
1771 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1772 eps2der=evdwij*eps3rt
1773 eps3der=evdwij*eps2rt
1774 fac_augm=rrij**expon
1775 e_augm=augm(itypi,itypj)*fac_augm
1776 evdwij=evdwij*eps2rt*eps3rt
1777 evdw=evdw+evdwij+e_augm
1779 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1780 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1781 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1782 & restyp(itypi),i,restyp(itypj),j,
1783 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1784 & chi1,chi2,chip1,chip2,
1785 & eps1,eps2rt**2,eps3rt**2,
1786 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1789 C Calculate gradient components.
1790 e1=e1*eps1*eps2rt**2*eps3rt**2
1791 fac=-expon*(e1+evdwij)*rij_shift
1793 fac=rij*fac-2*expon*rrij*e_augm
1794 C Calculate the radial part of the gradient
1798 C Calculate angular part of the gradient.
1804 C-----------------------------------------------------------------------------
1805 subroutine sc_angular
1806 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1807 C om12. Called by ebp, egb, and egbv.
1809 include 'COMMON.CALC'
1810 include 'COMMON.IOUNITS'
1814 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1815 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1816 om12=dxi*dxj+dyi*dyj+dzi*dzj
1818 C Calculate eps1(om12) and its derivative in om12
1819 faceps1=1.0D0-om12*chiom12
1820 faceps1_inv=1.0D0/faceps1
1821 eps1=dsqrt(faceps1_inv)
1822 C Following variable is eps1*deps1/dom12
1823 eps1_om12=faceps1_inv*chiom12
1828 c write (iout,*) "om12",om12," eps1",eps1
1829 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1834 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1835 sigsq=1.0D0-facsig*faceps1_inv
1836 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1837 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1838 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1844 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1845 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1847 C Calculate eps2 and its derivatives in om1, om2, and om12.
1850 chipom12=chip12*om12
1851 facp=1.0D0-om12*chipom12
1853 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1854 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1855 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1856 C Following variable is the square root of eps2
1857 eps2rt=1.0D0-facp1*facp_inv
1858 C Following three variables are the derivatives of the square root of eps
1859 C in om1, om2, and om12.
1860 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1861 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1862 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1863 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1864 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1865 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1866 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1867 c & " eps2rt_om12",eps2rt_om12
1868 C Calculate whole angle-dependent part of epsilon and contributions
1869 C to its derivatives
1872 C----------------------------------------------------------------------------
1874 implicit real*8 (a-h,o-z)
1875 include 'DIMENSIONS'
1876 include 'COMMON.CHAIN'
1877 include 'COMMON.DERIV'
1878 include 'COMMON.CALC'
1879 include 'COMMON.IOUNITS'
1880 double precision dcosom1(3),dcosom2(3)
1881 cc print *,'sss=',sss
1882 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1883 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1884 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1885 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1889 c eom12=evdwij*eps1_om12
1891 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1892 c & " sigder",sigder
1893 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1894 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1896 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1897 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1900 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
1902 c write (iout,*) "gg",(gg(k),k=1,3)
1904 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1905 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1906 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
1907 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1908 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1909 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
1910 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1911 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1912 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1913 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1916 C Calculate the components of the gradient in DC and X
1920 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1924 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1925 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1929 C-----------------------------------------------------------------------
1930 subroutine e_softsphere(evdw)
1932 C This subroutine calculates the interaction energy of nonbonded side chains
1933 C assuming the LJ potential of interaction.
1935 implicit real*8 (a-h,o-z)
1936 include 'DIMENSIONS'
1937 parameter (accur=1.0d-10)
1938 include 'COMMON.GEO'
1939 include 'COMMON.VAR'
1940 include 'COMMON.LOCAL'
1941 include 'COMMON.CHAIN'
1942 include 'COMMON.DERIV'
1943 include 'COMMON.INTERACT'
1944 include 'COMMON.TORSION'
1945 include 'COMMON.SBRIDGE'
1946 include 'COMMON.NAMES'
1947 include 'COMMON.IOUNITS'
1948 include 'COMMON.CONTACTS'
1950 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1952 do i=iatsc_s,iatsc_e
1953 itypi=iabs(itype(i))
1954 if (itypi.eq.ntyp1) cycle
1955 itypi1=iabs(itype(i+1))
1960 C Calculate SC interaction energy.
1962 do iint=1,nint_gr(i)
1963 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1964 cd & 'iend=',iend(i,iint)
1965 do j=istart(i,iint),iend(i,iint)
1966 itypj=iabs(itype(j))
1967 if (itypj.eq.ntyp1) cycle
1971 rij=xj*xj+yj*yj+zj*zj
1972 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1973 r0ij=r0(itypi,itypj)
1975 c print *,i,j,r0ij,dsqrt(rij)
1976 if (rij.lt.r0ijsq) then
1977 evdwij=0.25d0*(rij-r0ijsq)**2
1985 C Calculate the components of the gradient in DC and X
1991 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1992 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1993 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1994 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1998 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2006 C--------------------------------------------------------------------------
2007 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2010 C Soft-sphere potential of p-p interaction
2012 implicit real*8 (a-h,o-z)
2013 include 'DIMENSIONS'
2014 include 'COMMON.CONTROL'
2015 include 'COMMON.IOUNITS'
2016 include 'COMMON.GEO'
2017 include 'COMMON.VAR'
2018 include 'COMMON.LOCAL'
2019 include 'COMMON.CHAIN'
2020 include 'COMMON.DERIV'
2021 include 'COMMON.INTERACT'
2022 include 'COMMON.CONTACTS'
2023 include 'COMMON.TORSION'
2024 include 'COMMON.VECTORS'
2025 include 'COMMON.FFIELD'
2027 C write(iout,*) 'In EELEC_soft_sphere'
2034 do i=iatel_s,iatel_e
2035 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2039 xmedi=c(1,i)+0.5d0*dxi
2040 ymedi=c(2,i)+0.5d0*dyi
2041 zmedi=c(3,i)+0.5d0*dzi
2042 xmedi=mod(xmedi,boxxsize)
2043 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2044 ymedi=mod(ymedi,boxysize)
2045 if (ymedi.lt.0) ymedi=ymedi+boxysize
2046 zmedi=mod(zmedi,boxzsize)
2047 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2049 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2050 do j=ielstart(i),ielend(i)
2051 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2055 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2056 r0ij=rpp(iteli,itelj)
2065 if (xj.lt.0) xj=xj+boxxsize
2067 if (yj.lt.0) yj=yj+boxysize
2069 if (zj.lt.0) zj=zj+boxzsize
2070 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2078 xj=xj_safe+xshift*boxxsize
2079 yj=yj_safe+yshift*boxysize
2080 zj=zj_safe+zshift*boxzsize
2081 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2082 if(dist_temp.lt.dist_init) then
2092 if (isubchap.eq.1) then
2101 rij=xj*xj+yj*yj+zj*zj
2102 sss=sscale(sqrt(rij))
2103 sssgrad=sscagrad(sqrt(rij))
2104 if (rij.lt.r0ijsq) then
2105 evdw1ij=0.25d0*(rij-r0ijsq)**2
2111 evdw1=evdw1+evdw1ij*sss
2113 C Calculate contributions to the Cartesian gradient.
2115 ggg(1)=fac*xj*sssgrad
2116 ggg(2)=fac*yj*sssgrad
2117 ggg(3)=fac*zj*sssgrad
2119 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2120 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2123 * Loop over residues i+1 thru j-1.
2127 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2132 cgrad do i=nnt,nct-1
2134 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2136 cgrad do j=i+1,nct-1
2138 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2144 c------------------------------------------------------------------------------
2145 subroutine vec_and_deriv
2146 implicit real*8 (a-h,o-z)
2147 include 'DIMENSIONS'
2151 include 'COMMON.IOUNITS'
2152 include 'COMMON.GEO'
2153 include 'COMMON.VAR'
2154 include 'COMMON.LOCAL'
2155 include 'COMMON.CHAIN'
2156 include 'COMMON.VECTORS'
2157 include 'COMMON.SETUP'
2158 include 'COMMON.TIME1'
2159 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2160 C Compute the local reference systems. For reference system (i), the
2161 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2162 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2164 do i=ivec_start,ivec_end
2168 if (i.eq.nres-1) then
2169 C Case of the last full residue
2170 C Compute the Z-axis
2171 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2172 costh=dcos(pi-theta(nres))
2173 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2177 C Compute the derivatives of uz
2179 uzder(2,1,1)=-dc_norm(3,i-1)
2180 uzder(3,1,1)= dc_norm(2,i-1)
2181 uzder(1,2,1)= dc_norm(3,i-1)
2183 uzder(3,2,1)=-dc_norm(1,i-1)
2184 uzder(1,3,1)=-dc_norm(2,i-1)
2185 uzder(2,3,1)= dc_norm(1,i-1)
2188 uzder(2,1,2)= dc_norm(3,i)
2189 uzder(3,1,2)=-dc_norm(2,i)
2190 uzder(1,2,2)=-dc_norm(3,i)
2192 uzder(3,2,2)= dc_norm(1,i)
2193 uzder(1,3,2)= dc_norm(2,i)
2194 uzder(2,3,2)=-dc_norm(1,i)
2196 C Compute the Y-axis
2199 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2201 C Compute the derivatives of uy
2204 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2205 & -dc_norm(k,i)*dc_norm(j,i-1)
2206 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2208 uyder(j,j,1)=uyder(j,j,1)-costh
2209 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2214 uygrad(l,k,j,i)=uyder(l,k,j)
2215 uzgrad(l,k,j,i)=uzder(l,k,j)
2219 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2220 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2221 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2222 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2225 C Compute the Z-axis
2226 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2227 costh=dcos(pi-theta(i+2))
2228 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2232 C Compute the derivatives of uz
2234 uzder(2,1,1)=-dc_norm(3,i+1)
2235 uzder(3,1,1)= dc_norm(2,i+1)
2236 uzder(1,2,1)= dc_norm(3,i+1)
2238 uzder(3,2,1)=-dc_norm(1,i+1)
2239 uzder(1,3,1)=-dc_norm(2,i+1)
2240 uzder(2,3,1)= dc_norm(1,i+1)
2243 uzder(2,1,2)= dc_norm(3,i)
2244 uzder(3,1,2)=-dc_norm(2,i)
2245 uzder(1,2,2)=-dc_norm(3,i)
2247 uzder(3,2,2)= dc_norm(1,i)
2248 uzder(1,3,2)= dc_norm(2,i)
2249 uzder(2,3,2)=-dc_norm(1,i)
2251 C Compute the Y-axis
2254 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2256 C Compute the derivatives of uy
2259 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2260 & -dc_norm(k,i)*dc_norm(j,i+1)
2261 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2263 uyder(j,j,1)=uyder(j,j,1)-costh
2264 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2269 uygrad(l,k,j,i)=uyder(l,k,j)
2270 uzgrad(l,k,j,i)=uzder(l,k,j)
2274 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2275 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2276 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2277 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2281 vbld_inv_temp(1)=vbld_inv(i+1)
2282 if (i.lt.nres-1) then
2283 vbld_inv_temp(2)=vbld_inv(i+2)
2285 vbld_inv_temp(2)=vbld_inv(i)
2290 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2291 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2296 #if defined(PARVEC) && defined(MPI)
2297 if (nfgtasks1.gt.1) then
2299 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2300 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2301 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2302 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2303 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2305 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2306 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2308 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2309 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2310 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2311 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2312 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2313 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2314 time_gather=time_gather+MPI_Wtime()-time00
2316 c if (fg_rank.eq.0) then
2317 c write (iout,*) "Arrays UY and UZ"
2319 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2326 C-----------------------------------------------------------------------------
2327 subroutine check_vecgrad
2328 implicit real*8 (a-h,o-z)
2329 include 'DIMENSIONS'
2330 include 'COMMON.IOUNITS'
2331 include 'COMMON.GEO'
2332 include 'COMMON.VAR'
2333 include 'COMMON.LOCAL'
2334 include 'COMMON.CHAIN'
2335 include 'COMMON.VECTORS'
2336 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2337 dimension uyt(3,maxres),uzt(3,maxres)
2338 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2339 double precision delta /1.0d-7/
2342 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2343 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2344 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2345 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2346 cd & (dc_norm(if90,i),if90=1,3)
2347 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2348 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2349 cd write(iout,'(a)')
2355 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2356 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2369 cd write (iout,*) 'i=',i
2371 erij(k)=dc_norm(k,i)
2375 dc_norm(k,i)=erij(k)
2377 dc_norm(j,i)=dc_norm(j,i)+delta
2378 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2380 c dc_norm(k,i)=dc_norm(k,i)/fac
2382 c write (iout,*) (dc_norm(k,i),k=1,3)
2383 c write (iout,*) (erij(k),k=1,3)
2386 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2387 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2388 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2389 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2391 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2392 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2393 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2396 dc_norm(k,i)=erij(k)
2399 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2400 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2401 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2402 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2403 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2404 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2405 cd write (iout,'(a)')
2410 C--------------------------------------------------------------------------
2411 subroutine set_matrices
2412 implicit real*8 (a-h,o-z)
2413 include 'DIMENSIONS'
2416 include "COMMON.SETUP"
2418 integer status(MPI_STATUS_SIZE)
2420 include 'COMMON.IOUNITS'
2421 include 'COMMON.GEO'
2422 include 'COMMON.VAR'
2423 include 'COMMON.LOCAL'
2424 include 'COMMON.CHAIN'
2425 include 'COMMON.DERIV'
2426 include 'COMMON.INTERACT'
2427 include 'COMMON.CONTACTS'
2428 include 'COMMON.TORSION'
2429 include 'COMMON.VECTORS'
2430 include 'COMMON.FFIELD'
2431 double precision auxvec(2),auxmat(2,2)
2433 C Compute the virtual-bond-torsional-angle dependent quantities needed
2434 C to calculate the el-loc multibody terms of various order.
2436 c write(iout,*) 'nphi=',nphi,nres
2438 do i=ivec_start+2,ivec_end+2
2443 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2444 iti = itortyp(itype(i-2))
2448 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2449 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2450 iti1 = itortyp(itype(i-1))
2455 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2456 & +bnew1(2,1,iti)*dsin(theta(i-1))
2457 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2458 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2459 & +bnew1(2,1,iti)*dcos(theta(i-1))
2460 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2461 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2462 c &*(cos(theta(i)/2.0)
2463 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2464 & +bnew2(2,1,iti)*dsin(theta(i-1))
2465 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2466 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2467 c &*(cos(theta(i)/2.0)
2468 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2469 & +bnew2(2,1,iti)*dcos(theta(i-1))
2470 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2471 c if (ggb1(1,i).eq.0.0d0) then
2472 c write(iout,*) 'i=',i,ggb1(1,i),
2473 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2474 c &bnew1(2,1,iti)*cos(theta(i)),
2475 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2477 b1(2,i-2)=bnew1(1,2,iti)
2479 b2(2,i-2)=bnew2(1,2,iti)
2481 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2482 EE(1,2,i-2)=eeold(1,2,iti)
2483 EE(2,1,i-2)=eeold(2,1,iti)
2484 EE(2,2,i-2)=eeold(2,2,iti)
2485 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2490 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2491 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2492 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2493 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2494 b1tilde(1,i-2)=b1(1,i-2)
2495 b1tilde(2,i-2)=-b1(2,i-2)
2496 b2tilde(1,i-2)=b2(1,i-2)
2497 b2tilde(2,i-2)=-b2(2,i-2)
2498 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2499 c write(iout,*) 'b1=',b1(1,i-2)
2500 c write (iout,*) 'theta=', theta(i-1)
2507 b1tilde(1,i-2)=b1(1,i-2)
2508 b1tilde(2,i-2)=-b1(2,i-2)
2509 b2tilde(1,i-2)=b2(1,i-2)
2510 b2tilde(2,i-2)=-b2(2,i-2)
2511 EE(1,2,i-2)=eeold(1,2,iti)
2512 EE(2,1,i-2)=eeold(2,1,iti)
2513 EE(2,2,i-2)=eeold(2,2,iti)
2514 EE(1,1,i-2)=eeold(1,1,iti)
2518 do i=ivec_start+2,ivec_end+2
2522 if (i .lt. nres+1) then
2559 if (i .gt. 3 .and. i .lt. nres+1) then
2560 obrot_der(1,i-2)=-sin1
2561 obrot_der(2,i-2)= cos1
2562 Ugder(1,1,i-2)= sin1
2563 Ugder(1,2,i-2)=-cos1
2564 Ugder(2,1,i-2)=-cos1
2565 Ugder(2,2,i-2)=-sin1
2568 obrot2_der(1,i-2)=-dwasin2
2569 obrot2_der(2,i-2)= dwacos2
2570 Ug2der(1,1,i-2)= dwasin2
2571 Ug2der(1,2,i-2)=-dwacos2
2572 Ug2der(2,1,i-2)=-dwacos2
2573 Ug2der(2,2,i-2)=-dwasin2
2575 obrot_der(1,i-2)=0.0d0
2576 obrot_der(2,i-2)=0.0d0
2577 Ugder(1,1,i-2)=0.0d0
2578 Ugder(1,2,i-2)=0.0d0
2579 Ugder(2,1,i-2)=0.0d0
2580 Ugder(2,2,i-2)=0.0d0
2581 obrot2_der(1,i-2)=0.0d0
2582 obrot2_der(2,i-2)=0.0d0
2583 Ug2der(1,1,i-2)=0.0d0
2584 Ug2der(1,2,i-2)=0.0d0
2585 Ug2der(2,1,i-2)=0.0d0
2586 Ug2der(2,2,i-2)=0.0d0
2588 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2589 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2590 iti = itortyp(itype(i-2))
2594 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2595 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2596 iti1 = itortyp(itype(i-1))
2600 cd write (iout,*) '*******i',i,' iti1',iti
2601 cd write (iout,*) 'b1',b1(:,iti)
2602 cd write (iout,*) 'b2',b2(:,iti)
2603 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2604 c if (i .gt. iatel_s+2) then
2605 if (i .gt. nnt+2) then
2606 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2608 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2609 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2611 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2612 c & EE(1,2,iti),EE(2,2,iti)
2613 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2614 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2615 c write(iout,*) "Macierz EUG",
2616 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2618 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2620 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2621 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2622 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2623 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2624 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2635 DtUg2(l,k,i-2)=0.0d0
2639 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2640 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2642 muder(k,i-2)=Ub2der(k,i-2)
2644 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2645 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2646 if (itype(i-1).le.ntyp) then
2647 iti1 = itortyp(itype(i-1))
2655 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2657 c write (iout,*) 'mu ',mu(:,i-2),i-2
2658 cd write (iout,*) 'mu1',mu1(:,i-2)
2659 cd write (iout,*) 'mu2',mu2(:,i-2)
2660 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2662 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2663 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2664 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2665 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2666 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2667 C Vectors and matrices dependent on a single virtual-bond dihedral.
2668 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2669 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2670 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2671 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2672 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2673 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2674 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2675 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2676 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2679 C Matrices dependent on two consecutive virtual-bond dihedrals.
2680 C The order of matrices is from left to right.
2681 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2683 c do i=max0(ivec_start,2),ivec_end
2685 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2686 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2687 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2688 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2689 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2690 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2691 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2692 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2695 #if defined(MPI) && defined(PARMAT)
2697 c if (fg_rank.eq.0) then
2698 write (iout,*) "Arrays UG and UGDER before GATHER"
2700 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2701 & ((ug(l,k,i),l=1,2),k=1,2),
2702 & ((ugder(l,k,i),l=1,2),k=1,2)
2704 write (iout,*) "Arrays UG2 and UG2DER"
2706 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2707 & ((ug2(l,k,i),l=1,2),k=1,2),
2708 & ((ug2der(l,k,i),l=1,2),k=1,2)
2710 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2712 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2713 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2714 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2716 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2718 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2719 & costab(i),sintab(i),costab2(i),sintab2(i)
2721 write (iout,*) "Array MUDER"
2723 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2727 if (nfgtasks.gt.1) then
2729 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2730 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2731 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2733 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2734 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2736 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2737 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2739 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2740 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2742 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2743 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2745 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2746 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2748 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2749 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2751 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2752 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2753 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2754 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2755 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2756 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2757 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2758 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2759 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2760 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2761 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2762 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2763 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2765 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2766 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2768 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2769 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2771 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2772 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2774 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2775 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2777 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2778 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2780 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2781 & ivec_count(fg_rank1),
2782 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2784 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2785 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2787 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2788 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2790 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2791 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2793 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2794 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2796 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2797 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2799 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2800 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2802 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2803 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2805 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2806 & ivec_count(fg_rank1),
2807 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2809 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2810 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2812 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2813 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2815 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2816 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2818 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2819 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2821 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2822 & ivec_count(fg_rank1),
2823 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2825 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2826 & ivec_count(fg_rank1),
2827 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2829 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2830 & ivec_count(fg_rank1),
2831 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2832 & MPI_MAT2,FG_COMM1,IERR)
2833 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2834 & ivec_count(fg_rank1),
2835 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2836 & MPI_MAT2,FG_COMM1,IERR)
2839 c Passes matrix info through the ring
2842 if (irecv.lt.0) irecv=nfgtasks1-1
2845 if (inext.ge.nfgtasks1) inext=0
2847 c write (iout,*) "isend",isend," irecv",irecv
2849 lensend=lentyp(isend)
2850 lenrecv=lentyp(irecv)
2851 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2852 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2853 c & MPI_ROTAT1(lensend),inext,2200+isend,
2854 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2855 c & iprev,2200+irecv,FG_COMM,status,IERR)
2856 c write (iout,*) "Gather ROTAT1"
2858 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2859 c & MPI_ROTAT2(lensend),inext,3300+isend,
2860 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2861 c & iprev,3300+irecv,FG_COMM,status,IERR)
2862 c write (iout,*) "Gather ROTAT2"
2864 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2865 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2866 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2867 & iprev,4400+irecv,FG_COMM,status,IERR)
2868 c write (iout,*) "Gather ROTAT_OLD"
2870 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2871 & MPI_PRECOMP11(lensend),inext,5500+isend,
2872 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2873 & iprev,5500+irecv,FG_COMM,status,IERR)
2874 c write (iout,*) "Gather PRECOMP11"
2876 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2877 & MPI_PRECOMP12(lensend),inext,6600+isend,
2878 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2879 & iprev,6600+irecv,FG_COMM,status,IERR)
2880 c write (iout,*) "Gather PRECOMP12"
2882 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2884 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2885 & MPI_ROTAT2(lensend),inext,7700+isend,
2886 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2887 & iprev,7700+irecv,FG_COMM,status,IERR)
2888 c write (iout,*) "Gather PRECOMP21"
2890 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2891 & MPI_PRECOMP22(lensend),inext,8800+isend,
2892 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2893 & iprev,8800+irecv,FG_COMM,status,IERR)
2894 c write (iout,*) "Gather PRECOMP22"
2896 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2897 & MPI_PRECOMP23(lensend),inext,9900+isend,
2898 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2899 & MPI_PRECOMP23(lenrecv),
2900 & iprev,9900+irecv,FG_COMM,status,IERR)
2901 c write (iout,*) "Gather PRECOMP23"
2906 if (irecv.lt.0) irecv=nfgtasks1-1
2909 time_gather=time_gather+MPI_Wtime()-time00
2912 c if (fg_rank.eq.0) then
2913 write (iout,*) "Arrays UG and UGDER"
2915 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2916 & ((ug(l,k,i),l=1,2),k=1,2),
2917 & ((ugder(l,k,i),l=1,2),k=1,2)
2919 write (iout,*) "Arrays UG2 and UG2DER"
2921 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2922 & ((ug2(l,k,i),l=1,2),k=1,2),
2923 & ((ug2der(l,k,i),l=1,2),k=1,2)
2925 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2927 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2928 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2929 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2931 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2933 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2934 & costab(i),sintab(i),costab2(i),sintab2(i)
2936 write (iout,*) "Array MUDER"
2938 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2944 cd iti = itortyp(itype(i))
2947 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2948 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2953 C--------------------------------------------------------------------------
2954 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2956 C This subroutine calculates the average interaction energy and its gradient
2957 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2958 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2959 C The potential depends both on the distance of peptide-group centers and on
2960 C the orientation of the CA-CA virtual bonds.
2962 implicit real*8 (a-h,o-z)
2966 include 'DIMENSIONS'
2967 include 'COMMON.CONTROL'
2968 include 'COMMON.SETUP'
2969 include 'COMMON.IOUNITS'
2970 include 'COMMON.GEO'
2971 include 'COMMON.VAR'
2972 include 'COMMON.LOCAL'
2973 include 'COMMON.CHAIN'
2974 include 'COMMON.DERIV'
2975 include 'COMMON.INTERACT'
2976 include 'COMMON.CONTACTS'
2977 include 'COMMON.TORSION'
2978 include 'COMMON.VECTORS'
2979 include 'COMMON.FFIELD'
2980 include 'COMMON.TIME1'
2981 include 'COMMON.SPLITELE'
2982 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2983 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2984 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2985 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2986 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2987 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2989 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2991 double precision scal_el /1.0d0/
2993 double precision scal_el /0.5d0/
2996 C 13-go grudnia roku pamietnego...
2997 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2998 & 0.0d0,1.0d0,0.0d0,
2999 & 0.0d0,0.0d0,1.0d0/
3000 cd write(iout,*) 'In EELEC'
3002 cd write(iout,*) 'Type',i
3003 cd write(iout,*) 'B1',B1(:,i)
3004 cd write(iout,*) 'B2',B2(:,i)
3005 cd write(iout,*) 'CC',CC(:,:,i)
3006 cd write(iout,*) 'DD',DD(:,:,i)
3007 cd write(iout,*) 'EE',EE(:,:,i)
3009 cd call check_vecgrad
3011 if (icheckgrad.eq.1) then
3013 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3015 dc_norm(k,i)=dc(k,i)*fac
3017 c write (iout,*) 'i',i,' fac',fac
3020 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3021 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3022 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3023 c call vec_and_deriv
3029 time_mat=time_mat+MPI_Wtime()-time01
3033 cd write (iout,*) 'i=',i
3035 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3038 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3039 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3052 cd print '(a)','Enter EELEC'
3053 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3055 gel_loc_loc(i)=0.0d0
3060 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3062 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3064 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3065 do i=iturn3_start,iturn3_end
3066 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3067 C changes suggested by Ana to avoid out of bounds
3068 & .or.((i+4).gt.nres)
3070 C end of changes by Ana
3071 & .or. itype(i+2).eq.ntyp1
3072 & .or. itype(i+3).eq.ntyp1
3073 & .or. itype(i-1).eq.ntyp1
3074 & .or. itype(i+4).eq.ntyp1
3079 dx_normi=dc_norm(1,i)
3080 dy_normi=dc_norm(2,i)
3081 dz_normi=dc_norm(3,i)
3082 xmedi=c(1,i)+0.5d0*dxi
3083 ymedi=c(2,i)+0.5d0*dyi
3084 zmedi=c(3,i)+0.5d0*dzi
3085 xmedi=mod(xmedi,boxxsize)
3086 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3087 ymedi=mod(ymedi,boxysize)
3088 if (ymedi.lt.0) ymedi=ymedi+boxysize
3089 zmedi=mod(zmedi,boxzsize)
3090 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3092 call eelecij(i,i+2,ees,evdw1,eel_loc)
3093 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3094 num_cont_hb(i)=num_conti
3096 do i=iturn4_start,iturn4_end
3097 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3098 C changes suggested by Ana to avoid out of bounds
3099 & .or.((i+5).gt.nres)
3101 C end of changes suggested by Ana
3102 & .or. itype(i+3).eq.ntyp1
3103 & .or. itype(i+4).eq.ntyp1
3104 & .or. itype(i+5).eq.ntyp1
3105 & .or. itype(i).eq.ntyp1
3106 & .or. itype(i-1).eq.ntyp1
3111 dx_normi=dc_norm(1,i)
3112 dy_normi=dc_norm(2,i)
3113 dz_normi=dc_norm(3,i)
3114 xmedi=c(1,i)+0.5d0*dxi
3115 ymedi=c(2,i)+0.5d0*dyi
3116 zmedi=c(3,i)+0.5d0*dzi
3117 C Return atom into box, boxxsize is size of box in x dimension
3119 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3120 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3121 C Condition for being inside the proper box
3122 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3123 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3127 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3128 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3129 C Condition for being inside the proper box
3130 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3131 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3135 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3136 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3137 C Condition for being inside the proper box
3138 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3139 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3142 xmedi=mod(xmedi,boxxsize)
3143 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3144 ymedi=mod(ymedi,boxysize)
3145 if (ymedi.lt.0) ymedi=ymedi+boxysize
3146 zmedi=mod(zmedi,boxzsize)
3147 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3149 num_conti=num_cont_hb(i)
3150 c write(iout,*) "JESTEM W PETLI"
3151 call eelecij(i,i+3,ees,evdw1,eel_loc)
3152 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3153 & call eturn4(i,eello_turn4)
3154 num_cont_hb(i)=num_conti
3156 C Loop over all neighbouring boxes
3161 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3163 do i=iatel_s,iatel_e
3164 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3165 C changes suggested by Ana to avoid out of bounds
3166 & .or.((i+2).gt.nres)
3168 C end of changes by Ana
3169 & .or. itype(i+2).eq.ntyp1
3170 & .or. itype(i-1).eq.ntyp1
3175 dx_normi=dc_norm(1,i)
3176 dy_normi=dc_norm(2,i)
3177 dz_normi=dc_norm(3,i)
3178 xmedi=c(1,i)+0.5d0*dxi
3179 ymedi=c(2,i)+0.5d0*dyi
3180 zmedi=c(3,i)+0.5d0*dzi
3181 xmedi=mod(xmedi,boxxsize)
3182 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3183 ymedi=mod(ymedi,boxysize)
3184 if (ymedi.lt.0) ymedi=ymedi+boxysize
3185 zmedi=mod(zmedi,boxzsize)
3186 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3187 C xmedi=xmedi+xshift*boxxsize
3188 C ymedi=ymedi+yshift*boxysize
3189 C zmedi=zmedi+zshift*boxzsize
3191 C Return tom into box, boxxsize is size of box in x dimension
3193 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3194 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3195 C Condition for being inside the proper box
3196 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3197 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3201 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3202 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3203 C Condition for being inside the proper box
3204 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3205 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3209 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3210 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3211 cC Condition for being inside the proper box
3212 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3213 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3217 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3218 num_conti=num_cont_hb(i)
3219 do j=ielstart(i),ielend(i)
3220 c write (iout,*) i,j,itype(i),itype(j)
3221 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3222 C changes suggested by Ana to avoid out of bounds
3223 & .or.((j+2).gt.nres)
3225 C end of changes by Ana
3226 & .or.itype(j+2).eq.ntyp1
3227 & .or.itype(j-1).eq.ntyp1
3229 call eelecij(i,j,ees,evdw1,eel_loc)
3231 num_cont_hb(i)=num_conti
3237 c write (iout,*) "Number of loop steps in EELEC:",ind
3239 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3240 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3242 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3243 ccc eel_loc=eel_loc+eello_turn3
3244 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3247 C-------------------------------------------------------------------------------
3248 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3249 implicit real*8 (a-h,o-z)
3250 include 'DIMENSIONS'
3254 include 'COMMON.CONTROL'
3255 include 'COMMON.IOUNITS'
3256 include 'COMMON.GEO'
3257 include 'COMMON.VAR'
3258 include 'COMMON.LOCAL'
3259 include 'COMMON.CHAIN'
3260 include 'COMMON.DERIV'
3261 include 'COMMON.INTERACT'
3262 include 'COMMON.CONTACTS'
3263 include 'COMMON.TORSION'
3264 include 'COMMON.VECTORS'
3265 include 'COMMON.FFIELD'
3266 include 'COMMON.TIME1'
3267 include 'COMMON.SPLITELE'
3268 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3269 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3270 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3271 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3272 & gmuij2(4),gmuji2(4)
3273 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3274 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3276 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3278 double precision scal_el /1.0d0/
3280 double precision scal_el /0.5d0/
3283 C 13-go grudnia roku pamietnego...
3284 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3285 & 0.0d0,1.0d0,0.0d0,
3286 & 0.0d0,0.0d0,1.0d0/
3287 c time00=MPI_Wtime()
3288 cd write (iout,*) "eelecij",i,j
3292 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3293 aaa=app(iteli,itelj)
3294 bbb=bpp(iteli,itelj)
3295 ael6i=ael6(iteli,itelj)
3296 ael3i=ael3(iteli,itelj)
3300 dx_normj=dc_norm(1,j)
3301 dy_normj=dc_norm(2,j)
3302 dz_normj=dc_norm(3,j)
3303 C xj=c(1,j)+0.5D0*dxj-xmedi
3304 C yj=c(2,j)+0.5D0*dyj-ymedi
3305 C zj=c(3,j)+0.5D0*dzj-zmedi
3310 if (xj.lt.0) xj=xj+boxxsize
3312 if (yj.lt.0) yj=yj+boxysize
3314 if (zj.lt.0) zj=zj+boxzsize
3315 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3316 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3324 xj=xj_safe+xshift*boxxsize
3325 yj=yj_safe+yshift*boxysize
3326 zj=zj_safe+zshift*boxzsize
3327 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3328 if(dist_temp.lt.dist_init) then
3338 if (isubchap.eq.1) then
3347 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3349 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3350 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3351 C Condition for being inside the proper box
3352 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3353 c & (xj.lt.((-0.5d0)*boxxsize))) then
3357 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3358 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3359 C Condition for being inside the proper box
3360 c if ((yj.gt.((0.5d0)*boxysize)).or.
3361 c & (yj.lt.((-0.5d0)*boxysize))) then
3365 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3366 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3367 C Condition for being inside the proper box
3368 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3369 c & (zj.lt.((-0.5d0)*boxzsize))) then
3372 C endif !endPBC condintion
3376 rij=xj*xj+yj*yj+zj*zj
3378 sss=sscale(sqrt(rij))
3379 sssgrad=sscagrad(sqrt(rij))
3380 c if (sss.gt.0.0d0) then
3386 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3387 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3388 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3389 fac=cosa-3.0D0*cosb*cosg
3391 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3392 if (j.eq.i+2) ev1=scal_el*ev1
3397 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3401 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3402 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3404 evdw1=evdw1+evdwij*sss
3405 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3406 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3407 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3408 cd & xmedi,ymedi,zmedi,xj,yj,zj
3410 if (energy_dec) then
3411 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3413 &,iteli,itelj,aaa,evdw1
3414 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3418 C Calculate contributions to the Cartesian gradient.
3421 facvdw=-6*rrmij*(ev1+evdwij)*sss
3422 facel=-3*rrmij*(el1+eesij)
3428 * Radial derivatives. First process both termini of the fragment (i,j)
3434 c ghalf=0.5D0*ggg(k)
3435 c gelc(k,i)=gelc(k,i)+ghalf
3436 c gelc(k,j)=gelc(k,j)+ghalf
3438 c 9/28/08 AL Gradient compotents will be summed only at the end
3440 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3441 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3444 * Loop over residues i+1 thru j-1.
3448 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3451 if (sss.gt.0.0) then
3452 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3453 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3454 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3461 c ghalf=0.5D0*ggg(k)
3462 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3463 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3465 c 9/28/08 AL Gradient compotents will be summed only at the end
3467 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3468 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3471 * Loop over residues i+1 thru j-1.
3475 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3480 facvdw=(ev1+evdwij)*sss
3483 fac=-3*rrmij*(facvdw+facvdw+facel)
3488 * Radial derivatives. First process both termini of the fragment (i,j)
3494 c ghalf=0.5D0*ggg(k)
3495 c gelc(k,i)=gelc(k,i)+ghalf
3496 c gelc(k,j)=gelc(k,j)+ghalf
3498 c 9/28/08 AL Gradient compotents will be summed only at the end
3500 gelc_long(k,j)=gelc(k,j)+ggg(k)
3501 gelc_long(k,i)=gelc(k,i)-ggg(k)
3504 * Loop over residues i+1 thru j-1.
3508 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3511 c 9/28/08 AL Gradient compotents will be summed only at the end
3512 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3513 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3514 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3516 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3517 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3523 ecosa=2.0D0*fac3*fac1+fac4
3526 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3527 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3529 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3530 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3532 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3533 cd & (dcosg(k),k=1,3)
3535 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3538 c ghalf=0.5D0*ggg(k)
3539 c gelc(k,i)=gelc(k,i)+ghalf
3540 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3541 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3542 c gelc(k,j)=gelc(k,j)+ghalf
3543 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3544 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3548 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3553 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3554 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3556 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3557 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3558 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3559 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3563 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3564 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3565 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3567 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3568 C energy of a peptide unit is assumed in the form of a second-order
3569 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3570 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3571 C are computed for EVERY pair of non-contiguous peptide groups.
3574 if (j.lt.nres-1) then
3586 muij(kkk)=mu(k,i)*mu(l,j)
3587 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3589 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3590 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3591 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3592 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3593 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3594 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3598 cd write (iout,*) 'EELEC: i',i,' j',j
3599 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3600 cd write(iout,*) 'muij',muij
3601 ury=scalar(uy(1,i),erij)
3602 urz=scalar(uz(1,i),erij)
3603 vry=scalar(uy(1,j),erij)
3604 vrz=scalar(uz(1,j),erij)
3605 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3606 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3607 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3608 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3609 fac=dsqrt(-ael6i)*r3ij
3614 cd write (iout,'(4i5,4f10.5)')
3615 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3616 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3617 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3618 cd & uy(:,j),uz(:,j)
3619 cd write (iout,'(4f10.5)')
3620 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3621 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3622 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3623 cd write (iout,'(9f10.5/)')
3624 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3625 C Derivatives of the elements of A in virtual-bond vectors
3626 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3628 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3629 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3630 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3631 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3632 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3633 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3634 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3635 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3636 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3637 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3638 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3639 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3641 C Compute radial contributions to the gradient
3659 C Add the contributions coming from er
3662 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3663 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3664 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3665 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3668 C Derivatives in DC(i)
3669 cgrad ghalf1=0.5d0*agg(k,1)
3670 cgrad ghalf2=0.5d0*agg(k,2)
3671 cgrad ghalf3=0.5d0*agg(k,3)
3672 cgrad ghalf4=0.5d0*agg(k,4)
3673 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3674 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3675 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3676 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3677 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3678 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3679 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3680 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3681 C Derivatives in DC(i+1)
3682 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3683 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3684 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3685 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3686 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3687 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3688 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3689 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3690 C Derivatives in DC(j)
3691 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3692 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3693 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3694 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3695 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3696 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3697 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3698 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3699 C Derivatives in DC(j+1) or DC(nres-1)
3700 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3701 & -3.0d0*vryg(k,3)*ury)
3702 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3703 & -3.0d0*vrzg(k,3)*ury)
3704 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3705 & -3.0d0*vryg(k,3)*urz)
3706 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3707 & -3.0d0*vrzg(k,3)*urz)
3708 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3710 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3723 aggi(k,l)=-aggi(k,l)
3724 aggi1(k,l)=-aggi1(k,l)
3725 aggj(k,l)=-aggj(k,l)
3726 aggj1(k,l)=-aggj1(k,l)
3729 if (j.lt.nres-1) then
3735 aggi(k,l)=-aggi(k,l)
3736 aggi1(k,l)=-aggi1(k,l)
3737 aggj(k,l)=-aggj(k,l)
3738 aggj1(k,l)=-aggj1(k,l)
3749 aggi(k,l)=-aggi(k,l)
3750 aggi1(k,l)=-aggi1(k,l)
3751 aggj(k,l)=-aggj(k,l)
3752 aggj1(k,l)=-aggj1(k,l)
3757 IF (wel_loc.gt.0.0d0) THEN
3758 C Contribution to the local-electrostatic energy coming from the i-j pair
3759 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3761 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3762 c & ' eel_loc_ij',eel_loc_ij
3763 c write(iout,*) 'muije=',muij(1),muij(2),muij(3),muij(4)
3764 C Calculate patrial derivative for theta angle
3766 geel_loc_ij=a22*gmuij1(1)
3770 c write(iout,*) "derivative over thatai"
3771 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3773 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3774 & geel_loc_ij*wel_loc
3775 c write(iout,*) "derivative over thatai-1"
3776 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3783 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3784 & geel_loc_ij*wel_loc
3785 c Derivative over j residue
3786 geel_loc_ji=a22*gmuji1(1)
3790 c write(iout,*) "derivative over thataj"
3791 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3794 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3795 & geel_loc_ji*wel_loc
3801 c write(iout,*) "derivative over thataj-1"
3802 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3804 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3805 & geel_loc_ji*wel_loc
3807 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3809 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3810 & 'eelloc',i,j,eel_loc_ij
3811 c if (eel_loc_ij.ne.0)
3812 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3813 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3815 eel_loc=eel_loc+eel_loc_ij
3816 C Partial derivatives in virtual-bond dihedral angles gamma
3818 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3819 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3820 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3821 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3822 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3823 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3824 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3826 ggg(l)=agg(l,1)*muij(1)+
3827 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3828 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3829 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3830 cgrad ghalf=0.5d0*ggg(l)
3831 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3832 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3836 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3839 C Remaining derivatives of eello
3841 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3842 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3843 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3844 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3845 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3846 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3847 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3848 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3851 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3852 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3853 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3854 & .and. num_conti.le.maxconts) then
3855 c write (iout,*) i,j," entered corr"
3857 C Calculate the contact function. The ith column of the array JCONT will
3858 C contain the numbers of atoms that make contacts with the atom I (of numbers
3859 C greater than I). The arrays FACONT and GACONT will contain the values of
3860 C the contact function and its derivative.
3861 c r0ij=1.02D0*rpp(iteli,itelj)
3862 c r0ij=1.11D0*rpp(iteli,itelj)
3863 r0ij=2.20D0*rpp(iteli,itelj)
3864 c r0ij=1.55D0*rpp(iteli,itelj)
3865 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3866 if (fcont.gt.0.0D0) then
3867 num_conti=num_conti+1
3868 if (num_conti.gt.maxconts) then
3869 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3870 & ' will skip next contacts for this conf.'
3872 jcont_hb(num_conti,i)=j
3873 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3874 cd & " jcont_hb",jcont_hb(num_conti,i)
3875 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3876 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3877 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3879 d_cont(num_conti,i)=rij
3880 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3881 C --- Electrostatic-interaction matrix ---
3882 a_chuj(1,1,num_conti,i)=a22
3883 a_chuj(1,2,num_conti,i)=a23
3884 a_chuj(2,1,num_conti,i)=a32
3885 a_chuj(2,2,num_conti,i)=a33
3886 C --- Gradient of rij
3888 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3895 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3896 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3897 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3898 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3899 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3904 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3905 C Calculate contact energies
3907 wij=cosa-3.0D0*cosb*cosg
3910 c fac3=dsqrt(-ael6i)/r0ij**3
3911 fac3=dsqrt(-ael6i)*r3ij
3912 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3913 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3914 if (ees0tmp.gt.0) then
3915 ees0pij=dsqrt(ees0tmp)
3919 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3920 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3921 if (ees0tmp.gt.0) then
3922 ees0mij=dsqrt(ees0tmp)
3927 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3928 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3929 C Diagnostics. Comment out or remove after debugging!
3930 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3931 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3932 c ees0m(num_conti,i)=0.0D0
3934 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3935 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3936 C Angular derivatives of the contact function
3937 ees0pij1=fac3/ees0pij
3938 ees0mij1=fac3/ees0mij
3939 fac3p=-3.0D0*fac3*rrmij
3940 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3941 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3943 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3944 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3945 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3946 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3947 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3948 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3949 ecosap=ecosa1+ecosa2
3950 ecosbp=ecosb1+ecosb2
3951 ecosgp=ecosg1+ecosg2
3952 ecosam=ecosa1-ecosa2
3953 ecosbm=ecosb1-ecosb2
3954 ecosgm=ecosg1-ecosg2
3963 facont_hb(num_conti,i)=fcont
3964 fprimcont=fprimcont/rij
3965 cd facont_hb(num_conti,i)=1.0D0
3966 C Following line is for diagnostics.
3969 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3970 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3973 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3974 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3976 gggp(1)=gggp(1)+ees0pijp*xj
3977 gggp(2)=gggp(2)+ees0pijp*yj
3978 gggp(3)=gggp(3)+ees0pijp*zj
3979 gggm(1)=gggm(1)+ees0mijp*xj
3980 gggm(2)=gggm(2)+ees0mijp*yj
3981 gggm(3)=gggm(3)+ees0mijp*zj
3982 C Derivatives due to the contact function
3983 gacont_hbr(1,num_conti,i)=fprimcont*xj
3984 gacont_hbr(2,num_conti,i)=fprimcont*yj
3985 gacont_hbr(3,num_conti,i)=fprimcont*zj
3988 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3989 c following the change of gradient-summation algorithm.
3991 cgrad ghalfp=0.5D0*gggp(k)
3992 cgrad ghalfm=0.5D0*gggm(k)
3993 gacontp_hb1(k,num_conti,i)=!ghalfp
3994 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3995 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3996 gacontp_hb2(k,num_conti,i)=!ghalfp
3997 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3998 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3999 gacontp_hb3(k,num_conti,i)=gggp(k)
4000 gacontm_hb1(k,num_conti,i)=!ghalfm
4001 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4002 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4003 gacontm_hb2(k,num_conti,i)=!ghalfm
4004 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4005 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4006 gacontm_hb3(k,num_conti,i)=gggm(k)
4008 C Diagnostics. Comment out or remove after debugging!
4010 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4011 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4012 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4013 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4014 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4015 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4018 endif ! num_conti.le.maxconts
4021 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4024 ghalf=0.5d0*agg(l,k)
4025 aggi(l,k)=aggi(l,k)+ghalf
4026 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4027 aggj(l,k)=aggj(l,k)+ghalf
4030 if (j.eq.nres-1 .and. i.lt.j-2) then
4033 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4038 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4041 C-----------------------------------------------------------------------------
4042 subroutine eturn3(i,eello_turn3)
4043 C Third- and fourth-order contributions from turns
4044 implicit real*8 (a-h,o-z)
4045 include 'DIMENSIONS'
4046 include 'COMMON.IOUNITS'
4047 include 'COMMON.GEO'
4048 include 'COMMON.VAR'
4049 include 'COMMON.LOCAL'
4050 include 'COMMON.CHAIN'
4051 include 'COMMON.DERIV'
4052 include 'COMMON.INTERACT'
4053 include 'COMMON.CONTACTS'
4054 include 'COMMON.TORSION'
4055 include 'COMMON.VECTORS'
4056 include 'COMMON.FFIELD'
4057 include 'COMMON.CONTROL'
4059 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4060 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4061 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4062 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4063 & auxgmat2(2,2),auxgmatt2(2,2)
4064 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4065 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4066 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4067 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4070 c write (iout,*) "eturn3",i,j,j1,j2
4075 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4077 C Third-order contributions
4084 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4085 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4086 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4087 c auxalary matices for theta gradient
4088 c auxalary matrix for i+1 and constant i+2
4089 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4090 c auxalary matrix for i+2 and constant i+1
4091 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4092 call transpose2(auxmat(1,1),auxmat1(1,1))
4093 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4094 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4095 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4096 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4097 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4098 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4099 C Derivatives in theta
4100 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4101 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4102 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4103 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4105 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4106 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4107 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4108 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4109 cd & ' eello_turn3_num',4*eello_turn3_num
4110 C Derivatives in gamma(i)
4111 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4112 call transpose2(auxmat2(1,1),auxmat3(1,1))
4113 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4114 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4115 C Derivatives in gamma(i+1)
4116 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4117 call transpose2(auxmat2(1,1),auxmat3(1,1))
4118 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4119 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4120 & +0.5d0*(pizda(1,1)+pizda(2,2))
4121 C Cartesian derivatives
4123 c ghalf1=0.5d0*agg(l,1)
4124 c ghalf2=0.5d0*agg(l,2)
4125 c ghalf3=0.5d0*agg(l,3)
4126 c ghalf4=0.5d0*agg(l,4)
4127 a_temp(1,1)=aggi(l,1)!+ghalf1
4128 a_temp(1,2)=aggi(l,2)!+ghalf2
4129 a_temp(2,1)=aggi(l,3)!+ghalf3
4130 a_temp(2,2)=aggi(l,4)!+ghalf4
4131 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4132 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4133 & +0.5d0*(pizda(1,1)+pizda(2,2))
4134 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4135 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4136 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4137 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4138 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4139 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4140 & +0.5d0*(pizda(1,1)+pizda(2,2))
4141 a_temp(1,1)=aggj(l,1)!+ghalf1
4142 a_temp(1,2)=aggj(l,2)!+ghalf2
4143 a_temp(2,1)=aggj(l,3)!+ghalf3
4144 a_temp(2,2)=aggj(l,4)!+ghalf4
4145 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4146 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4147 & +0.5d0*(pizda(1,1)+pizda(2,2))
4148 a_temp(1,1)=aggj1(l,1)
4149 a_temp(1,2)=aggj1(l,2)
4150 a_temp(2,1)=aggj1(l,3)
4151 a_temp(2,2)=aggj1(l,4)
4152 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4153 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4154 & +0.5d0*(pizda(1,1)+pizda(2,2))
4158 C-------------------------------------------------------------------------------
4159 subroutine eturn4(i,eello_turn4)
4160 C Third- and fourth-order contributions from turns
4161 implicit real*8 (a-h,o-z)
4162 include 'DIMENSIONS'
4163 include 'COMMON.IOUNITS'
4164 include 'COMMON.GEO'
4165 include 'COMMON.VAR'
4166 include 'COMMON.LOCAL'
4167 include 'COMMON.CHAIN'
4168 include 'COMMON.DERIV'
4169 include 'COMMON.INTERACT'
4170 include 'COMMON.CONTACTS'
4171 include 'COMMON.TORSION'
4172 include 'COMMON.VECTORS'
4173 include 'COMMON.FFIELD'
4174 include 'COMMON.CONTROL'
4176 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4177 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4178 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4179 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4180 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4181 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4182 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4183 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4184 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4185 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4186 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4189 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4191 C Fourth-order contributions
4199 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4200 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4201 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4202 c write(iout,*)"WCHODZE W PROGRAM"
4207 iti1=itortyp(itype(i+1))
4208 iti2=itortyp(itype(i+2))
4209 iti3=itortyp(itype(i+3))
4210 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4211 call transpose2(EUg(1,1,i+1),e1t(1,1))
4212 call transpose2(Eug(1,1,i+2),e2t(1,1))
4213 call transpose2(Eug(1,1,i+3),e3t(1,1))
4214 C Ematrix derivative in theta
4215 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4216 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4217 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4218 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4219 c eta1 in derivative theta
4220 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4221 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4222 c auxgvec is derivative of Ub2 so i+3 theta
4223 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4224 c auxalary matrix of E i+1
4225 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4228 s1=scalar2(b1(1,i+2),auxvec(1))
4229 c derivative of theta i+2 with constant i+3
4230 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4231 c derivative of theta i+2 with constant i+2
4232 gs32=scalar2(b1(1,i+2),auxgvec(1))
4233 c derivative of E matix in theta of i+1
4234 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4236 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4237 c ea31 in derivative theta
4238 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4239 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4240 c auxilary matrix auxgvec of Ub2 with constant E matirx
4241 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4242 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4243 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4247 s2=scalar2(b1(1,i+1),auxvec(1))
4248 c derivative of theta i+1 with constant i+3
4249 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4250 c derivative of theta i+2 with constant i+1
4251 gs21=scalar2(b1(1,i+1),auxgvec(1))
4252 c derivative of theta i+3 with constant i+1
4253 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4254 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4256 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4257 c two derivatives over diffetent matrices
4258 c gtae3e2 is derivative over i+3
4259 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4260 c ae3gte2 is derivative over i+2
4261 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4262 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4263 c three possible derivative over theta E matices
4265 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4267 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4269 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4270 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4272 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4273 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4274 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4276 eello_turn4=eello_turn4-(s1+s2+s3)
4277 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4278 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4279 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4280 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4281 cd & ' eello_turn4_num',8*eello_turn4_num
4283 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4284 & -(gs13+gsE13+gsEE1)*wturn4
4285 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4286 & -(gs23+gs21+gsEE2)*wturn4
4287 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4288 & -(gs32+gsE31+gsEE3)*wturn4
4289 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4292 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4293 & 'eturn4',i,j,-(s1+s2+s3)
4294 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4295 c & ' eello_turn4_num',8*eello_turn4_num
4296 C Derivatives in gamma(i)
4297 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4298 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4299 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4300 s1=scalar2(b1(1,i+2),auxvec(1))
4301 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4302 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4303 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4304 C Derivatives in gamma(i+1)
4305 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4306 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4307 s2=scalar2(b1(1,i+1),auxvec(1))
4308 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4309 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4310 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4311 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4312 C Derivatives in gamma(i+2)
4313 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4314 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4315 s1=scalar2(b1(1,i+2),auxvec(1))
4316 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4317 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4318 s2=scalar2(b1(1,i+1),auxvec(1))
4319 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4320 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4321 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4322 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4323 C Cartesian derivatives
4324 C Derivatives of this turn contributions in DC(i+2)
4325 if (j.lt.nres-1) then
4327 a_temp(1,1)=agg(l,1)
4328 a_temp(1,2)=agg(l,2)
4329 a_temp(2,1)=agg(l,3)
4330 a_temp(2,2)=agg(l,4)
4331 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4332 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4333 s1=scalar2(b1(1,i+2),auxvec(1))
4334 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4335 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4336 s2=scalar2(b1(1,i+1),auxvec(1))
4337 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4338 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4339 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4341 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4344 C Remaining derivatives of this turn contribution
4346 a_temp(1,1)=aggi(l,1)
4347 a_temp(1,2)=aggi(l,2)
4348 a_temp(2,1)=aggi(l,3)
4349 a_temp(2,2)=aggi(l,4)
4350 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4351 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4352 s1=scalar2(b1(1,i+2),auxvec(1))
4353 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4354 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4355 s2=scalar2(b1(1,i+1),auxvec(1))
4356 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4357 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4358 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4359 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4360 a_temp(1,1)=aggi1(l,1)
4361 a_temp(1,2)=aggi1(l,2)
4362 a_temp(2,1)=aggi1(l,3)
4363 a_temp(2,2)=aggi1(l,4)
4364 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4365 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4366 s1=scalar2(b1(1,i+2),auxvec(1))
4367 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4368 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4369 s2=scalar2(b1(1,i+1),auxvec(1))
4370 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4371 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4372 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4373 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4374 a_temp(1,1)=aggj(l,1)
4375 a_temp(1,2)=aggj(l,2)
4376 a_temp(2,1)=aggj(l,3)
4377 a_temp(2,2)=aggj(l,4)
4378 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4379 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4380 s1=scalar2(b1(1,i+2),auxvec(1))
4381 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4382 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4383 s2=scalar2(b1(1,i+1),auxvec(1))
4384 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4385 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4386 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4387 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4388 a_temp(1,1)=aggj1(l,1)
4389 a_temp(1,2)=aggj1(l,2)
4390 a_temp(2,1)=aggj1(l,3)
4391 a_temp(2,2)=aggj1(l,4)
4392 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4393 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4394 s1=scalar2(b1(1,i+2),auxvec(1))
4395 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4396 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4397 s2=scalar2(b1(1,i+1),auxvec(1))
4398 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4399 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4400 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4401 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4402 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4406 C-----------------------------------------------------------------------------
4407 subroutine vecpr(u,v,w)
4408 implicit real*8(a-h,o-z)
4409 dimension u(3),v(3),w(3)
4410 w(1)=u(2)*v(3)-u(3)*v(2)
4411 w(2)=-u(1)*v(3)+u(3)*v(1)
4412 w(3)=u(1)*v(2)-u(2)*v(1)
4415 C-----------------------------------------------------------------------------
4416 subroutine unormderiv(u,ugrad,unorm,ungrad)
4417 C This subroutine computes the derivatives of a normalized vector u, given
4418 C the derivatives computed without normalization conditions, ugrad. Returns
4421 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4422 double precision vec(3)
4423 double precision scalar
4425 c write (2,*) 'ugrad',ugrad
4428 vec(i)=scalar(ugrad(1,i),u(1))
4430 c write (2,*) 'vec',vec
4433 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4436 c write (2,*) 'ungrad',ungrad
4439 C-----------------------------------------------------------------------------
4440 subroutine escp_soft_sphere(evdw2,evdw2_14)
4442 C This subroutine calculates the excluded-volume interaction energy between
4443 C peptide-group centers and side chains and its gradient in virtual-bond and
4444 C side-chain vectors.
4446 implicit real*8 (a-h,o-z)
4447 include 'DIMENSIONS'
4448 include 'COMMON.GEO'
4449 include 'COMMON.VAR'
4450 include 'COMMON.LOCAL'
4451 include 'COMMON.CHAIN'
4452 include 'COMMON.DERIV'
4453 include 'COMMON.INTERACT'
4454 include 'COMMON.FFIELD'
4455 include 'COMMON.IOUNITS'
4456 include 'COMMON.CONTROL'
4461 cd print '(a)','Enter ESCP'
4462 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4466 do i=iatscp_s,iatscp_e
4467 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4469 xi=0.5D0*(c(1,i)+c(1,i+1))
4470 yi=0.5D0*(c(2,i)+c(2,i+1))
4471 zi=0.5D0*(c(3,i)+c(3,i+1))
4472 C Return atom into box, boxxsize is size of box in x dimension
4474 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4475 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4476 C Condition for being inside the proper box
4477 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4478 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4482 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4483 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4484 C Condition for being inside the proper box
4485 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4486 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4490 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4491 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4492 cC Condition for being inside the proper box
4493 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4494 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4498 if (xi.lt.0) xi=xi+boxxsize
4500 if (yi.lt.0) yi=yi+boxysize
4502 if (zi.lt.0) zi=zi+boxzsize
4503 C xi=xi+xshift*boxxsize
4504 C yi=yi+yshift*boxysize
4505 C zi=zi+zshift*boxzsize
4506 do iint=1,nscp_gr(i)
4508 do j=iscpstart(i,iint),iscpend(i,iint)
4509 if (itype(j).eq.ntyp1) cycle
4510 itypj=iabs(itype(j))
4511 C Uncomment following three lines for SC-p interactions
4515 C Uncomment following three lines for Ca-p interactions
4520 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4521 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4522 C Condition for being inside the proper box
4523 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4524 c & (xj.lt.((-0.5d0)*boxxsize))) then
4528 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4529 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4530 cC Condition for being inside the proper box
4531 c if ((yj.gt.((0.5d0)*boxysize)).or.
4532 c & (yj.lt.((-0.5d0)*boxysize))) then
4536 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4537 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4538 C Condition for being inside the proper box
4539 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4540 c & (zj.lt.((-0.5d0)*boxzsize))) then
4543 if (xj.lt.0) xj=xj+boxxsize
4545 if (yj.lt.0) yj=yj+boxysize
4547 if (zj.lt.0) zj=zj+boxzsize
4548 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4556 xj=xj_safe+xshift*boxxsize
4557 yj=yj_safe+yshift*boxysize
4558 zj=zj_safe+zshift*boxzsize
4559 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4560 if(dist_temp.lt.dist_init) then
4570 if (subchap.eq.1) then
4583 rij=xj*xj+yj*yj+zj*zj
4587 if (rij.lt.r0ijsq) then
4588 evdwij=0.25d0*(rij-r0ijsq)**2
4596 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4601 cgrad if (j.lt.i) then
4602 cd write (iout,*) 'j<i'
4603 C Uncomment following three lines for SC-p interactions
4605 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4608 cd write (iout,*) 'j>i'
4610 cgrad ggg(k)=-ggg(k)
4611 C Uncomment following line for SC-p interactions
4612 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4616 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4618 cgrad kstart=min0(i+1,j)
4619 cgrad kend=max0(i-1,j-1)
4620 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4621 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4622 cgrad do k=kstart,kend
4624 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4628 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4629 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4640 C-----------------------------------------------------------------------------
4641 subroutine escp(evdw2,evdw2_14)
4643 C This subroutine calculates the excluded-volume interaction energy between
4644 C peptide-group centers and side chains and its gradient in virtual-bond and
4645 C side-chain vectors.
4647 implicit real*8 (a-h,o-z)
4648 include 'DIMENSIONS'
4649 include 'COMMON.GEO'
4650 include 'COMMON.VAR'
4651 include 'COMMON.LOCAL'
4652 include 'COMMON.CHAIN'
4653 include 'COMMON.DERIV'
4654 include 'COMMON.INTERACT'
4655 include 'COMMON.FFIELD'
4656 include 'COMMON.IOUNITS'
4657 include 'COMMON.CONTROL'
4658 include 'COMMON.SPLITELE'
4662 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4663 cd print '(a)','Enter ESCP'
4664 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4668 do i=iatscp_s,iatscp_e
4669 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4671 xi=0.5D0*(c(1,i)+c(1,i+1))
4672 yi=0.5D0*(c(2,i)+c(2,i+1))
4673 zi=0.5D0*(c(3,i)+c(3,i+1))
4675 if (xi.lt.0) xi=xi+boxxsize
4677 if (yi.lt.0) yi=yi+boxysize
4679 if (zi.lt.0) zi=zi+boxzsize
4680 c xi=xi+xshift*boxxsize
4681 c yi=yi+yshift*boxysize
4682 c zi=zi+zshift*boxzsize
4683 c print *,xi,yi,zi,'polozenie i'
4684 C Return atom into box, boxxsize is size of box in x dimension
4686 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4687 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4688 C Condition for being inside the proper box
4689 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4690 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4694 c print *,xi,boxxsize,"pierwszy"
4696 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4697 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4698 C Condition for being inside the proper box
4699 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4700 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4704 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4705 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4706 C Condition for being inside the proper box
4707 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4708 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4711 do iint=1,nscp_gr(i)
4713 do j=iscpstart(i,iint),iscpend(i,iint)
4714 itypj=iabs(itype(j))
4715 if (itypj.eq.ntyp1) cycle
4716 C Uncomment following three lines for SC-p interactions
4720 C Uncomment following three lines for Ca-p interactions
4725 if (xj.lt.0) xj=xj+boxxsize
4727 if (yj.lt.0) yj=yj+boxysize
4729 if (zj.lt.0) zj=zj+boxzsize
4731 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4732 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4733 C Condition for being inside the proper box
4734 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4735 c & (xj.lt.((-0.5d0)*boxxsize))) then
4739 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4740 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4741 cC Condition for being inside the proper box
4742 c if ((yj.gt.((0.5d0)*boxysize)).or.
4743 c & (yj.lt.((-0.5d0)*boxysize))) then
4747 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4748 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4749 C Condition for being inside the proper box
4750 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4751 c & (zj.lt.((-0.5d0)*boxzsize))) then
4754 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
4755 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4763 xj=xj_safe+xshift*boxxsize
4764 yj=yj_safe+yshift*boxysize
4765 zj=zj_safe+zshift*boxzsize
4766 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4767 if(dist_temp.lt.dist_init) then
4777 if (subchap.eq.1) then
4786 c print *,xj,yj,zj,'polozenie j'
4787 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4789 sss=sscale(1.0d0/(dsqrt(rrij)))
4790 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
4791 c if (sss.eq.0) print *,'czasem jest OK'
4792 if (sss.le.0.0d0) cycle
4793 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4795 e1=fac*fac*aad(itypj,iteli)
4796 e2=fac*bad(itypj,iteli)
4797 if (iabs(j-i) .le. 2) then
4800 evdw2_14=evdw2_14+(e1+e2)*sss
4803 evdw2=evdw2+evdwij*sss
4804 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4805 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4808 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4810 fac=-(evdwij+e1)*rrij*sss
4811 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4815 cgrad if (j.lt.i) then
4816 cd write (iout,*) 'j<i'
4817 C Uncomment following three lines for SC-p interactions
4819 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4822 cd write (iout,*) 'j>i'
4824 cgrad ggg(k)=-ggg(k)
4825 C Uncomment following line for SC-p interactions
4826 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4827 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4831 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4833 cgrad kstart=min0(i+1,j)
4834 cgrad kend=max0(i-1,j-1)
4835 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4836 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4837 cgrad do k=kstart,kend
4839 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4843 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4844 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4846 c endif !endif for sscale cutoff
4856 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4857 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4858 gradx_scp(j,i)=expon*gradx_scp(j,i)
4861 C******************************************************************************
4865 C To save time the factor EXPON has been extracted from ALL components
4866 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4869 C******************************************************************************
4872 C--------------------------------------------------------------------------
4873 subroutine edis(ehpb)
4875 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4877 implicit real*8 (a-h,o-z)
4878 include 'DIMENSIONS'
4879 include 'COMMON.SBRIDGE'
4880 include 'COMMON.CHAIN'
4881 include 'COMMON.DERIV'
4882 include 'COMMON.VAR'
4883 include 'COMMON.INTERACT'
4884 include 'COMMON.IOUNITS'
4887 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4888 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4889 if (link_end.eq.0) return
4890 do i=link_start,link_end
4891 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4892 C CA-CA distance used in regularization of structure.
4895 C iii and jjj point to the residues for which the distance is assigned.
4896 if (ii.gt.nres) then
4903 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4904 c & dhpb(i),dhpb1(i),forcon(i)
4905 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4906 C distance and angle dependent SS bond potential.
4907 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4908 & iabs(itype(jjj)).eq.1) then
4909 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4910 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4911 if (.not.dyn_ss .and. i.le.nss) then
4912 C 15/02/13 CC dynamic SSbond - additional check
4914 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4915 call ssbond_ene(iii,jjj,eij)
4918 cd write (iout,*) "eij",eij
4920 C Calculate the distance between the two points and its difference from the
4924 C Get the force constant corresponding to this distance.
4926 C Calculate the contribution to energy.
4927 ehpb=ehpb+waga*rdis*rdis
4929 C Evaluate gradient.
4932 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4933 cd & ' waga=',waga,' fac=',fac
4935 ggg(j)=fac*(c(j,jj)-c(j,ii))
4937 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4938 C If this is a SC-SC distance, we need to calculate the contributions to the
4939 C Cartesian gradient in the SC vectors (ghpbx).
4942 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4943 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4946 cgrad do j=iii,jjj-1
4948 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4952 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4953 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4961 C--------------------------------------------------------------------------
4962 subroutine ssbond_ene(i,j,eij)
4964 C Calculate the distance and angle dependent SS-bond potential energy
4965 C using a free-energy function derived based on RHF/6-31G** ab initio
4966 C calculations of diethyl disulfide.
4968 C A. Liwo and U. Kozlowska, 11/24/03
4970 implicit real*8 (a-h,o-z)
4971 include 'DIMENSIONS'
4972 include 'COMMON.SBRIDGE'
4973 include 'COMMON.CHAIN'
4974 include 'COMMON.DERIV'
4975 include 'COMMON.LOCAL'
4976 include 'COMMON.INTERACT'
4977 include 'COMMON.VAR'
4978 include 'COMMON.IOUNITS'
4979 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4980 itypi=iabs(itype(i))
4984 dxi=dc_norm(1,nres+i)
4985 dyi=dc_norm(2,nres+i)
4986 dzi=dc_norm(3,nres+i)
4987 c dsci_inv=dsc_inv(itypi)
4988 dsci_inv=vbld_inv(nres+i)
4989 itypj=iabs(itype(j))
4990 c dscj_inv=dsc_inv(itypj)
4991 dscj_inv=vbld_inv(nres+j)
4995 dxj=dc_norm(1,nres+j)
4996 dyj=dc_norm(2,nres+j)
4997 dzj=dc_norm(3,nres+j)
4998 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5003 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5004 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5005 om12=dxi*dxj+dyi*dyj+dzi*dzj
5007 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5008 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5014 deltat12=om2-om1+2.0d0
5016 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5017 & +akct*deltad*deltat12
5018 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5019 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5020 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5021 c & " deltat12",deltat12," eij",eij
5022 ed=2*akcm*deltad+akct*deltat12
5024 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5025 eom1=-2*akth*deltat1-pom1-om2*pom2
5026 eom2= 2*akth*deltat2+pom1-om1*pom2
5029 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5030 ghpbx(k,i)=ghpbx(k,i)-ggk
5031 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5032 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5033 ghpbx(k,j)=ghpbx(k,j)+ggk
5034 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5035 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5036 ghpbc(k,i)=ghpbc(k,i)-ggk
5037 ghpbc(k,j)=ghpbc(k,j)+ggk
5040 C Calculate the components of the gradient in DC and X
5044 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5049 C--------------------------------------------------------------------------
5050 subroutine ebond(estr)
5052 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5054 implicit real*8 (a-h,o-z)
5055 include 'DIMENSIONS'
5056 include 'COMMON.LOCAL'
5057 include 'COMMON.GEO'
5058 include 'COMMON.INTERACT'
5059 include 'COMMON.DERIV'
5060 include 'COMMON.VAR'
5061 include 'COMMON.CHAIN'
5062 include 'COMMON.IOUNITS'
5063 include 'COMMON.NAMES'
5064 include 'COMMON.FFIELD'
5065 include 'COMMON.CONTROL'
5066 include 'COMMON.SETUP'
5067 double precision u(3),ud(3)
5070 do i=ibondp_start,ibondp_end
5071 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5072 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5074 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5075 c & *dc(j,i-1)/vbld(i)
5077 c if (energy_dec) write(iout,*)
5078 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5080 C Checking if it involves dummy (NH3+ or COO-) group
5081 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5082 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5083 diff = vbld(i)-vbldpDUM
5085 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5086 diff = vbld(i)-vbldp0
5088 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5089 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5092 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5094 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5097 estr=0.5d0*AKP*estr+estr1
5099 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5101 do i=ibond_start,ibond_end
5103 if (iti.ne.10 .and. iti.ne.ntyp1) then
5106 diff=vbld(i+nres)-vbldsc0(1,iti)
5107 if (energy_dec) write (iout,*)
5108 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5109 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5110 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5112 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5116 diff=vbld(i+nres)-vbldsc0(j,iti)
5117 ud(j)=aksc(j,iti)*diff
5118 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5132 uprod2=uprod2*u(k)*u(k)
5136 usumsqder=usumsqder+ud(j)*uprod2
5138 estr=estr+uprod/usum
5140 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5148 C--------------------------------------------------------------------------
5149 subroutine ebend(etheta)
5151 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5152 C angles gamma and its derivatives in consecutive thetas and gammas.
5154 implicit real*8 (a-h,o-z)
5155 include 'DIMENSIONS'
5156 include 'COMMON.LOCAL'
5157 include 'COMMON.GEO'
5158 include 'COMMON.INTERACT'
5159 include 'COMMON.DERIV'
5160 include 'COMMON.VAR'
5161 include 'COMMON.CHAIN'
5162 include 'COMMON.IOUNITS'
5163 include 'COMMON.NAMES'
5164 include 'COMMON.FFIELD'
5165 include 'COMMON.CONTROL'
5166 common /calcthet/ term1,term2,termm,diffak,ratak,
5167 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5168 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5169 double precision y(2),z(2)
5171 c time11=dexp(-2*time)
5174 c write (*,'(a,i2)') 'EBEND ICG=',icg
5175 do i=ithet_start,ithet_end
5176 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5177 & .or.itype(i).eq.ntyp1) cycle
5178 C Zero the energy function and its derivative at 0 or pi.
5179 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5181 ichir1=isign(1,itype(i-2))
5182 ichir2=isign(1,itype(i))
5183 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5184 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5185 if (itype(i-1).eq.10) then
5186 itype1=isign(10,itype(i-2))
5187 ichir11=isign(1,itype(i-2))
5188 ichir12=isign(1,itype(i-2))
5189 itype2=isign(10,itype(i))
5190 ichir21=isign(1,itype(i))
5191 ichir22=isign(1,itype(i))
5194 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5197 if (phii.ne.phii) phii=150.0
5207 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5210 if (phii1.ne.phii1) phii1=150.0
5222 C Calculate the "mean" value of theta from the part of the distribution
5223 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5224 C In following comments this theta will be referred to as t_c.
5225 thet_pred_mean=0.0d0
5227 athetk=athet(k,it,ichir1,ichir2)
5228 bthetk=bthet(k,it,ichir1,ichir2)
5230 athetk=athet(k,itype1,ichir11,ichir12)
5231 bthetk=bthet(k,itype2,ichir21,ichir22)
5233 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5234 c write(iout,*) 'chuj tu', y(k),z(k)
5236 dthett=thet_pred_mean*ssd
5237 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5238 C Derivatives of the "mean" values in gamma1 and gamma2.
5239 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5240 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5241 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5242 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5244 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5245 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5246 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5247 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5249 if (theta(i).gt.pi-delta) then
5250 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5252 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5253 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5254 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5256 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5258 else if (theta(i).lt.delta) then
5259 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5260 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5261 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5263 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5264 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5267 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5270 etheta=etheta+ethetai
5271 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5272 & 'ebend',i,ethetai,theta(i),itype(i)
5273 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5274 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5275 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5277 C Ufff.... We've done all this!!!
5280 C---------------------------------------------------------------------------
5281 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5283 implicit real*8 (a-h,o-z)
5284 include 'DIMENSIONS'
5285 include 'COMMON.LOCAL'
5286 include 'COMMON.IOUNITS'
5287 common /calcthet/ term1,term2,termm,diffak,ratak,
5288 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5289 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5290 C Calculate the contributions to both Gaussian lobes.
5291 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5292 C The "polynomial part" of the "standard deviation" of this part of
5293 C the distributioni.
5294 ccc write (iout,*) thetai,thet_pred_mean
5297 sig=sig*thet_pred_mean+polthet(j,it)
5299 C Derivative of the "interior part" of the "standard deviation of the"
5300 C gamma-dependent Gaussian lobe in t_c.
5301 sigtc=3*polthet(3,it)
5303 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5306 C Set the parameters of both Gaussian lobes of the distribution.
5307 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5308 fac=sig*sig+sigc0(it)
5311 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5312 sigsqtc=-4.0D0*sigcsq*sigtc
5313 c print *,i,sig,sigtc,sigsqtc
5314 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5315 sigtc=-sigtc/(fac*fac)
5316 C Following variable is sigma(t_c)**(-2)
5317 sigcsq=sigcsq*sigcsq
5319 sig0inv=1.0D0/sig0i**2
5320 delthec=thetai-thet_pred_mean
5321 delthe0=thetai-theta0i
5322 term1=-0.5D0*sigcsq*delthec*delthec
5323 term2=-0.5D0*sig0inv*delthe0*delthe0
5324 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5325 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5326 C NaNs in taking the logarithm. We extract the largest exponent which is added
5327 C to the energy (this being the log of the distribution) at the end of energy
5328 C term evaluation for this virtual-bond angle.
5329 if (term1.gt.term2) then
5331 term2=dexp(term2-termm)
5335 term1=dexp(term1-termm)
5338 C The ratio between the gamma-independent and gamma-dependent lobes of
5339 C the distribution is a Gaussian function of thet_pred_mean too.
5340 diffak=gthet(2,it)-thet_pred_mean
5341 ratak=diffak/gthet(3,it)**2
5342 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5343 C Let's differentiate it in thet_pred_mean NOW.
5345 C Now put together the distribution terms to make complete distribution.
5346 termexp=term1+ak*term2
5347 termpre=sigc+ak*sig0i
5348 C Contribution of the bending energy from this theta is just the -log of
5349 C the sum of the contributions from the two lobes and the pre-exponential
5350 C factor. Simple enough, isn't it?
5351 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5352 C write (iout,*) 'termexp',termexp,termm,termpre,i
5353 C NOW the derivatives!!!
5354 C 6/6/97 Take into account the deformation.
5355 E_theta=(delthec*sigcsq*term1
5356 & +ak*delthe0*sig0inv*term2)/termexp
5357 E_tc=((sigtc+aktc*sig0i)/termpre
5358 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5359 & aktc*term2)/termexp)
5362 c-----------------------------------------------------------------------------
5363 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5364 implicit real*8 (a-h,o-z)
5365 include 'DIMENSIONS'
5366 include 'COMMON.LOCAL'
5367 include 'COMMON.IOUNITS'
5368 common /calcthet/ term1,term2,termm,diffak,ratak,
5369 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5370 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5371 delthec=thetai-thet_pred_mean
5372 delthe0=thetai-theta0i
5373 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5374 t3 = thetai-thet_pred_mean
5378 t14 = t12+t6*sigsqtc
5380 t21 = thetai-theta0i
5386 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5387 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5388 & *(-t12*t9-ak*sig0inv*t27)
5392 C--------------------------------------------------------------------------
5393 subroutine ebend(etheta)
5395 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5396 C angles gamma and its derivatives in consecutive thetas and gammas.
5397 C ab initio-derived potentials from
5398 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5400 implicit real*8 (a-h,o-z)
5401 include 'DIMENSIONS'
5402 include 'COMMON.LOCAL'
5403 include 'COMMON.GEO'
5404 include 'COMMON.INTERACT'
5405 include 'COMMON.DERIV'
5406 include 'COMMON.VAR'
5407 include 'COMMON.CHAIN'
5408 include 'COMMON.IOUNITS'
5409 include 'COMMON.NAMES'
5410 include 'COMMON.FFIELD'
5411 include 'COMMON.CONTROL'
5412 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5413 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5414 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5415 & sinph1ph2(maxdouble,maxdouble)
5416 logical lprn /.false./, lprn1 /.false./
5418 do i=ithet_start,ithet_end
5419 c print *,i,itype(i-1),itype(i),itype(i-2)
5420 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5421 & .or.itype(i).eq.ntyp1) cycle
5422 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5424 if (iabs(itype(i+1)).eq.20) iblock=2
5425 if (iabs(itype(i+1)).ne.20) iblock=1
5429 theti2=0.5d0*theta(i)
5430 ityp2=ithetyp((itype(i-1)))
5432 coskt(k)=dcos(k*theti2)
5433 sinkt(k)=dsin(k*theti2)
5435 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5438 if (phii.ne.phii) phii=150.0
5442 ityp1=ithetyp((itype(i-2)))
5443 C propagation of chirality for glycine type
5445 cosph1(k)=dcos(k*phii)
5446 sinph1(k)=dsin(k*phii)
5456 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5459 if (phii1.ne.phii1) phii1=150.0
5464 ityp3=ithetyp((itype(i)))
5466 cosph2(k)=dcos(k*phii1)
5467 sinph2(k)=dsin(k*phii1)
5477 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5480 ccl=cosph1(l)*cosph2(k-l)
5481 ssl=sinph1(l)*sinph2(k-l)
5482 scl=sinph1(l)*cosph2(k-l)
5483 csl=cosph1(l)*sinph2(k-l)
5484 cosph1ph2(l,k)=ccl-ssl
5485 cosph1ph2(k,l)=ccl+ssl
5486 sinph1ph2(l,k)=scl+csl
5487 sinph1ph2(k,l)=scl-csl
5491 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5492 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5493 write (iout,*) "coskt and sinkt"
5495 write (iout,*) k,coskt(k),sinkt(k)
5499 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5500 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5503 & write (iout,*) "k",k,"
5504 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5505 & " ethetai",ethetai
5508 write (iout,*) "cosph and sinph"
5510 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5512 write (iout,*) "cosph1ph2 and sinph2ph2"
5515 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5516 & sinph1ph2(l,k),sinph1ph2(k,l)
5519 write(iout,*) "ethetai",ethetai
5523 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5524 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5525 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5526 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5527 ethetai=ethetai+sinkt(m)*aux
5528 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5529 dephii=dephii+k*sinkt(m)*(
5530 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5531 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5532 dephii1=dephii1+k*sinkt(m)*(
5533 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5534 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5536 & write (iout,*) "m",m," k",k," bbthet",
5537 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5538 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5539 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5540 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5544 & write(iout,*) "ethetai",ethetai
5548 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5549 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5550 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5551 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5552 ethetai=ethetai+sinkt(m)*aux
5553 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5554 dephii=dephii+l*sinkt(m)*(
5555 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5556 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5557 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5558 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5559 dephii1=dephii1+(k-l)*sinkt(m)*(
5560 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5561 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5562 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5563 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5565 write (iout,*) "m",m," k",k," l",l," ffthet",
5566 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5567 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5568 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5569 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5570 & " ethetai",ethetai
5571 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5572 & cosph1ph2(k,l)*sinkt(m),
5573 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5581 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5582 & i,theta(i)*rad2deg,phii*rad2deg,
5583 & phii1*rad2deg,ethetai
5585 etheta=etheta+ethetai
5586 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5587 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5588 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
5594 c-----------------------------------------------------------------------------
5595 subroutine esc(escloc)
5596 C Calculate the local energy of a side chain and its derivatives in the
5597 C corresponding virtual-bond valence angles THETA and the spherical angles
5599 implicit real*8 (a-h,o-z)
5600 include 'DIMENSIONS'
5601 include 'COMMON.GEO'
5602 include 'COMMON.LOCAL'
5603 include 'COMMON.VAR'
5604 include 'COMMON.INTERACT'
5605 include 'COMMON.DERIV'
5606 include 'COMMON.CHAIN'
5607 include 'COMMON.IOUNITS'
5608 include 'COMMON.NAMES'
5609 include 'COMMON.FFIELD'
5610 include 'COMMON.CONTROL'
5611 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5612 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5613 common /sccalc/ time11,time12,time112,theti,it,nlobit
5616 c write (iout,'(a)') 'ESC'
5617 do i=loc_start,loc_end
5619 if (it.eq.ntyp1) cycle
5620 if (it.eq.10) goto 1
5621 nlobit=nlob(iabs(it))
5622 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5623 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5624 theti=theta(i+1)-pipol
5629 if (x(2).gt.pi-delta) then
5633 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5635 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5636 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5638 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5639 & ddersc0(1),dersc(1))
5640 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5641 & ddersc0(3),dersc(3))
5643 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5645 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5646 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5647 & dersc0(2),esclocbi,dersc02)
5648 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5650 call splinthet(x(2),0.5d0*delta,ss,ssd)
5655 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5657 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5658 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5660 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5662 c write (iout,*) escloci
5663 else if (x(2).lt.delta) then
5667 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5669 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5670 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5672 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5673 & ddersc0(1),dersc(1))
5674 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5675 & ddersc0(3),dersc(3))
5677 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5679 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5680 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5681 & dersc0(2),esclocbi,dersc02)
5682 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5687 call splinthet(x(2),0.5d0*delta,ss,ssd)
5689 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5691 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5692 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5694 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5695 c write (iout,*) escloci
5697 call enesc(x,escloci,dersc,ddummy,.false.)
5700 escloc=escloc+escloci
5701 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5702 & 'escloc',i,escloci
5703 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5705 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5707 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5708 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5713 C---------------------------------------------------------------------------
5714 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5715 implicit real*8 (a-h,o-z)
5716 include 'DIMENSIONS'
5717 include 'COMMON.GEO'
5718 include 'COMMON.LOCAL'
5719 include 'COMMON.IOUNITS'
5720 common /sccalc/ time11,time12,time112,theti,it,nlobit
5721 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5722 double precision contr(maxlob,-1:1)
5724 c write (iout,*) 'it=',it,' nlobit=',nlobit
5728 if (mixed) ddersc(j)=0.0d0
5732 C Because of periodicity of the dependence of the SC energy in omega we have
5733 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5734 C To avoid underflows, first compute & store the exponents.
5742 z(k)=x(k)-censc(k,j,it)
5747 Axk=Axk+gaussc(l,k,j,it)*z(l)
5753 expfac=expfac+Ax(k,j,iii)*z(k)
5761 C As in the case of ebend, we want to avoid underflows in exponentiation and
5762 C subsequent NaNs and INFs in energy calculation.
5763 C Find the largest exponent
5767 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5771 cd print *,'it=',it,' emin=',emin
5773 C Compute the contribution to SC energy and derivatives
5778 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5779 if(adexp.ne.adexp) adexp=1.0
5782 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5784 cd print *,'j=',j,' expfac=',expfac
5785 escloc_i=escloc_i+expfac
5787 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5791 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5792 & +gaussc(k,2,j,it))*expfac
5799 dersc(1)=dersc(1)/cos(theti)**2
5800 ddersc(1)=ddersc(1)/cos(theti)**2
5803 escloci=-(dlog(escloc_i)-emin)
5805 dersc(j)=dersc(j)/escloc_i
5809 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5814 C------------------------------------------------------------------------------
5815 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5816 implicit real*8 (a-h,o-z)
5817 include 'DIMENSIONS'
5818 include 'COMMON.GEO'
5819 include 'COMMON.LOCAL'
5820 include 'COMMON.IOUNITS'
5821 common /sccalc/ time11,time12,time112,theti,it,nlobit
5822 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5823 double precision contr(maxlob)
5834 z(k)=x(k)-censc(k,j,it)
5840 Axk=Axk+gaussc(l,k,j,it)*z(l)
5846 expfac=expfac+Ax(k,j)*z(k)
5851 C As in the case of ebend, we want to avoid underflows in exponentiation and
5852 C subsequent NaNs and INFs in energy calculation.
5853 C Find the largest exponent
5856 if (emin.gt.contr(j)) emin=contr(j)
5860 C Compute the contribution to SC energy and derivatives
5864 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5865 escloc_i=escloc_i+expfac
5867 dersc(k)=dersc(k)+Ax(k,j)*expfac
5869 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5870 & +gaussc(1,2,j,it))*expfac
5874 dersc(1)=dersc(1)/cos(theti)**2
5875 dersc12=dersc12/cos(theti)**2
5876 escloci=-(dlog(escloc_i)-emin)
5878 dersc(j)=dersc(j)/escloc_i
5880 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5884 c----------------------------------------------------------------------------------
5885 subroutine esc(escloc)
5886 C Calculate the local energy of a side chain and its derivatives in the
5887 C corresponding virtual-bond valence angles THETA and the spherical angles
5888 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5889 C added by Urszula Kozlowska. 07/11/2007
5891 implicit real*8 (a-h,o-z)
5892 include 'DIMENSIONS'
5893 include 'COMMON.GEO'
5894 include 'COMMON.LOCAL'
5895 include 'COMMON.VAR'
5896 include 'COMMON.SCROT'
5897 include 'COMMON.INTERACT'
5898 include 'COMMON.DERIV'
5899 include 'COMMON.CHAIN'
5900 include 'COMMON.IOUNITS'
5901 include 'COMMON.NAMES'
5902 include 'COMMON.FFIELD'
5903 include 'COMMON.CONTROL'
5904 include 'COMMON.VECTORS'
5905 double precision x_prime(3),y_prime(3),z_prime(3)
5906 & , sumene,dsc_i,dp2_i,x(65),
5907 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5908 & de_dxx,de_dyy,de_dzz,de_dt
5909 double precision s1_t,s1_6_t,s2_t,s2_6_t
5911 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5912 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5913 & dt_dCi(3),dt_dCi1(3)
5914 common /sccalc/ time11,time12,time112,theti,it,nlobit
5917 do i=loc_start,loc_end
5918 if (itype(i).eq.ntyp1) cycle
5919 costtab(i+1) =dcos(theta(i+1))
5920 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5921 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5922 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5923 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5924 cosfac=dsqrt(cosfac2)
5925 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5926 sinfac=dsqrt(sinfac2)
5928 if (it.eq.10) goto 1
5930 C Compute the axes of tghe local cartesian coordinates system; store in
5931 c x_prime, y_prime and z_prime
5938 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5939 C & dc_norm(3,i+nres)
5941 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5942 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5945 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5948 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5949 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5950 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5951 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5952 c & " xy",scalar(x_prime(1),y_prime(1)),
5953 c & " xz",scalar(x_prime(1),z_prime(1)),
5954 c & " yy",scalar(y_prime(1),y_prime(1)),
5955 c & " yz",scalar(y_prime(1),z_prime(1)),
5956 c & " zz",scalar(z_prime(1),z_prime(1))
5958 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5959 C to local coordinate system. Store in xx, yy, zz.
5965 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5966 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5967 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5974 C Compute the energy of the ith side cbain
5976 c write (2,*) "xx",xx," yy",yy," zz",zz
5979 x(j) = sc_parmin(j,it)
5982 Cc diagnostics - remove later
5984 yy1 = dsin(alph(2))*dcos(omeg(2))
5985 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5986 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5987 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5989 C," --- ", xx_w,yy_w,zz_w
5992 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5993 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5995 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5996 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5998 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5999 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6000 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6001 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6002 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6004 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6005 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6006 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6007 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6008 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6010 dsc_i = 0.743d0+x(61)
6012 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6013 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6014 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6015 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6016 s1=(1+x(63))/(0.1d0 + dscp1)
6017 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6018 s2=(1+x(65))/(0.1d0 + dscp2)
6019 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6020 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6021 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6022 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6024 c & dscp1,dscp2,sumene
6025 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6026 escloc = escloc + sumene
6027 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6032 C This section to check the numerical derivatives of the energy of ith side
6033 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6034 C #define DEBUG in the code to turn it on.
6036 write (2,*) "sumene =",sumene
6040 write (2,*) xx,yy,zz
6041 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6042 de_dxx_num=(sumenep-sumene)/aincr
6044 write (2,*) "xx+ sumene from enesc=",sumenep
6047 write (2,*) xx,yy,zz
6048 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6049 de_dyy_num=(sumenep-sumene)/aincr
6051 write (2,*) "yy+ sumene from enesc=",sumenep
6054 write (2,*) xx,yy,zz
6055 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6056 de_dzz_num=(sumenep-sumene)/aincr
6058 write (2,*) "zz+ sumene from enesc=",sumenep
6059 costsave=cost2tab(i+1)
6060 sintsave=sint2tab(i+1)
6061 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6062 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6063 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6064 de_dt_num=(sumenep-sumene)/aincr
6065 write (2,*) " t+ sumene from enesc=",sumenep
6066 cost2tab(i+1)=costsave
6067 sint2tab(i+1)=sintsave
6068 C End of diagnostics section.
6071 C Compute the gradient of esc
6073 c zz=zz*dsign(1.0,dfloat(itype(i)))
6074 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6075 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6076 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6077 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6078 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6079 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6080 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6081 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6082 pom1=(sumene3*sint2tab(i+1)+sumene1)
6083 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6084 pom2=(sumene4*cost2tab(i+1)+sumene2)
6085 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6086 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6087 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6088 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6090 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6091 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6092 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6094 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6095 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6096 & +(pom1+pom2)*pom_dx
6098 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6101 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6102 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6103 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6105 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6106 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6107 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6108 & +x(59)*zz**2 +x(60)*xx*zz
6109 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6110 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6111 & +(pom1-pom2)*pom_dy
6113 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6116 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6117 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6118 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6119 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6120 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6121 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6122 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6123 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6125 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6128 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6129 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6130 & +pom1*pom_dt1+pom2*pom_dt2
6132 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6137 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6138 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6139 cosfac2xx=cosfac2*xx
6140 sinfac2yy=sinfac2*yy
6142 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6144 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6146 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6147 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6148 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6149 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6150 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6151 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6152 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6153 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6154 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6155 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6159 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6160 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6161 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6162 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6165 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6166 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6167 dZZ_XYZ(k)=vbld_inv(i+nres)*
6168 & (z_prime(k)-zz*dC_norm(k,i+nres))
6170 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6171 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6175 dXX_Ctab(k,i)=dXX_Ci(k)
6176 dXX_C1tab(k,i)=dXX_Ci1(k)
6177 dYY_Ctab(k,i)=dYY_Ci(k)
6178 dYY_C1tab(k,i)=dYY_Ci1(k)
6179 dZZ_Ctab(k,i)=dZZ_Ci(k)
6180 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6181 dXX_XYZtab(k,i)=dXX_XYZ(k)
6182 dYY_XYZtab(k,i)=dYY_XYZ(k)
6183 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6187 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6188 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6189 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6190 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6191 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6193 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6194 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6195 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6196 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6197 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6198 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6199 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6200 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6202 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6203 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6205 C to check gradient call subroutine check_grad
6211 c------------------------------------------------------------------------------
6212 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6214 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6215 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6216 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6217 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6219 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6220 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6222 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6223 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6224 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6225 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6226 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6228 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6229 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6230 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6231 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6232 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6234 dsc_i = 0.743d0+x(61)
6236 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6237 & *(xx*cost2+yy*sint2))
6238 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6239 & *(xx*cost2-yy*sint2))
6240 s1=(1+x(63))/(0.1d0 + dscp1)
6241 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6242 s2=(1+x(65))/(0.1d0 + dscp2)
6243 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6244 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6245 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6250 c------------------------------------------------------------------------------
6251 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6253 C This procedure calculates two-body contact function g(rij) and its derivative:
6256 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6259 C where x=(rij-r0ij)/delta
6261 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6264 double precision rij,r0ij,eps0ij,fcont,fprimcont
6265 double precision x,x2,x4,delta
6269 if (x.lt.-1.0D0) then
6272 else if (x.le.1.0D0) then
6275 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6276 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6283 c------------------------------------------------------------------------------
6284 subroutine splinthet(theti,delta,ss,ssder)
6285 implicit real*8 (a-h,o-z)
6286 include 'DIMENSIONS'
6287 include 'COMMON.VAR'
6288 include 'COMMON.GEO'
6291 if (theti.gt.pipol) then
6292 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6294 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6299 c------------------------------------------------------------------------------
6300 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6302 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6303 double precision ksi,ksi2,ksi3,a1,a2,a3
6304 a1=fprim0*delta/(f1-f0)
6310 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6311 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6314 c------------------------------------------------------------------------------
6315 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6317 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6318 double precision ksi,ksi2,ksi3,a1,a2,a3
6323 a2=3*(f1x-f0x)-2*fprim0x*delta
6324 a3=fprim0x*delta-2*(f1x-f0x)
6325 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6328 C-----------------------------------------------------------------------------
6330 C-----------------------------------------------------------------------------
6331 subroutine etor(etors,edihcnstr)
6332 implicit real*8 (a-h,o-z)
6333 include 'DIMENSIONS'
6334 include 'COMMON.VAR'
6335 include 'COMMON.GEO'
6336 include 'COMMON.LOCAL'
6337 include 'COMMON.TORSION'
6338 include 'COMMON.INTERACT'
6339 include 'COMMON.DERIV'
6340 include 'COMMON.CHAIN'
6341 include 'COMMON.NAMES'
6342 include 'COMMON.IOUNITS'
6343 include 'COMMON.FFIELD'
6344 include 'COMMON.TORCNSTR'
6345 include 'COMMON.CONTROL'
6347 C Set lprn=.true. for debugging
6351 do i=iphi_start,iphi_end
6353 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6354 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6355 itori=itortyp(itype(i-2))
6356 itori1=itortyp(itype(i-1))
6359 C Proline-Proline pair is a special case...
6360 if (itori.eq.3 .and. itori1.eq.3) then
6361 if (phii.gt.-dwapi3) then
6363 fac=1.0D0/(1.0D0-cosphi)
6364 etorsi=v1(1,3,3)*fac
6365 etorsi=etorsi+etorsi
6366 etors=etors+etorsi-v1(1,3,3)
6367 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6368 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6371 v1ij=v1(j+1,itori,itori1)
6372 v2ij=v2(j+1,itori,itori1)
6375 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6376 if (energy_dec) etors_ii=etors_ii+
6377 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6378 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6382 v1ij=v1(j,itori,itori1)
6383 v2ij=v2(j,itori,itori1)
6386 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6387 if (energy_dec) etors_ii=etors_ii+
6388 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6389 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6392 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6395 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6396 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6397 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6398 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6399 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6401 ! 6/20/98 - dihedral angle constraints
6404 itori=idih_constr(i)
6407 if (difi.gt.drange(i)) then
6409 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6410 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6411 else if (difi.lt.-drange(i)) then
6413 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6414 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6416 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6417 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6419 ! write (iout,*) 'edihcnstr',edihcnstr
6422 c------------------------------------------------------------------------------
6423 subroutine etor_d(etors_d)
6427 c----------------------------------------------------------------------------
6429 subroutine etor(etors,edihcnstr)
6430 implicit real*8 (a-h,o-z)
6431 include 'DIMENSIONS'
6432 include 'COMMON.VAR'
6433 include 'COMMON.GEO'
6434 include 'COMMON.LOCAL'
6435 include 'COMMON.TORSION'
6436 include 'COMMON.INTERACT'
6437 include 'COMMON.DERIV'
6438 include 'COMMON.CHAIN'
6439 include 'COMMON.NAMES'
6440 include 'COMMON.IOUNITS'
6441 include 'COMMON.FFIELD'
6442 include 'COMMON.TORCNSTR'
6443 include 'COMMON.CONTROL'
6445 C Set lprn=.true. for debugging
6449 do i=iphi_start,iphi_end
6450 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6451 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6452 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6453 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6454 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6455 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6456 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6457 C For introducing the NH3+ and COO- group please check the etor_d for reference
6460 if (iabs(itype(i)).eq.20) then
6465 itori=itortyp(itype(i-2))
6466 itori1=itortyp(itype(i-1))
6469 C Regular cosine and sine terms
6470 do j=1,nterm(itori,itori1,iblock)
6471 v1ij=v1(j,itori,itori1,iblock)
6472 v2ij=v2(j,itori,itori1,iblock)
6475 etors=etors+v1ij*cosphi+v2ij*sinphi
6476 if (energy_dec) etors_ii=etors_ii+
6477 & v1ij*cosphi+v2ij*sinphi
6478 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6482 C E = SUM ----------------------------------- - v1
6483 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6485 cosphi=dcos(0.5d0*phii)
6486 sinphi=dsin(0.5d0*phii)
6487 do j=1,nlor(itori,itori1,iblock)
6488 vl1ij=vlor1(j,itori,itori1)
6489 vl2ij=vlor2(j,itori,itori1)
6490 vl3ij=vlor3(j,itori,itori1)
6491 pom=vl2ij*cosphi+vl3ij*sinphi
6492 pom1=1.0d0/(pom*pom+1.0d0)
6493 etors=etors+vl1ij*pom1
6494 if (energy_dec) etors_ii=etors_ii+
6497 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6499 C Subtract the constant term
6500 etors=etors-v0(itori,itori1,iblock)
6501 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6502 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6504 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6505 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6506 & (v1(j,itori,itori1,iblock),j=1,6),
6507 & (v2(j,itori,itori1,iblock),j=1,6)
6508 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6509 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6511 ! 6/20/98 - dihedral angle constraints
6513 c do i=1,ndih_constr
6514 do i=idihconstr_start,idihconstr_end
6515 itori=idih_constr(i)
6517 difi=pinorm(phii-phi0(i))
6518 if (difi.gt.drange(i)) then
6520 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6521 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6522 else if (difi.lt.-drange(i)) then
6524 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6525 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6529 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6530 cd & rad2deg*phi0(i), rad2deg*drange(i),
6531 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6533 cd write (iout,*) 'edihcnstr',edihcnstr
6536 c----------------------------------------------------------------------------
6537 subroutine etor_d(etors_d)
6538 C 6/23/01 Compute double torsional energy
6539 implicit real*8 (a-h,o-z)
6540 include 'DIMENSIONS'
6541 include 'COMMON.VAR'
6542 include 'COMMON.GEO'
6543 include 'COMMON.LOCAL'
6544 include 'COMMON.TORSION'
6545 include 'COMMON.INTERACT'
6546 include 'COMMON.DERIV'
6547 include 'COMMON.CHAIN'
6548 include 'COMMON.NAMES'
6549 include 'COMMON.IOUNITS'
6550 include 'COMMON.FFIELD'
6551 include 'COMMON.TORCNSTR'
6553 C Set lprn=.true. for debugging
6557 c write(iout,*) "a tu??"
6558 do i=iphid_start,iphid_end
6559 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6560 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6561 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6562 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6563 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6564 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6565 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6566 & (itype(i+1).eq.ntyp1)) cycle
6567 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6568 itori=itortyp(itype(i-2))
6569 itori1=itortyp(itype(i-1))
6570 itori2=itortyp(itype(i))
6576 if (iabs(itype(i+1)).eq.20) iblock=2
6577 C Iblock=2 Proline type
6578 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6579 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6580 C if (itype(i+1).eq.ntyp1) iblock=3
6581 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6582 C IS or IS NOT need for this
6583 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6584 C is (itype(i-3).eq.ntyp1) ntblock=2
6585 C ntblock is N-terminal blocking group
6587 C Regular cosine and sine terms
6588 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6589 C Example of changes for NH3+ blocking group
6590 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6591 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6592 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6593 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6594 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6595 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6596 cosphi1=dcos(j*phii)
6597 sinphi1=dsin(j*phii)
6598 cosphi2=dcos(j*phii1)
6599 sinphi2=dsin(j*phii1)
6600 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6601 & v2cij*cosphi2+v2sij*sinphi2
6602 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6603 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6605 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6607 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6608 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6609 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6610 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6611 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6612 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6613 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6614 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6615 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6616 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6617 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6618 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6619 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6620 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6623 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6624 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6629 c------------------------------------------------------------------------------
6630 subroutine eback_sc_corr(esccor)
6631 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6632 c conformational states; temporarily implemented as differences
6633 c between UNRES torsional potentials (dependent on three types of
6634 c residues) and the torsional potentials dependent on all 20 types
6635 c of residues computed from AM1 energy surfaces of terminally-blocked
6636 c amino-acid residues.
6637 implicit real*8 (a-h,o-z)
6638 include 'DIMENSIONS'
6639 include 'COMMON.VAR'
6640 include 'COMMON.GEO'
6641 include 'COMMON.LOCAL'
6642 include 'COMMON.TORSION'
6643 include 'COMMON.SCCOR'
6644 include 'COMMON.INTERACT'
6645 include 'COMMON.DERIV'
6646 include 'COMMON.CHAIN'
6647 include 'COMMON.NAMES'
6648 include 'COMMON.IOUNITS'
6649 include 'COMMON.FFIELD'
6650 include 'COMMON.CONTROL'
6652 C Set lprn=.true. for debugging
6655 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6657 do i=itau_start,itau_end
6658 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6660 isccori=isccortyp(itype(i-2))
6661 isccori1=isccortyp(itype(i-1))
6662 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6664 do intertyp=1,3 !intertyp
6665 cc Added 09 May 2012 (Adasko)
6666 cc Intertyp means interaction type of backbone mainchain correlation:
6667 c 1 = SC...Ca...Ca...Ca
6668 c 2 = Ca...Ca...Ca...SC
6669 c 3 = SC...Ca...Ca...SCi
6671 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6672 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6673 & (itype(i-1).eq.ntyp1)))
6674 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6675 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6676 & .or.(itype(i).eq.ntyp1)))
6677 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6678 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6679 & (itype(i-3).eq.ntyp1)))) cycle
6680 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6681 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6683 do j=1,nterm_sccor(isccori,isccori1)
6684 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6685 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6686 cosphi=dcos(j*tauangle(intertyp,i))
6687 sinphi=dsin(j*tauangle(intertyp,i))
6688 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6689 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6691 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6692 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6694 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6695 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6696 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6697 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6698 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6704 c----------------------------------------------------------------------------
6705 subroutine multibody(ecorr)
6706 C This subroutine calculates multi-body contributions to energy following
6707 C the idea of Skolnick et al. If side chains I and J make a contact and
6708 C at the same time side chains I+1 and J+1 make a contact, an extra
6709 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6710 implicit real*8 (a-h,o-z)
6711 include 'DIMENSIONS'
6712 include 'COMMON.IOUNITS'
6713 include 'COMMON.DERIV'
6714 include 'COMMON.INTERACT'
6715 include 'COMMON.CONTACTS'
6716 double precision gx(3),gx1(3)
6719 C Set lprn=.true. for debugging
6723 write (iout,'(a)') 'Contact function values:'
6725 write (iout,'(i2,20(1x,i2,f10.5))')
6726 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6741 num_conti=num_cont(i)
6742 num_conti1=num_cont(i1)
6747 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6748 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6749 cd & ' ishift=',ishift
6750 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6751 C The system gains extra energy.
6752 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6753 endif ! j1==j+-ishift
6762 c------------------------------------------------------------------------------
6763 double precision function esccorr(i,j,k,l,jj,kk)
6764 implicit real*8 (a-h,o-z)
6765 include 'DIMENSIONS'
6766 include 'COMMON.IOUNITS'
6767 include 'COMMON.DERIV'
6768 include 'COMMON.INTERACT'
6769 include 'COMMON.CONTACTS'
6770 double precision gx(3),gx1(3)
6775 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6776 C Calculate the multi-body contribution to energy.
6777 C Calculate multi-body contributions to the gradient.
6778 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6779 cd & k,l,(gacont(m,kk,k),m=1,3)
6781 gx(m) =ekl*gacont(m,jj,i)
6782 gx1(m)=eij*gacont(m,kk,k)
6783 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6784 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6785 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6786 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6790 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6795 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6801 c------------------------------------------------------------------------------
6802 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6803 C This subroutine calculates multi-body contributions to hydrogen-bonding
6804 implicit real*8 (a-h,o-z)
6805 include 'DIMENSIONS'
6806 include 'COMMON.IOUNITS'
6809 parameter (max_cont=maxconts)
6810 parameter (max_dim=26)
6811 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6812 double precision zapas(max_dim,maxconts,max_fg_procs),
6813 & zapas_recv(max_dim,maxconts,max_fg_procs)
6814 common /przechowalnia/ zapas
6815 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6816 & status_array(MPI_STATUS_SIZE,maxconts*2)
6818 include 'COMMON.SETUP'
6819 include 'COMMON.FFIELD'
6820 include 'COMMON.DERIV'
6821 include 'COMMON.INTERACT'
6822 include 'COMMON.CONTACTS'
6823 include 'COMMON.CONTROL'
6824 include 'COMMON.LOCAL'
6825 double precision gx(3),gx1(3),time00
6828 C Set lprn=.true. for debugging
6833 if (nfgtasks.le.1) goto 30
6835 write (iout,'(a)') 'Contact function values before RECEIVE:'
6837 write (iout,'(2i3,50(1x,i2,f5.2))')
6838 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6839 & j=1,num_cont_hb(i))
6843 do i=1,ntask_cont_from
6846 do i=1,ntask_cont_to
6849 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6851 C Make the list of contacts to send to send to other procesors
6852 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6854 do i=iturn3_start,iturn3_end
6855 c write (iout,*) "make contact list turn3",i," num_cont",
6857 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6859 do i=iturn4_start,iturn4_end
6860 c write (iout,*) "make contact list turn4",i," num_cont",
6862 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6866 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6868 do j=1,num_cont_hb(i)
6871 iproc=iint_sent_local(k,jjc,ii)
6872 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6873 if (iproc.gt.0) then
6874 ncont_sent(iproc)=ncont_sent(iproc)+1
6875 nn=ncont_sent(iproc)
6877 zapas(2,nn,iproc)=jjc
6878 zapas(3,nn,iproc)=facont_hb(j,i)
6879 zapas(4,nn,iproc)=ees0p(j,i)
6880 zapas(5,nn,iproc)=ees0m(j,i)
6881 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6882 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6883 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6884 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6885 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6886 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6887 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6888 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6889 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6890 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6891 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6892 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6893 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6894 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6895 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6896 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6897 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6898 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6899 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6900 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6901 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6908 & "Numbers of contacts to be sent to other processors",
6909 & (ncont_sent(i),i=1,ntask_cont_to)
6910 write (iout,*) "Contacts sent"
6911 do ii=1,ntask_cont_to
6913 iproc=itask_cont_to(ii)
6914 write (iout,*) nn," contacts to processor",iproc,
6915 & " of CONT_TO_COMM group"
6917 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6925 CorrelID1=nfgtasks+fg_rank+1
6927 C Receive the numbers of needed contacts from other processors
6928 do ii=1,ntask_cont_from
6929 iproc=itask_cont_from(ii)
6931 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6932 & FG_COMM,req(ireq),IERR)
6934 c write (iout,*) "IRECV ended"
6936 C Send the number of contacts needed by other processors
6937 do ii=1,ntask_cont_to
6938 iproc=itask_cont_to(ii)
6940 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6941 & FG_COMM,req(ireq),IERR)
6943 c write (iout,*) "ISEND ended"
6944 c write (iout,*) "number of requests (nn)",ireq
6947 & call MPI_Waitall(ireq,req,status_array,ierr)
6949 c & "Numbers of contacts to be received from other processors",
6950 c & (ncont_recv(i),i=1,ntask_cont_from)
6954 do ii=1,ntask_cont_from
6955 iproc=itask_cont_from(ii)
6957 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6958 c & " of CONT_TO_COMM group"
6962 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6963 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6964 c write (iout,*) "ireq,req",ireq,req(ireq)
6967 C Send the contacts to processors that need them
6968 do ii=1,ntask_cont_to
6969 iproc=itask_cont_to(ii)
6971 c write (iout,*) nn," contacts to processor",iproc,
6972 c & " of CONT_TO_COMM group"
6975 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6976 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6977 c write (iout,*) "ireq,req",ireq,req(ireq)
6979 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6983 c write (iout,*) "number of requests (contacts)",ireq
6984 c write (iout,*) "req",(req(i),i=1,4)
6987 & call MPI_Waitall(ireq,req,status_array,ierr)
6988 do iii=1,ntask_cont_from
6989 iproc=itask_cont_from(iii)
6992 write (iout,*) "Received",nn," contacts from processor",iproc,
6993 & " of CONT_FROM_COMM group"
6996 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7001 ii=zapas_recv(1,i,iii)
7002 c Flag the received contacts to prevent double-counting
7003 jj=-zapas_recv(2,i,iii)
7004 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7006 nnn=num_cont_hb(ii)+1
7009 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7010 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7011 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7012 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7013 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7014 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7015 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7016 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7017 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7018 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7019 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7020 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7021 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7022 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7023 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7024 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7025 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7026 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7027 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7028 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7029 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7030 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7031 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7032 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7037 write (iout,'(a)') 'Contact function values after receive:'
7039 write (iout,'(2i3,50(1x,i3,f5.2))')
7040 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7041 & j=1,num_cont_hb(i))
7048 write (iout,'(a)') 'Contact function values:'
7050 write (iout,'(2i3,50(1x,i3,f5.2))')
7051 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7052 & j=1,num_cont_hb(i))
7056 C Remove the loop below after debugging !!!
7063 C Calculate the local-electrostatic correlation terms
7064 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7066 num_conti=num_cont_hb(i)
7067 num_conti1=num_cont_hb(i+1)
7074 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7075 c & ' jj=',jj,' kk=',kk
7076 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7077 & .or. j.lt.0 .and. j1.gt.0) .and.
7078 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7079 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7080 C The system gains extra energy.
7081 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7082 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7083 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7085 else if (j1.eq.j) then
7086 C Contacts I-J and I-(J+1) occur simultaneously.
7087 C The system loses extra energy.
7088 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7093 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7094 c & ' jj=',jj,' kk=',kk
7096 C Contacts I-J and (I+1)-J occur simultaneously.
7097 C The system loses extra energy.
7098 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7105 c------------------------------------------------------------------------------
7106 subroutine add_hb_contact(ii,jj,itask)
7107 implicit real*8 (a-h,o-z)
7108 include "DIMENSIONS"
7109 include "COMMON.IOUNITS"
7112 parameter (max_cont=maxconts)
7113 parameter (max_dim=26)
7114 include "COMMON.CONTACTS"
7115 double precision zapas(max_dim,maxconts,max_fg_procs),
7116 & zapas_recv(max_dim,maxconts,max_fg_procs)
7117 common /przechowalnia/ zapas
7118 integer i,j,ii,jj,iproc,itask(4),nn
7119 c write (iout,*) "itask",itask
7122 if (iproc.gt.0) then
7123 do j=1,num_cont_hb(ii)
7125 c write (iout,*) "i",ii," j",jj," jjc",jjc
7127 ncont_sent(iproc)=ncont_sent(iproc)+1
7128 nn=ncont_sent(iproc)
7129 zapas(1,nn,iproc)=ii
7130 zapas(2,nn,iproc)=jjc
7131 zapas(3,nn,iproc)=facont_hb(j,ii)
7132 zapas(4,nn,iproc)=ees0p(j,ii)
7133 zapas(5,nn,iproc)=ees0m(j,ii)
7134 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7135 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7136 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7137 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7138 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7139 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7140 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7141 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7142 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7143 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7144 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7145 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7146 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7147 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7148 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7149 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7150 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7151 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7152 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7153 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7154 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7162 c------------------------------------------------------------------------------
7163 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7165 C This subroutine calculates multi-body contributions to hydrogen-bonding
7166 implicit real*8 (a-h,o-z)
7167 include 'DIMENSIONS'
7168 include 'COMMON.IOUNITS'
7171 parameter (max_cont=maxconts)
7172 parameter (max_dim=70)
7173 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7174 double precision zapas(max_dim,maxconts,max_fg_procs),
7175 & zapas_recv(max_dim,maxconts,max_fg_procs)
7176 common /przechowalnia/ zapas
7177 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7178 & status_array(MPI_STATUS_SIZE,maxconts*2)
7180 include 'COMMON.SETUP'
7181 include 'COMMON.FFIELD'
7182 include 'COMMON.DERIV'
7183 include 'COMMON.LOCAL'
7184 include 'COMMON.INTERACT'
7185 include 'COMMON.CONTACTS'
7186 include 'COMMON.CHAIN'
7187 include 'COMMON.CONTROL'
7188 double precision gx(3),gx1(3)
7189 integer num_cont_hb_old(maxres)
7191 double precision eello4,eello5,eelo6,eello_turn6
7192 external eello4,eello5,eello6,eello_turn6
7193 C Set lprn=.true. for debugging
7198 num_cont_hb_old(i)=num_cont_hb(i)
7202 if (nfgtasks.le.1) goto 30
7204 write (iout,'(a)') 'Contact function values before RECEIVE:'
7206 write (iout,'(2i3,50(1x,i2,f5.2))')
7207 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7208 & j=1,num_cont_hb(i))
7212 do i=1,ntask_cont_from
7215 do i=1,ntask_cont_to
7218 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7220 C Make the list of contacts to send to send to other procesors
7221 do i=iturn3_start,iturn3_end
7222 c write (iout,*) "make contact list turn3",i," num_cont",
7224 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7226 do i=iturn4_start,iturn4_end
7227 c write (iout,*) "make contact list turn4",i," num_cont",
7229 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7233 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7235 do j=1,num_cont_hb(i)
7238 iproc=iint_sent_local(k,jjc,ii)
7239 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7240 if (iproc.ne.0) then
7241 ncont_sent(iproc)=ncont_sent(iproc)+1
7242 nn=ncont_sent(iproc)
7244 zapas(2,nn,iproc)=jjc
7245 zapas(3,nn,iproc)=d_cont(j,i)
7249 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7254 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7262 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7273 & "Numbers of contacts to be sent to other processors",
7274 & (ncont_sent(i),i=1,ntask_cont_to)
7275 write (iout,*) "Contacts sent"
7276 do ii=1,ntask_cont_to
7278 iproc=itask_cont_to(ii)
7279 write (iout,*) nn," contacts to processor",iproc,
7280 & " of CONT_TO_COMM group"
7282 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7290 CorrelID1=nfgtasks+fg_rank+1
7292 C Receive the numbers of needed contacts from other processors
7293 do ii=1,ntask_cont_from
7294 iproc=itask_cont_from(ii)
7296 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7297 & FG_COMM,req(ireq),IERR)
7299 c write (iout,*) "IRECV ended"
7301 C Send the number of contacts needed by other processors
7302 do ii=1,ntask_cont_to
7303 iproc=itask_cont_to(ii)
7305 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7306 & FG_COMM,req(ireq),IERR)
7308 c write (iout,*) "ISEND ended"
7309 c write (iout,*) "number of requests (nn)",ireq
7312 & call MPI_Waitall(ireq,req,status_array,ierr)
7314 c & "Numbers of contacts to be received from other processors",
7315 c & (ncont_recv(i),i=1,ntask_cont_from)
7319 do ii=1,ntask_cont_from
7320 iproc=itask_cont_from(ii)
7322 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7323 c & " of CONT_TO_COMM group"
7327 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7328 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7329 c write (iout,*) "ireq,req",ireq,req(ireq)
7332 C Send the contacts to processors that need them
7333 do ii=1,ntask_cont_to
7334 iproc=itask_cont_to(ii)
7336 c write (iout,*) nn," contacts to processor",iproc,
7337 c & " of CONT_TO_COMM group"
7340 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7341 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7342 c write (iout,*) "ireq,req",ireq,req(ireq)
7344 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7348 c write (iout,*) "number of requests (contacts)",ireq
7349 c write (iout,*) "req",(req(i),i=1,4)
7352 & call MPI_Waitall(ireq,req,status_array,ierr)
7353 do iii=1,ntask_cont_from
7354 iproc=itask_cont_from(iii)
7357 write (iout,*) "Received",nn," contacts from processor",iproc,
7358 & " of CONT_FROM_COMM group"
7361 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7366 ii=zapas_recv(1,i,iii)
7367 c Flag the received contacts to prevent double-counting
7368 jj=-zapas_recv(2,i,iii)
7369 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7371 nnn=num_cont_hb(ii)+1
7374 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7378 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7383 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7391 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7400 write (iout,'(a)') 'Contact function values after receive:'
7402 write (iout,'(2i3,50(1x,i3,5f6.3))')
7403 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7404 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7411 write (iout,'(a)') 'Contact function values:'
7413 write (iout,'(2i3,50(1x,i2,5f6.3))')
7414 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7415 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7421 C Remove the loop below after debugging !!!
7428 C Calculate the dipole-dipole interaction energies
7429 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7430 do i=iatel_s,iatel_e+1
7431 num_conti=num_cont_hb(i)
7440 C Calculate the local-electrostatic correlation terms
7441 c write (iout,*) "gradcorr5 in eello5 before loop"
7443 c write (iout,'(i5,3f10.5)')
7444 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7446 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7447 c write (iout,*) "corr loop i",i
7449 num_conti=num_cont_hb(i)
7450 num_conti1=num_cont_hb(i+1)
7457 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7458 c & ' jj=',jj,' kk=',kk
7459 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7460 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7461 & .or. j.lt.0 .and. j1.gt.0) .and.
7462 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7463 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7464 C The system gains extra energy.
7466 sqd1=dsqrt(d_cont(jj,i))
7467 sqd2=dsqrt(d_cont(kk,i1))
7468 sred_geom = sqd1*sqd2
7469 IF (sred_geom.lt.cutoff_corr) THEN
7470 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7472 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7473 cd & ' jj=',jj,' kk=',kk
7474 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7475 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7477 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7478 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7481 cd write (iout,*) 'sred_geom=',sred_geom,
7482 cd & ' ekont=',ekont,' fprim=',fprimcont,
7483 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7484 cd write (iout,*) "g_contij",g_contij
7485 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7486 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7487 call calc_eello(i,jp,i+1,jp1,jj,kk)
7488 if (wcorr4.gt.0.0d0)
7489 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7490 if (energy_dec.and.wcorr4.gt.0.0d0)
7491 1 write (iout,'(a6,4i5,0pf7.3)')
7492 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7493 c write (iout,*) "gradcorr5 before eello5"
7495 c write (iout,'(i5,3f10.5)')
7496 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7498 if (wcorr5.gt.0.0d0)
7499 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7500 c write (iout,*) "gradcorr5 after eello5"
7502 c write (iout,'(i5,3f10.5)')
7503 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7505 if (energy_dec.and.wcorr5.gt.0.0d0)
7506 1 write (iout,'(a6,4i5,0pf7.3)')
7507 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7508 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7509 cd write(2,*)'ijkl',i,jp,i+1,jp1
7510 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7511 & .or. wturn6.eq.0.0d0))then
7512 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7513 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7514 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7515 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7516 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7517 cd & 'ecorr6=',ecorr6
7518 cd write (iout,'(4e15.5)') sred_geom,
7519 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7520 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7521 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7522 else if (wturn6.gt.0.0d0
7523 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7524 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7525 eturn6=eturn6+eello_turn6(i,jj,kk)
7526 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7527 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7528 cd write (2,*) 'multibody_eello:eturn6',eturn6
7537 num_cont_hb(i)=num_cont_hb_old(i)
7539 c write (iout,*) "gradcorr5 in eello5"
7541 c write (iout,'(i5,3f10.5)')
7542 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7546 c------------------------------------------------------------------------------
7547 subroutine add_hb_contact_eello(ii,jj,itask)
7548 implicit real*8 (a-h,o-z)
7549 include "DIMENSIONS"
7550 include "COMMON.IOUNITS"
7553 parameter (max_cont=maxconts)
7554 parameter (max_dim=70)
7555 include "COMMON.CONTACTS"
7556 double precision zapas(max_dim,maxconts,max_fg_procs),
7557 & zapas_recv(max_dim,maxconts,max_fg_procs)
7558 common /przechowalnia/ zapas
7559 integer i,j,ii,jj,iproc,itask(4),nn
7560 c write (iout,*) "itask",itask
7563 if (iproc.gt.0) then
7564 do j=1,num_cont_hb(ii)
7566 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7568 ncont_sent(iproc)=ncont_sent(iproc)+1
7569 nn=ncont_sent(iproc)
7570 zapas(1,nn,iproc)=ii
7571 zapas(2,nn,iproc)=jjc
7572 zapas(3,nn,iproc)=d_cont(j,ii)
7576 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7581 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7589 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7601 c------------------------------------------------------------------------------
7602 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7603 implicit real*8 (a-h,o-z)
7604 include 'DIMENSIONS'
7605 include 'COMMON.IOUNITS'
7606 include 'COMMON.DERIV'
7607 include 'COMMON.INTERACT'
7608 include 'COMMON.CONTACTS'
7609 double precision gx(3),gx1(3)
7619 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7620 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7621 C Following 4 lines for diagnostics.
7626 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7627 c & 'Contacts ',i,j,
7628 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7629 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7631 C Calculate the multi-body contribution to energy.
7632 c ecorr=ecorr+ekont*ees
7633 C Calculate multi-body contributions to the gradient.
7634 coeffpees0pij=coeffp*ees0pij
7635 coeffmees0mij=coeffm*ees0mij
7636 coeffpees0pkl=coeffp*ees0pkl
7637 coeffmees0mkl=coeffm*ees0mkl
7639 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7640 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7641 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7642 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7643 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7644 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7645 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7646 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7647 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7648 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7649 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7650 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7651 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7652 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7653 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7654 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7655 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7656 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7657 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7658 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7659 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7660 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7661 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7662 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7663 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7668 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7669 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7670 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7671 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7676 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7677 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7678 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7679 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7682 c write (iout,*) "ehbcorr",ekont*ees
7687 C---------------------------------------------------------------------------
7688 subroutine dipole(i,j,jj)
7689 implicit real*8 (a-h,o-z)
7690 include 'DIMENSIONS'
7691 include 'COMMON.IOUNITS'
7692 include 'COMMON.CHAIN'
7693 include 'COMMON.FFIELD'
7694 include 'COMMON.DERIV'
7695 include 'COMMON.INTERACT'
7696 include 'COMMON.CONTACTS'
7697 include 'COMMON.TORSION'
7698 include 'COMMON.VAR'
7699 include 'COMMON.GEO'
7700 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7702 iti1 = itortyp(itype(i+1))
7703 if (j.lt.nres-1) then
7704 itj1 = itortyp(itype(j+1))
7709 dipi(iii,1)=Ub2(iii,i)
7710 dipderi(iii)=Ub2der(iii,i)
7711 dipi(iii,2)=b1(iii,i+1)
7712 dipj(iii,1)=Ub2(iii,j)
7713 dipderj(iii)=Ub2der(iii,j)
7714 dipj(iii,2)=b1(iii,j+1)
7718 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7721 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7728 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7732 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7737 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7738 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7740 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7742 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7744 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7749 C---------------------------------------------------------------------------
7750 subroutine calc_eello(i,j,k,l,jj,kk)
7752 C This subroutine computes matrices and vectors needed to calculate
7753 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7755 implicit real*8 (a-h,o-z)
7756 include 'DIMENSIONS'
7757 include 'COMMON.IOUNITS'
7758 include 'COMMON.CHAIN'
7759 include 'COMMON.DERIV'
7760 include 'COMMON.INTERACT'
7761 include 'COMMON.CONTACTS'
7762 include 'COMMON.TORSION'
7763 include 'COMMON.VAR'
7764 include 'COMMON.GEO'
7765 include 'COMMON.FFIELD'
7766 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7767 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7770 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7771 cd & ' jj=',jj,' kk=',kk
7772 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7773 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7774 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7777 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7778 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7781 call transpose2(aa1(1,1),aa1t(1,1))
7782 call transpose2(aa2(1,1),aa2t(1,1))
7785 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7786 & aa1tder(1,1,lll,kkk))
7787 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7788 & aa2tder(1,1,lll,kkk))
7792 C parallel orientation of the two CA-CA-CA frames.
7794 iti=itortyp(itype(i))
7798 itk1=itortyp(itype(k+1))
7799 itj=itortyp(itype(j))
7800 if (l.lt.nres-1) then
7801 itl1=itortyp(itype(l+1))
7805 C A1 kernel(j+1) A2T
7807 cd write (iout,'(3f10.5,5x,3f10.5)')
7808 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7810 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7811 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7812 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7813 C Following matrices are needed only for 6-th order cumulants
7814 IF (wcorr6.gt.0.0d0) THEN
7815 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7816 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7817 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7818 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7819 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7820 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7821 & ADtEAderx(1,1,1,1,1,1))
7823 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7824 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7825 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7826 & ADtEA1derx(1,1,1,1,1,1))
7828 C End 6-th order cumulants
7831 cd write (2,*) 'In calc_eello6'
7833 cd write (2,*) 'iii=',iii
7835 cd write (2,*) 'kkk=',kkk
7837 cd write (2,'(3(2f10.5),5x)')
7838 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7843 call transpose2(EUgder(1,1,k),auxmat(1,1))
7844 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7845 call transpose2(EUg(1,1,k),auxmat(1,1))
7846 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7847 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7851 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7852 & EAEAderx(1,1,lll,kkk,iii,1))
7856 C A1T kernel(i+1) A2
7857 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7858 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7859 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7860 C Following matrices are needed only for 6-th order cumulants
7861 IF (wcorr6.gt.0.0d0) THEN
7862 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7863 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7864 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7865 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7866 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7867 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7868 & ADtEAderx(1,1,1,1,1,2))
7869 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7870 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7871 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7872 & ADtEA1derx(1,1,1,1,1,2))
7874 C End 6-th order cumulants
7875 call transpose2(EUgder(1,1,l),auxmat(1,1))
7876 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7877 call transpose2(EUg(1,1,l),auxmat(1,1))
7878 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7879 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7883 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7884 & EAEAderx(1,1,lll,kkk,iii,2))
7889 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7890 C They are needed only when the fifth- or the sixth-order cumulants are
7892 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7893 call transpose2(AEA(1,1,1),auxmat(1,1))
7894 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7895 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7896 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7897 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7898 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7899 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7900 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7901 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7902 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7903 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7904 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7905 call transpose2(AEA(1,1,2),auxmat(1,1))
7906 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7907 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7908 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7909 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7910 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7911 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7912 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7913 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7914 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7915 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7916 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7917 C Calculate the Cartesian derivatives of the vectors.
7921 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7922 call matvec2(auxmat(1,1),b1(1,i),
7923 & AEAb1derx(1,lll,kkk,iii,1,1))
7924 call matvec2(auxmat(1,1),Ub2(1,i),
7925 & AEAb2derx(1,lll,kkk,iii,1,1))
7926 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7927 & AEAb1derx(1,lll,kkk,iii,2,1))
7928 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7929 & AEAb2derx(1,lll,kkk,iii,2,1))
7930 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7931 call matvec2(auxmat(1,1),b1(1,j),
7932 & AEAb1derx(1,lll,kkk,iii,1,2))
7933 call matvec2(auxmat(1,1),Ub2(1,j),
7934 & AEAb2derx(1,lll,kkk,iii,1,2))
7935 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7936 & AEAb1derx(1,lll,kkk,iii,2,2))
7937 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7938 & AEAb2derx(1,lll,kkk,iii,2,2))
7945 C Antiparallel orientation of the two CA-CA-CA frames.
7947 iti=itortyp(itype(i))
7951 itk1=itortyp(itype(k+1))
7952 itl=itortyp(itype(l))
7953 itj=itortyp(itype(j))
7954 if (j.lt.nres-1) then
7955 itj1=itortyp(itype(j+1))
7959 C A2 kernel(j-1)T A1T
7960 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7961 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7962 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7963 C Following matrices are needed only for 6-th order cumulants
7964 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7965 & j.eq.i+4 .and. l.eq.i+3)) THEN
7966 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7967 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7968 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7969 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7970 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7971 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7972 & ADtEAderx(1,1,1,1,1,1))
7973 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7974 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7975 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7976 & ADtEA1derx(1,1,1,1,1,1))
7978 C End 6-th order cumulants
7979 call transpose2(EUgder(1,1,k),auxmat(1,1))
7980 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7981 call transpose2(EUg(1,1,k),auxmat(1,1))
7982 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7983 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7987 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7988 & EAEAderx(1,1,lll,kkk,iii,1))
7992 C A2T kernel(i+1)T A1
7993 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7994 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7995 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7996 C Following matrices are needed only for 6-th order cumulants
7997 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7998 & j.eq.i+4 .and. l.eq.i+3)) THEN
7999 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8000 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8001 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8002 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8003 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8004 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8005 & ADtEAderx(1,1,1,1,1,2))
8006 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8007 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8008 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8009 & ADtEA1derx(1,1,1,1,1,2))
8011 C End 6-th order cumulants
8012 call transpose2(EUgder(1,1,j),auxmat(1,1))
8013 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8014 call transpose2(EUg(1,1,j),auxmat(1,1))
8015 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8016 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8020 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8021 & EAEAderx(1,1,lll,kkk,iii,2))
8026 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8027 C They are needed only when the fifth- or the sixth-order cumulants are
8029 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8030 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8031 call transpose2(AEA(1,1,1),auxmat(1,1))
8032 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8033 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8034 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8035 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8036 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8037 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8038 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8039 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8040 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8041 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8042 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8043 call transpose2(AEA(1,1,2),auxmat(1,1))
8044 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8045 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8046 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8047 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8048 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8049 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8050 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8051 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8052 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8053 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8054 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8055 C Calculate the Cartesian derivatives of the vectors.
8059 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8060 call matvec2(auxmat(1,1),b1(1,i),
8061 & AEAb1derx(1,lll,kkk,iii,1,1))
8062 call matvec2(auxmat(1,1),Ub2(1,i),
8063 & AEAb2derx(1,lll,kkk,iii,1,1))
8064 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8065 & AEAb1derx(1,lll,kkk,iii,2,1))
8066 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8067 & AEAb2derx(1,lll,kkk,iii,2,1))
8068 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8069 call matvec2(auxmat(1,1),b1(1,l),
8070 & AEAb1derx(1,lll,kkk,iii,1,2))
8071 call matvec2(auxmat(1,1),Ub2(1,l),
8072 & AEAb2derx(1,lll,kkk,iii,1,2))
8073 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8074 & AEAb1derx(1,lll,kkk,iii,2,2))
8075 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8076 & AEAb2derx(1,lll,kkk,iii,2,2))
8085 C---------------------------------------------------------------------------
8086 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8087 & KK,KKderg,AKA,AKAderg,AKAderx)
8091 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8092 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8093 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8098 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8100 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8103 cd if (lprn) write (2,*) 'In kernel'
8105 cd if (lprn) write (2,*) 'kkk=',kkk
8107 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8108 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8110 cd write (2,*) 'lll=',lll
8111 cd write (2,*) 'iii=1'
8113 cd write (2,'(3(2f10.5),5x)')
8114 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8117 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8118 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8120 cd write (2,*) 'lll=',lll
8121 cd write (2,*) 'iii=2'
8123 cd write (2,'(3(2f10.5),5x)')
8124 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8131 C---------------------------------------------------------------------------
8132 double precision function eello4(i,j,k,l,jj,kk)
8133 implicit real*8 (a-h,o-z)
8134 include 'DIMENSIONS'
8135 include 'COMMON.IOUNITS'
8136 include 'COMMON.CHAIN'
8137 include 'COMMON.DERIV'
8138 include 'COMMON.INTERACT'
8139 include 'COMMON.CONTACTS'
8140 include 'COMMON.TORSION'
8141 include 'COMMON.VAR'
8142 include 'COMMON.GEO'
8143 double precision pizda(2,2),ggg1(3),ggg2(3)
8144 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8148 cd print *,'eello4:',i,j,k,l,jj,kk
8149 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8150 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8151 cold eij=facont_hb(jj,i)
8152 cold ekl=facont_hb(kk,k)
8154 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8155 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8156 gcorr_loc(k-1)=gcorr_loc(k-1)
8157 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8159 gcorr_loc(l-1)=gcorr_loc(l-1)
8160 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8162 gcorr_loc(j-1)=gcorr_loc(j-1)
8163 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8168 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8169 & -EAEAderx(2,2,lll,kkk,iii,1)
8170 cd derx(lll,kkk,iii)=0.0d0
8174 cd gcorr_loc(l-1)=0.0d0
8175 cd gcorr_loc(j-1)=0.0d0
8176 cd gcorr_loc(k-1)=0.0d0
8178 cd write (iout,*)'Contacts have occurred for peptide groups',
8179 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8180 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8181 if (j.lt.nres-1) then
8188 if (l.lt.nres-1) then
8196 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8197 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8198 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8199 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8200 cgrad ghalf=0.5d0*ggg1(ll)
8201 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8202 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8203 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8204 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8205 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8206 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8207 cgrad ghalf=0.5d0*ggg2(ll)
8208 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8209 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8210 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8211 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8212 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8213 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8217 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8222 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8227 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8232 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8236 cd write (2,*) iii,gcorr_loc(iii)
8239 cd write (2,*) 'ekont',ekont
8240 cd write (iout,*) 'eello4',ekont*eel4
8243 C---------------------------------------------------------------------------
8244 double precision function eello5(i,j,k,l,jj,kk)
8245 implicit real*8 (a-h,o-z)
8246 include 'DIMENSIONS'
8247 include 'COMMON.IOUNITS'
8248 include 'COMMON.CHAIN'
8249 include 'COMMON.DERIV'
8250 include 'COMMON.INTERACT'
8251 include 'COMMON.CONTACTS'
8252 include 'COMMON.TORSION'
8253 include 'COMMON.VAR'
8254 include 'COMMON.GEO'
8255 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8256 double precision ggg1(3),ggg2(3)
8257 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8262 C /l\ / \ \ / \ / \ / C
8263 C / \ / \ \ / \ / \ / C
8264 C j| o |l1 | o | o| o | | o |o C
8265 C \ |/k\| |/ \| / |/ \| |/ \| C
8266 C \i/ \ / \ / / \ / \ C
8268 C (I) (II) (III) (IV) C
8270 C eello5_1 eello5_2 eello5_3 eello5_4 C
8272 C Antiparallel chains C
8275 C /j\ / \ \ / \ / \ / C
8276 C / \ / \ \ / \ / \ / C
8277 C j1| o |l | o | o| o | | o |o C
8278 C \ |/k\| |/ \| / |/ \| |/ \| C
8279 C \i/ \ / \ / / \ / \ C
8281 C (I) (II) (III) (IV) C
8283 C eello5_1 eello5_2 eello5_3 eello5_4 C
8285 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8287 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8288 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8293 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8295 itk=itortyp(itype(k))
8296 itl=itortyp(itype(l))
8297 itj=itortyp(itype(j))
8302 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8303 cd & eel5_3_num,eel5_4_num)
8307 derx(lll,kkk,iii)=0.0d0
8311 cd eij=facont_hb(jj,i)
8312 cd ekl=facont_hb(kk,k)
8314 cd write (iout,*)'Contacts have occurred for peptide groups',
8315 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8317 C Contribution from the graph I.
8318 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8319 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8320 call transpose2(EUg(1,1,k),auxmat(1,1))
8321 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8322 vv(1)=pizda(1,1)-pizda(2,2)
8323 vv(2)=pizda(1,2)+pizda(2,1)
8324 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8325 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8326 C Explicit gradient in virtual-dihedral angles.
8327 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8328 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8329 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8330 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8331 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8332 vv(1)=pizda(1,1)-pizda(2,2)
8333 vv(2)=pizda(1,2)+pizda(2,1)
8334 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8335 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8336 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8337 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8338 vv(1)=pizda(1,1)-pizda(2,2)
8339 vv(2)=pizda(1,2)+pizda(2,1)
8341 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8342 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8343 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8345 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8346 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8347 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8349 C Cartesian gradient
8353 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8355 vv(1)=pizda(1,1)-pizda(2,2)
8356 vv(2)=pizda(1,2)+pizda(2,1)
8357 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8358 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8359 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8365 C Contribution from graph II
8366 call transpose2(EE(1,1,itk),auxmat(1,1))
8367 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8368 vv(1)=pizda(1,1)+pizda(2,2)
8369 vv(2)=pizda(2,1)-pizda(1,2)
8370 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8371 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8372 C Explicit gradient in virtual-dihedral angles.
8373 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8374 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8375 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8376 vv(1)=pizda(1,1)+pizda(2,2)
8377 vv(2)=pizda(2,1)-pizda(1,2)
8379 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8380 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8381 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8383 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8384 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8385 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8387 C Cartesian gradient
8391 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8393 vv(1)=pizda(1,1)+pizda(2,2)
8394 vv(2)=pizda(2,1)-pizda(1,2)
8395 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8396 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8397 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8405 C Parallel orientation
8406 C Contribution from graph III
8407 call transpose2(EUg(1,1,l),auxmat(1,1))
8408 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8409 vv(1)=pizda(1,1)-pizda(2,2)
8410 vv(2)=pizda(1,2)+pizda(2,1)
8411 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8412 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8413 C Explicit gradient in virtual-dihedral angles.
8414 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8415 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8416 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8417 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8418 vv(1)=pizda(1,1)-pizda(2,2)
8419 vv(2)=pizda(1,2)+pizda(2,1)
8420 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8421 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8422 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8423 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8424 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8425 vv(1)=pizda(1,1)-pizda(2,2)
8426 vv(2)=pizda(1,2)+pizda(2,1)
8427 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8428 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8429 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8430 C Cartesian gradient
8434 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8436 vv(1)=pizda(1,1)-pizda(2,2)
8437 vv(2)=pizda(1,2)+pizda(2,1)
8438 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8439 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8440 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8445 C Contribution from graph IV
8447 call transpose2(EE(1,1,itl),auxmat(1,1))
8448 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8449 vv(1)=pizda(1,1)+pizda(2,2)
8450 vv(2)=pizda(2,1)-pizda(1,2)
8451 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8452 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8453 C Explicit gradient in virtual-dihedral angles.
8454 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8455 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8456 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8457 vv(1)=pizda(1,1)+pizda(2,2)
8458 vv(2)=pizda(2,1)-pizda(1,2)
8459 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8460 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8461 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8462 C Cartesian gradient
8466 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8468 vv(1)=pizda(1,1)+pizda(2,2)
8469 vv(2)=pizda(2,1)-pizda(1,2)
8470 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8471 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8472 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8477 C Antiparallel orientation
8478 C Contribution from graph III
8480 call transpose2(EUg(1,1,j),auxmat(1,1))
8481 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8482 vv(1)=pizda(1,1)-pizda(2,2)
8483 vv(2)=pizda(1,2)+pizda(2,1)
8484 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8485 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8486 C Explicit gradient in virtual-dihedral angles.
8487 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8488 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8489 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8490 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8491 vv(1)=pizda(1,1)-pizda(2,2)
8492 vv(2)=pizda(1,2)+pizda(2,1)
8493 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8494 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8495 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8496 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8497 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8498 vv(1)=pizda(1,1)-pizda(2,2)
8499 vv(2)=pizda(1,2)+pizda(2,1)
8500 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8501 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8502 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8503 C Cartesian gradient
8507 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8509 vv(1)=pizda(1,1)-pizda(2,2)
8510 vv(2)=pizda(1,2)+pizda(2,1)
8511 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8512 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8513 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8518 C Contribution from graph IV
8520 call transpose2(EE(1,1,itj),auxmat(1,1))
8521 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8522 vv(1)=pizda(1,1)+pizda(2,2)
8523 vv(2)=pizda(2,1)-pizda(1,2)
8524 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8525 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8526 C Explicit gradient in virtual-dihedral angles.
8527 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8528 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8529 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8530 vv(1)=pizda(1,1)+pizda(2,2)
8531 vv(2)=pizda(2,1)-pizda(1,2)
8532 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8533 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8534 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8535 C Cartesian gradient
8539 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8541 vv(1)=pizda(1,1)+pizda(2,2)
8542 vv(2)=pizda(2,1)-pizda(1,2)
8543 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8544 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8545 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8551 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8552 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8553 cd write (2,*) 'ijkl',i,j,k,l
8554 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8555 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8557 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8558 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8559 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8560 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8561 if (j.lt.nres-1) then
8568 if (l.lt.nres-1) then
8578 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8579 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8580 C summed up outside the subrouine as for the other subroutines
8581 C handling long-range interactions. The old code is commented out
8582 C with "cgrad" to keep track of changes.
8584 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8585 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8586 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8587 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8588 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8589 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8590 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8591 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8592 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8593 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8595 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8596 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8597 cgrad ghalf=0.5d0*ggg1(ll)
8599 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8600 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8601 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8602 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8603 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8604 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8605 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8606 cgrad ghalf=0.5d0*ggg2(ll)
8608 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8609 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8610 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8611 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8612 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8613 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8618 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8619 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8624 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8625 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8631 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8636 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8640 cd write (2,*) iii,g_corr5_loc(iii)
8643 cd write (2,*) 'ekont',ekont
8644 cd write (iout,*) 'eello5',ekont*eel5
8647 c--------------------------------------------------------------------------
8648 double precision function eello6(i,j,k,l,jj,kk)
8649 implicit real*8 (a-h,o-z)
8650 include 'DIMENSIONS'
8651 include 'COMMON.IOUNITS'
8652 include 'COMMON.CHAIN'
8653 include 'COMMON.DERIV'
8654 include 'COMMON.INTERACT'
8655 include 'COMMON.CONTACTS'
8656 include 'COMMON.TORSION'
8657 include 'COMMON.VAR'
8658 include 'COMMON.GEO'
8659 include 'COMMON.FFIELD'
8660 double precision ggg1(3),ggg2(3)
8661 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8666 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8674 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8675 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8679 derx(lll,kkk,iii)=0.0d0
8683 cd eij=facont_hb(jj,i)
8684 cd ekl=facont_hb(kk,k)
8690 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8691 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8692 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8693 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8694 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8695 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8697 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8698 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8699 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8700 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8701 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8702 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8706 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8708 C If turn contributions are considered, they will be handled separately.
8709 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8710 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8711 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8712 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8713 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8714 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8715 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8717 if (j.lt.nres-1) then
8724 if (l.lt.nres-1) then
8732 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8733 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8734 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8735 cgrad ghalf=0.5d0*ggg1(ll)
8737 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8738 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8739 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8740 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8741 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8742 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8743 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8744 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8745 cgrad ghalf=0.5d0*ggg2(ll)
8746 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8748 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8749 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8750 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8751 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8752 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8753 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8758 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8759 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8764 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8765 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8771 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8776 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8780 cd write (2,*) iii,g_corr6_loc(iii)
8783 cd write (2,*) 'ekont',ekont
8784 cd write (iout,*) 'eello6',ekont*eel6
8787 c--------------------------------------------------------------------------
8788 double precision function eello6_graph1(i,j,k,l,imat,swap)
8789 implicit real*8 (a-h,o-z)
8790 include 'DIMENSIONS'
8791 include 'COMMON.IOUNITS'
8792 include 'COMMON.CHAIN'
8793 include 'COMMON.DERIV'
8794 include 'COMMON.INTERACT'
8795 include 'COMMON.CONTACTS'
8796 include 'COMMON.TORSION'
8797 include 'COMMON.VAR'
8798 include 'COMMON.GEO'
8799 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8803 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8805 C Parallel Antiparallel C
8811 C \ j|/k\| / \ |/k\|l / C
8816 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8817 itk=itortyp(itype(k))
8818 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8819 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8820 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8821 call transpose2(EUgC(1,1,k),auxmat(1,1))
8822 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8823 vv1(1)=pizda1(1,1)-pizda1(2,2)
8824 vv1(2)=pizda1(1,2)+pizda1(2,1)
8825 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8826 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8827 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8828 s5=scalar2(vv(1),Dtobr2(1,i))
8829 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8830 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8831 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8832 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8833 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8834 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8835 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8836 & +scalar2(vv(1),Dtobr2der(1,i)))
8837 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8838 vv1(1)=pizda1(1,1)-pizda1(2,2)
8839 vv1(2)=pizda1(1,2)+pizda1(2,1)
8840 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8841 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8843 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8844 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8845 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8846 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8847 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8849 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8850 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8851 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8852 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8853 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8855 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8856 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8857 vv1(1)=pizda1(1,1)-pizda1(2,2)
8858 vv1(2)=pizda1(1,2)+pizda1(2,1)
8859 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8860 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8861 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8862 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8871 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8872 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8873 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8874 call transpose2(EUgC(1,1,k),auxmat(1,1))
8875 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8877 vv1(1)=pizda1(1,1)-pizda1(2,2)
8878 vv1(2)=pizda1(1,2)+pizda1(2,1)
8879 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8880 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8881 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8882 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8883 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8884 s5=scalar2(vv(1),Dtobr2(1,i))
8885 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8891 c----------------------------------------------------------------------------
8892 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8893 implicit real*8 (a-h,o-z)
8894 include 'DIMENSIONS'
8895 include 'COMMON.IOUNITS'
8896 include 'COMMON.CHAIN'
8897 include 'COMMON.DERIV'
8898 include 'COMMON.INTERACT'
8899 include 'COMMON.CONTACTS'
8900 include 'COMMON.TORSION'
8901 include 'COMMON.VAR'
8902 include 'COMMON.GEO'
8904 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8905 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8908 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8910 C Parallel Antiparallel C
8916 C \ j|/k\| \ |/k\|l C
8921 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8922 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8923 C AL 7/4/01 s1 would occur in the sixth-order moment,
8924 C but not in a cluster cumulant
8926 s1=dip(1,jj,i)*dip(1,kk,k)
8928 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8929 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8930 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8931 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8932 call transpose2(EUg(1,1,k),auxmat(1,1))
8933 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8934 vv(1)=pizda(1,1)-pizda(2,2)
8935 vv(2)=pizda(1,2)+pizda(2,1)
8936 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8937 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8939 eello6_graph2=-(s1+s2+s3+s4)
8941 eello6_graph2=-(s2+s3+s4)
8944 C Derivatives in gamma(i-1)
8947 s1=dipderg(1,jj,i)*dip(1,kk,k)
8949 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8950 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8951 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8952 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8954 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8956 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8958 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8960 C Derivatives in gamma(k-1)
8962 s1=dip(1,jj,i)*dipderg(1,kk,k)
8964 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8965 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8966 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8967 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8968 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8969 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8970 vv(1)=pizda(1,1)-pizda(2,2)
8971 vv(2)=pizda(1,2)+pizda(2,1)
8972 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8974 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8976 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8978 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8979 C Derivatives in gamma(j-1) or gamma(l-1)
8982 s1=dipderg(3,jj,i)*dip(1,kk,k)
8984 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8985 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8986 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8987 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8988 vv(1)=pizda(1,1)-pizda(2,2)
8989 vv(2)=pizda(1,2)+pizda(2,1)
8990 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8993 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8995 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8998 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8999 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9001 C Derivatives in gamma(l-1) or gamma(j-1)
9004 s1=dip(1,jj,i)*dipderg(3,kk,k)
9006 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9007 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9008 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9009 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9010 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9011 vv(1)=pizda(1,1)-pizda(2,2)
9012 vv(2)=pizda(1,2)+pizda(2,1)
9013 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9016 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9018 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9021 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9022 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9024 C Cartesian derivatives.
9026 write (2,*) 'In eello6_graph2'
9028 write (2,*) 'iii=',iii
9030 write (2,*) 'kkk=',kkk
9032 write (2,'(3(2f10.5),5x)')
9033 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9043 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9045 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9048 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9050 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9051 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9053 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9054 call transpose2(EUg(1,1,k),auxmat(1,1))
9055 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9057 vv(1)=pizda(1,1)-pizda(2,2)
9058 vv(2)=pizda(1,2)+pizda(2,1)
9059 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9060 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9062 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9064 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9067 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9069 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9076 c----------------------------------------------------------------------------
9077 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9078 implicit real*8 (a-h,o-z)
9079 include 'DIMENSIONS'
9080 include 'COMMON.IOUNITS'
9081 include 'COMMON.CHAIN'
9082 include 'COMMON.DERIV'
9083 include 'COMMON.INTERACT'
9084 include 'COMMON.CONTACTS'
9085 include 'COMMON.TORSION'
9086 include 'COMMON.VAR'
9087 include 'COMMON.GEO'
9088 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9090 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9092 C Parallel Antiparallel C
9098 C j|/k\| / |/k\|l / C
9103 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9105 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9106 C energy moment and not to the cluster cumulant.
9107 iti=itortyp(itype(i))
9108 if (j.lt.nres-1) then
9109 itj1=itortyp(itype(j+1))
9113 itk=itortyp(itype(k))
9114 itk1=itortyp(itype(k+1))
9115 if (l.lt.nres-1) then
9116 itl1=itortyp(itype(l+1))
9121 s1=dip(4,jj,i)*dip(4,kk,k)
9123 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9124 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9125 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9126 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9127 call transpose2(EE(1,1,itk),auxmat(1,1))
9128 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9129 vv(1)=pizda(1,1)+pizda(2,2)
9130 vv(2)=pizda(2,1)-pizda(1,2)
9131 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9132 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9133 cd & "sum",-(s2+s3+s4)
9135 eello6_graph3=-(s1+s2+s3+s4)
9137 eello6_graph3=-(s2+s3+s4)
9140 C Derivatives in gamma(k-1)
9141 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9142 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9143 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9144 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9145 C Derivatives in gamma(l-1)
9146 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9147 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9148 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9149 vv(1)=pizda(1,1)+pizda(2,2)
9150 vv(2)=pizda(2,1)-pizda(1,2)
9151 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9152 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9153 C Cartesian derivatives.
9159 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9161 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9164 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9166 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9167 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9169 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9170 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9172 vv(1)=pizda(1,1)+pizda(2,2)
9173 vv(2)=pizda(2,1)-pizda(1,2)
9174 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9176 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9178 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9181 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9183 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9185 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9191 c----------------------------------------------------------------------------
9192 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9193 implicit real*8 (a-h,o-z)
9194 include 'DIMENSIONS'
9195 include 'COMMON.IOUNITS'
9196 include 'COMMON.CHAIN'
9197 include 'COMMON.DERIV'
9198 include 'COMMON.INTERACT'
9199 include 'COMMON.CONTACTS'
9200 include 'COMMON.TORSION'
9201 include 'COMMON.VAR'
9202 include 'COMMON.GEO'
9203 include 'COMMON.FFIELD'
9204 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9205 & auxvec1(2),auxmat1(2,2)
9207 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9209 C Parallel Antiparallel C
9215 C \ j|/k\| \ |/k\|l C
9220 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9222 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9223 C energy moment and not to the cluster cumulant.
9224 cd write (2,*) 'eello_graph4: wturn6',wturn6
9225 iti=itortyp(itype(i))
9226 itj=itortyp(itype(j))
9227 if (j.lt.nres-1) then
9228 itj1=itortyp(itype(j+1))
9232 itk=itortyp(itype(k))
9233 if (k.lt.nres-1) then
9234 itk1=itortyp(itype(k+1))
9238 itl=itortyp(itype(l))
9239 if (l.lt.nres-1) then
9240 itl1=itortyp(itype(l+1))
9244 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9245 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9246 cd & ' itl',itl,' itl1',itl1
9249 s1=dip(3,jj,i)*dip(3,kk,k)
9251 s1=dip(2,jj,j)*dip(2,kk,l)
9254 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9255 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9257 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9258 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9260 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9261 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9263 call transpose2(EUg(1,1,k),auxmat(1,1))
9264 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9265 vv(1)=pizda(1,1)-pizda(2,2)
9266 vv(2)=pizda(2,1)+pizda(1,2)
9267 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9268 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9270 eello6_graph4=-(s1+s2+s3+s4)
9272 eello6_graph4=-(s2+s3+s4)
9274 C Derivatives in gamma(i-1)
9278 s1=dipderg(2,jj,i)*dip(3,kk,k)
9280 s1=dipderg(4,jj,j)*dip(2,kk,l)
9283 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9285 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9286 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9288 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9289 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9291 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9292 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9293 cd write (2,*) 'turn6 derivatives'
9295 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9297 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9301 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9303 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9307 C Derivatives in gamma(k-1)
9310 s1=dip(3,jj,i)*dipderg(2,kk,k)
9312 s1=dip(2,jj,j)*dipderg(4,kk,l)
9315 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9316 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9318 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9319 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9321 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9322 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9324 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9325 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9326 vv(1)=pizda(1,1)-pizda(2,2)
9327 vv(2)=pizda(2,1)+pizda(1,2)
9328 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9329 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9331 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9333 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9337 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9339 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9342 C Derivatives in gamma(j-1) or gamma(l-1)
9343 if (l.eq.j+1 .and. l.gt.1) then
9344 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9345 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9346 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9347 vv(1)=pizda(1,1)-pizda(2,2)
9348 vv(2)=pizda(2,1)+pizda(1,2)
9349 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9350 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9351 else if (j.gt.1) then
9352 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9353 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9354 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9355 vv(1)=pizda(1,1)-pizda(2,2)
9356 vv(2)=pizda(2,1)+pizda(1,2)
9357 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9358 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9359 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9361 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9364 C Cartesian derivatives.
9371 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9373 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9377 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9379 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9383 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9385 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9387 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9388 & b1(1,j+1),auxvec(1))
9389 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9391 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9392 & b1(1,l+1),auxvec(1))
9393 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9395 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9397 vv(1)=pizda(1,1)-pizda(2,2)
9398 vv(2)=pizda(2,1)+pizda(1,2)
9399 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9401 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9403 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9406 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9409 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9412 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9414 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9416 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9420 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9422 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9425 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9427 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9435 c----------------------------------------------------------------------------
9436 double precision function eello_turn6(i,jj,kk)
9437 implicit real*8 (a-h,o-z)
9438 include 'DIMENSIONS'
9439 include 'COMMON.IOUNITS'
9440 include 'COMMON.CHAIN'
9441 include 'COMMON.DERIV'
9442 include 'COMMON.INTERACT'
9443 include 'COMMON.CONTACTS'
9444 include 'COMMON.TORSION'
9445 include 'COMMON.VAR'
9446 include 'COMMON.GEO'
9447 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9448 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9450 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9451 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9452 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9453 C the respective energy moment and not to the cluster cumulant.
9462 iti=itortyp(itype(i))
9463 itk=itortyp(itype(k))
9464 itk1=itortyp(itype(k+1))
9465 itl=itortyp(itype(l))
9466 itj=itortyp(itype(j))
9467 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9468 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9469 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9474 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9476 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9480 derx_turn(lll,kkk,iii)=0.0d0
9487 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9489 cd write (2,*) 'eello6_5',eello6_5
9491 call transpose2(AEA(1,1,1),auxmat(1,1))
9492 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9493 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9494 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9496 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9497 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9498 s2 = scalar2(b1(1,k),vtemp1(1))
9500 call transpose2(AEA(1,1,2),atemp(1,1))
9501 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9502 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9503 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9505 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9506 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9507 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9509 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9510 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9511 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9512 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9513 ss13 = scalar2(b1(1,k),vtemp4(1))
9514 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9516 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9522 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9523 C Derivatives in gamma(i+2)
9527 call transpose2(AEA(1,1,1),auxmatd(1,1))
9528 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9529 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9530 call transpose2(AEAderg(1,1,2),atempd(1,1))
9531 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9532 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9534 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9535 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9536 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9542 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9543 C Derivatives in gamma(i+3)
9545 call transpose2(AEA(1,1,1),auxmatd(1,1))
9546 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9547 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9548 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9550 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9551 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9552 s2d = scalar2(b1(1,k),vtemp1d(1))
9554 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9555 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9557 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9559 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9560 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9561 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9569 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9570 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9572 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9573 & -0.5d0*ekont*(s2d+s12d)
9575 C Derivatives in gamma(i+4)
9576 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9577 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9578 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9580 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9581 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9582 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9590 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9592 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9594 C Derivatives in gamma(i+5)
9596 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9597 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9598 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9600 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9601 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9602 s2d = scalar2(b1(1,k),vtemp1d(1))
9604 call transpose2(AEA(1,1,2),atempd(1,1))
9605 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9606 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9608 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9609 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9611 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9612 ss13d = scalar2(b1(1,k),vtemp4d(1))
9613 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9621 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9622 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9624 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9625 & -0.5d0*ekont*(s2d+s12d)
9627 C Cartesian derivatives
9632 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9633 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9634 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9636 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9637 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9639 s2d = scalar2(b1(1,k),vtemp1d(1))
9641 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9642 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9643 s8d = -(atempd(1,1)+atempd(2,2))*
9644 & scalar2(cc(1,1,itl),vtemp2(1))
9646 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9648 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9649 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9656 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9659 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9663 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9664 & - 0.5d0*(s8d+s12d)
9666 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9675 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9677 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9678 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9679 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9680 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9681 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9683 ss13d = scalar2(b1(1,k),vtemp4d(1))
9684 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9685 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9689 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9690 cd & 16*eel_turn6_num
9692 if (j.lt.nres-1) then
9699 if (l.lt.nres-1) then
9707 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9708 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9709 cgrad ghalf=0.5d0*ggg1(ll)
9711 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9712 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9713 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9714 & +ekont*derx_turn(ll,2,1)
9715 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9716 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9717 & +ekont*derx_turn(ll,4,1)
9718 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9719 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9720 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9721 cgrad ghalf=0.5d0*ggg2(ll)
9723 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9724 & +ekont*derx_turn(ll,2,2)
9725 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9726 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9727 & +ekont*derx_turn(ll,4,2)
9728 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9729 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9730 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9735 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9740 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9746 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9751 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9755 cd write (2,*) iii,g_corr6_loc(iii)
9757 eello_turn6=ekont*eel_turn6
9758 cd write (2,*) 'ekont',ekont
9759 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9763 C-----------------------------------------------------------------------------
9764 double precision function scalar(u,v)
9765 !DIR$ INLINEALWAYS scalar
9767 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9770 double precision u(3),v(3)
9771 cd double precision sc
9779 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9782 crc-------------------------------------------------
9783 SUBROUTINE MATVEC2(A1,V1,V2)
9784 !DIR$ INLINEALWAYS MATVEC2
9786 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9788 implicit real*8 (a-h,o-z)
9789 include 'DIMENSIONS'
9790 DIMENSION A1(2,2),V1(2),V2(2)
9794 c 3 VI=VI+A1(I,K)*V1(K)
9798 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9799 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9804 C---------------------------------------
9805 SUBROUTINE MATMAT2(A1,A2,A3)
9807 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9809 implicit real*8 (a-h,o-z)
9810 include 'DIMENSIONS'
9811 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9812 c DIMENSION AI3(2,2)
9816 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9822 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9823 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9824 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9825 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9833 c-------------------------------------------------------------------------
9834 double precision function scalar2(u,v)
9835 !DIR$ INLINEALWAYS scalar2
9837 double precision u(2),v(2)
9840 scalar2=u(1)*v(1)+u(2)*v(2)
9844 C-----------------------------------------------------------------------------
9846 subroutine transpose2(a,at)
9847 !DIR$ INLINEALWAYS transpose2
9849 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9852 double precision a(2,2),at(2,2)
9859 c--------------------------------------------------------------------------
9860 subroutine transpose(n,a,at)
9863 double precision a(n,n),at(n,n)
9871 C---------------------------------------------------------------------------
9872 subroutine prodmat3(a1,a2,kk,transp,prod)
9873 !DIR$ INLINEALWAYS prodmat3
9875 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9879 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9881 crc double precision auxmat(2,2),prod_(2,2)
9884 crc call transpose2(kk(1,1),auxmat(1,1))
9885 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9886 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9888 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9889 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9890 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9891 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9892 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9893 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9894 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9895 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9898 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9899 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9901 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9902 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9903 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9904 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9905 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9906 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9907 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9908 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9911 c call transpose2(a2(1,1),a2t(1,1))
9914 crc print *,((prod_(i,j),i=1,2),j=1,2)
9915 crc print *,((prod(i,j),i=1,2),j=1,2)