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.
1673 c write (iout,*) "Number of loop steps in EGB:",ind
1674 cccc energy_dec=.false.
1677 C-----------------------------------------------------------------------------
1678 subroutine egbv(evdw)
1680 C This subroutine calculates the interaction energy of nonbonded side chains
1681 C assuming the Gay-Berne-Vorobjev potential of interaction.
1683 implicit real*8 (a-h,o-z)
1684 include 'DIMENSIONS'
1685 include 'COMMON.GEO'
1686 include 'COMMON.VAR'
1687 include 'COMMON.LOCAL'
1688 include 'COMMON.CHAIN'
1689 include 'COMMON.DERIV'
1690 include 'COMMON.NAMES'
1691 include 'COMMON.INTERACT'
1692 include 'COMMON.IOUNITS'
1693 include 'COMMON.CALC'
1694 common /srutu/ icall
1697 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1700 c if (icall.eq.0) lprn=.true.
1702 do i=iatsc_s,iatsc_e
1703 itypi=iabs(itype(i))
1704 if (itypi.eq.ntyp1) cycle
1705 itypi1=iabs(itype(i+1))
1709 dxi=dc_norm(1,nres+i)
1710 dyi=dc_norm(2,nres+i)
1711 dzi=dc_norm(3,nres+i)
1712 c dsci_inv=dsc_inv(itypi)
1713 dsci_inv=vbld_inv(i+nres)
1715 C Calculate SC interaction energy.
1717 do iint=1,nint_gr(i)
1718 do j=istart(i,iint),iend(i,iint)
1720 itypj=iabs(itype(j))
1721 if (itypj.eq.ntyp1) cycle
1722 c dscj_inv=dsc_inv(itypj)
1723 dscj_inv=vbld_inv(j+nres)
1724 sig0ij=sigma(itypi,itypj)
1725 r0ij=r0(itypi,itypj)
1726 chi1=chi(itypi,itypj)
1727 chi2=chi(itypj,itypi)
1734 alf12=0.5D0*(alf1+alf2)
1735 C For diagnostics only!!!
1748 dxj=dc_norm(1,nres+j)
1749 dyj=dc_norm(2,nres+j)
1750 dzj=dc_norm(3,nres+j)
1751 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1753 C Calculate angle-dependent terms of energy and contributions to their
1757 sig=sig0ij*dsqrt(sigsq)
1758 rij_shift=1.0D0/rij-sig+r0ij
1759 C I hate to put IF's in the loops, but here don't have another choice!!!!
1760 if (rij_shift.le.0.0D0) then
1765 c---------------------------------------------------------------
1766 rij_shift=1.0D0/rij_shift
1767 fac=rij_shift**expon
1768 e1=fac*fac*aa(itypi,itypj)
1769 e2=fac*bb(itypi,itypj)
1770 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1771 eps2der=evdwij*eps3rt
1772 eps3der=evdwij*eps2rt
1773 fac_augm=rrij**expon
1774 e_augm=augm(itypi,itypj)*fac_augm
1775 evdwij=evdwij*eps2rt*eps3rt
1776 evdw=evdw+evdwij+e_augm
1778 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1779 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1780 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1781 & restyp(itypi),i,restyp(itypj),j,
1782 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1783 & chi1,chi2,chip1,chip2,
1784 & eps1,eps2rt**2,eps3rt**2,
1785 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1788 C Calculate gradient components.
1789 e1=e1*eps1*eps2rt**2*eps3rt**2
1790 fac=-expon*(e1+evdwij)*rij_shift
1792 fac=rij*fac-2*expon*rrij*e_augm
1793 C Calculate the radial part of the gradient
1797 C Calculate angular part of the gradient.
1803 C-----------------------------------------------------------------------------
1804 subroutine sc_angular
1805 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1806 C om12. Called by ebp, egb, and egbv.
1808 include 'COMMON.CALC'
1809 include 'COMMON.IOUNITS'
1813 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1814 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1815 om12=dxi*dxj+dyi*dyj+dzi*dzj
1817 C Calculate eps1(om12) and its derivative in om12
1818 faceps1=1.0D0-om12*chiom12
1819 faceps1_inv=1.0D0/faceps1
1820 eps1=dsqrt(faceps1_inv)
1821 C Following variable is eps1*deps1/dom12
1822 eps1_om12=faceps1_inv*chiom12
1827 c write (iout,*) "om12",om12," eps1",eps1
1828 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1833 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1834 sigsq=1.0D0-facsig*faceps1_inv
1835 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1836 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1837 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1843 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1844 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1846 C Calculate eps2 and its derivatives in om1, om2, and om12.
1849 chipom12=chip12*om12
1850 facp=1.0D0-om12*chipom12
1852 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1853 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1854 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1855 C Following variable is the square root of eps2
1856 eps2rt=1.0D0-facp1*facp_inv
1857 C Following three variables are the derivatives of the square root of eps
1858 C in om1, om2, and om12.
1859 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1860 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1861 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1862 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1863 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1864 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1865 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1866 c & " eps2rt_om12",eps2rt_om12
1867 C Calculate whole angle-dependent part of epsilon and contributions
1868 C to its derivatives
1871 C----------------------------------------------------------------------------
1873 implicit real*8 (a-h,o-z)
1874 include 'DIMENSIONS'
1875 include 'COMMON.CHAIN'
1876 include 'COMMON.DERIV'
1877 include 'COMMON.CALC'
1878 include 'COMMON.IOUNITS'
1879 double precision dcosom1(3),dcosom2(3)
1880 cc print *,'sss=',sss
1881 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1882 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1883 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1884 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1888 c eom12=evdwij*eps1_om12
1890 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1891 c & " sigder",sigder
1892 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1893 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1895 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1896 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1899 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
1901 c write (iout,*) "gg",(gg(k),k=1,3)
1903 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1904 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1905 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
1906 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1907 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1908 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
1909 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1910 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1911 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1912 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1915 C Calculate the components of the gradient in DC and X
1919 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1923 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1924 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1928 C-----------------------------------------------------------------------
1929 subroutine e_softsphere(evdw)
1931 C This subroutine calculates the interaction energy of nonbonded side chains
1932 C assuming the LJ potential of interaction.
1934 implicit real*8 (a-h,o-z)
1935 include 'DIMENSIONS'
1936 parameter (accur=1.0d-10)
1937 include 'COMMON.GEO'
1938 include 'COMMON.VAR'
1939 include 'COMMON.LOCAL'
1940 include 'COMMON.CHAIN'
1941 include 'COMMON.DERIV'
1942 include 'COMMON.INTERACT'
1943 include 'COMMON.TORSION'
1944 include 'COMMON.SBRIDGE'
1945 include 'COMMON.NAMES'
1946 include 'COMMON.IOUNITS'
1947 include 'COMMON.CONTACTS'
1949 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1951 do i=iatsc_s,iatsc_e
1952 itypi=iabs(itype(i))
1953 if (itypi.eq.ntyp1) cycle
1954 itypi1=iabs(itype(i+1))
1959 C Calculate SC interaction energy.
1961 do iint=1,nint_gr(i)
1962 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1963 cd & 'iend=',iend(i,iint)
1964 do j=istart(i,iint),iend(i,iint)
1965 itypj=iabs(itype(j))
1966 if (itypj.eq.ntyp1) cycle
1970 rij=xj*xj+yj*yj+zj*zj
1971 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1972 r0ij=r0(itypi,itypj)
1974 c print *,i,j,r0ij,dsqrt(rij)
1975 if (rij.lt.r0ijsq) then
1976 evdwij=0.25d0*(rij-r0ijsq)**2
1984 C Calculate the components of the gradient in DC and X
1990 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1991 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1992 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1993 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1997 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2005 C--------------------------------------------------------------------------
2006 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2009 C Soft-sphere potential of p-p interaction
2011 implicit real*8 (a-h,o-z)
2012 include 'DIMENSIONS'
2013 include 'COMMON.CONTROL'
2014 include 'COMMON.IOUNITS'
2015 include 'COMMON.GEO'
2016 include 'COMMON.VAR'
2017 include 'COMMON.LOCAL'
2018 include 'COMMON.CHAIN'
2019 include 'COMMON.DERIV'
2020 include 'COMMON.INTERACT'
2021 include 'COMMON.CONTACTS'
2022 include 'COMMON.TORSION'
2023 include 'COMMON.VECTORS'
2024 include 'COMMON.FFIELD'
2026 C write(iout,*) 'In EELEC_soft_sphere'
2033 do i=iatel_s,iatel_e
2034 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2038 xmedi=c(1,i)+0.5d0*dxi
2039 ymedi=c(2,i)+0.5d0*dyi
2040 zmedi=c(3,i)+0.5d0*dzi
2041 xmedi=mod(xmedi,boxxsize)
2042 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2043 ymedi=mod(ymedi,boxysize)
2044 if (ymedi.lt.0) ymedi=ymedi+boxysize
2045 zmedi=mod(zmedi,boxzsize)
2046 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2048 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2049 do j=ielstart(i),ielend(i)
2050 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2054 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2055 r0ij=rpp(iteli,itelj)
2064 if (xj.lt.0) xj=xj+boxxsize
2066 if (yj.lt.0) yj=yj+boxysize
2068 if (zj.lt.0) zj=zj+boxzsize
2069 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2077 xj=xj_safe+xshift*boxxsize
2078 yj=yj_safe+yshift*boxysize
2079 zj=zj_safe+zshift*boxzsize
2080 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2081 if(dist_temp.lt.dist_init) then
2091 if (isubchap.eq.1) then
2100 rij=xj*xj+yj*yj+zj*zj
2101 sss=sscale(sqrt(rij))
2102 sssgrad=sscagrad(sqrt(rij))
2103 if (rij.lt.r0ijsq) then
2104 evdw1ij=0.25d0*(rij-r0ijsq)**2
2110 evdw1=evdw1+evdw1ij*sss
2112 C Calculate contributions to the Cartesian gradient.
2114 ggg(1)=fac*xj*sssgrad
2115 ggg(2)=fac*yj*sssgrad
2116 ggg(3)=fac*zj*sssgrad
2118 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2119 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2122 * Loop over residues i+1 thru j-1.
2126 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2131 cgrad do i=nnt,nct-1
2133 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2135 cgrad do j=i+1,nct-1
2137 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2143 c------------------------------------------------------------------------------
2144 subroutine vec_and_deriv
2145 implicit real*8 (a-h,o-z)
2146 include 'DIMENSIONS'
2150 include 'COMMON.IOUNITS'
2151 include 'COMMON.GEO'
2152 include 'COMMON.VAR'
2153 include 'COMMON.LOCAL'
2154 include 'COMMON.CHAIN'
2155 include 'COMMON.VECTORS'
2156 include 'COMMON.SETUP'
2157 include 'COMMON.TIME1'
2158 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2159 C Compute the local reference systems. For reference system (i), the
2160 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2161 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2163 do i=ivec_start,ivec_end
2167 if (i.eq.nres-1) then
2168 C Case of the last full residue
2169 C Compute the Z-axis
2170 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2171 costh=dcos(pi-theta(nres))
2172 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2176 C Compute the derivatives of uz
2178 uzder(2,1,1)=-dc_norm(3,i-1)
2179 uzder(3,1,1)= dc_norm(2,i-1)
2180 uzder(1,2,1)= dc_norm(3,i-1)
2182 uzder(3,2,1)=-dc_norm(1,i-1)
2183 uzder(1,3,1)=-dc_norm(2,i-1)
2184 uzder(2,3,1)= dc_norm(1,i-1)
2187 uzder(2,1,2)= dc_norm(3,i)
2188 uzder(3,1,2)=-dc_norm(2,i)
2189 uzder(1,2,2)=-dc_norm(3,i)
2191 uzder(3,2,2)= dc_norm(1,i)
2192 uzder(1,3,2)= dc_norm(2,i)
2193 uzder(2,3,2)=-dc_norm(1,i)
2195 C Compute the Y-axis
2198 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2200 C Compute the derivatives of uy
2203 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2204 & -dc_norm(k,i)*dc_norm(j,i-1)
2205 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2207 uyder(j,j,1)=uyder(j,j,1)-costh
2208 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2213 uygrad(l,k,j,i)=uyder(l,k,j)
2214 uzgrad(l,k,j,i)=uzder(l,k,j)
2218 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2219 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2220 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2221 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2224 C Compute the Z-axis
2225 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2226 costh=dcos(pi-theta(i+2))
2227 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2231 C Compute the derivatives of uz
2233 uzder(2,1,1)=-dc_norm(3,i+1)
2234 uzder(3,1,1)= dc_norm(2,i+1)
2235 uzder(1,2,1)= dc_norm(3,i+1)
2237 uzder(3,2,1)=-dc_norm(1,i+1)
2238 uzder(1,3,1)=-dc_norm(2,i+1)
2239 uzder(2,3,1)= dc_norm(1,i+1)
2242 uzder(2,1,2)= dc_norm(3,i)
2243 uzder(3,1,2)=-dc_norm(2,i)
2244 uzder(1,2,2)=-dc_norm(3,i)
2246 uzder(3,2,2)= dc_norm(1,i)
2247 uzder(1,3,2)= dc_norm(2,i)
2248 uzder(2,3,2)=-dc_norm(1,i)
2250 C Compute the Y-axis
2253 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2255 C Compute the derivatives of uy
2258 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2259 & -dc_norm(k,i)*dc_norm(j,i+1)
2260 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2262 uyder(j,j,1)=uyder(j,j,1)-costh
2263 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2268 uygrad(l,k,j,i)=uyder(l,k,j)
2269 uzgrad(l,k,j,i)=uzder(l,k,j)
2273 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2274 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2275 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2276 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2280 vbld_inv_temp(1)=vbld_inv(i+1)
2281 if (i.lt.nres-1) then
2282 vbld_inv_temp(2)=vbld_inv(i+2)
2284 vbld_inv_temp(2)=vbld_inv(i)
2289 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2290 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2295 #if defined(PARVEC) && defined(MPI)
2296 if (nfgtasks1.gt.1) then
2298 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2299 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2300 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2301 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2302 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2304 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2305 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2307 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2308 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2309 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2310 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2311 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2312 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2313 time_gather=time_gather+MPI_Wtime()-time00
2315 c if (fg_rank.eq.0) then
2316 c write (iout,*) "Arrays UY and UZ"
2318 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2325 C-----------------------------------------------------------------------------
2326 subroutine check_vecgrad
2327 implicit real*8 (a-h,o-z)
2328 include 'DIMENSIONS'
2329 include 'COMMON.IOUNITS'
2330 include 'COMMON.GEO'
2331 include 'COMMON.VAR'
2332 include 'COMMON.LOCAL'
2333 include 'COMMON.CHAIN'
2334 include 'COMMON.VECTORS'
2335 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2336 dimension uyt(3,maxres),uzt(3,maxres)
2337 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2338 double precision delta /1.0d-7/
2341 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2342 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2343 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2344 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2345 cd & (dc_norm(if90,i),if90=1,3)
2346 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2347 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2348 cd write(iout,'(a)')
2354 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2355 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2368 cd write (iout,*) 'i=',i
2370 erij(k)=dc_norm(k,i)
2374 dc_norm(k,i)=erij(k)
2376 dc_norm(j,i)=dc_norm(j,i)+delta
2377 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2379 c dc_norm(k,i)=dc_norm(k,i)/fac
2381 c write (iout,*) (dc_norm(k,i),k=1,3)
2382 c write (iout,*) (erij(k),k=1,3)
2385 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2386 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2387 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2388 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2390 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2391 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2392 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2395 dc_norm(k,i)=erij(k)
2398 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2399 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2400 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2401 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2402 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2403 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2404 cd write (iout,'(a)')
2409 C--------------------------------------------------------------------------
2410 subroutine set_matrices
2411 implicit real*8 (a-h,o-z)
2412 include 'DIMENSIONS'
2415 include "COMMON.SETUP"
2417 integer status(MPI_STATUS_SIZE)
2419 include 'COMMON.IOUNITS'
2420 include 'COMMON.GEO'
2421 include 'COMMON.VAR'
2422 include 'COMMON.LOCAL'
2423 include 'COMMON.CHAIN'
2424 include 'COMMON.DERIV'
2425 include 'COMMON.INTERACT'
2426 include 'COMMON.CONTACTS'
2427 include 'COMMON.TORSION'
2428 include 'COMMON.VECTORS'
2429 include 'COMMON.FFIELD'
2430 double precision auxvec(2),auxmat(2,2)
2432 C Compute the virtual-bond-torsional-angle dependent quantities needed
2433 C to calculate the el-loc multibody terms of various order.
2435 c write(iout,*) 'nphi=',nphi,nres
2437 do i=ivec_start+2,ivec_end+2
2442 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2443 iti = itortyp(itype(i-2))
2447 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2448 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2449 iti1 = itortyp(itype(i-1))
2454 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2455 & +bnew1(2,1,iti)*dsin(theta(i-1))
2456 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2457 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2458 & +bnew1(2,1,iti)*dcos(theta(i-1))
2459 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2460 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2461 c &*(cos(theta(i)/2.0)
2462 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2463 & +bnew2(2,1,iti)*dsin(theta(i-1))
2464 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2465 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2466 c &*(cos(theta(i)/2.0)
2467 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2468 & +bnew2(2,1,iti)*dcos(theta(i-1))
2469 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2470 c if (ggb1(1,i).eq.0.0d0) then
2471 c write(iout,*) 'i=',i,ggb1(1,i),
2472 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2473 c &bnew1(2,1,iti)*cos(theta(i)),
2474 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2476 b1(2,i-2)=bnew1(1,2,iti)
2478 b2(2,i-2)=bnew2(1,2,iti)
2480 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2481 EE(1,2,i-2)=eeold(1,2,iti)
2482 EE(2,1,i-2)=eeold(2,1,iti)
2483 EE(2,2,i-2)=eeold(2,2,iti)
2484 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2489 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2490 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2491 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2492 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2493 b1tilde(1,i-2)=b1(1,i-2)
2494 b1tilde(2,i-2)=-b1(2,i-2)
2495 b2tilde(1,i-2)=b2(1,i-2)
2496 b2tilde(2,i-2)=-b2(2,i-2)
2497 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2498 c write(iout,*) 'b1=',b1(1,i-2)
2499 c write (iout,*) 'theta=', theta(i-1)
2502 do i=ivec_start+2,ivec_end+2
2507 if (i .lt. nres+1) then
2544 if (i .gt. 3 .and. i .lt. nres+1) then
2545 obrot_der(1,i-2)=-sin1
2546 obrot_der(2,i-2)= cos1
2547 Ugder(1,1,i-2)= sin1
2548 Ugder(1,2,i-2)=-cos1
2549 Ugder(2,1,i-2)=-cos1
2550 Ugder(2,2,i-2)=-sin1
2553 obrot2_der(1,i-2)=-dwasin2
2554 obrot2_der(2,i-2)= dwacos2
2555 Ug2der(1,1,i-2)= dwasin2
2556 Ug2der(1,2,i-2)=-dwacos2
2557 Ug2der(2,1,i-2)=-dwacos2
2558 Ug2der(2,2,i-2)=-dwasin2
2560 obrot_der(1,i-2)=0.0d0
2561 obrot_der(2,i-2)=0.0d0
2562 Ugder(1,1,i-2)=0.0d0
2563 Ugder(1,2,i-2)=0.0d0
2564 Ugder(2,1,i-2)=0.0d0
2565 Ugder(2,2,i-2)=0.0d0
2566 obrot2_der(1,i-2)=0.0d0
2567 obrot2_der(2,i-2)=0.0d0
2568 Ug2der(1,1,i-2)=0.0d0
2569 Ug2der(1,2,i-2)=0.0d0
2570 Ug2der(2,1,i-2)=0.0d0
2571 Ug2der(2,2,i-2)=0.0d0
2573 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2574 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2575 iti = itortyp(itype(i-2))
2579 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2580 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2581 iti1 = itortyp(itype(i-1))
2585 cd write (iout,*) '*******i',i,' iti1',iti
2586 cd write (iout,*) 'b1',b1(:,iti)
2587 cd write (iout,*) 'b2',b2(:,iti)
2588 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2589 c if (i .gt. iatel_s+2) then
2590 if (i .gt. nnt+2) then
2591 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2593 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2594 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2596 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2597 c & EE(1,2,iti),EE(2,2,iti)
2598 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2599 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2600 c write(iout,*) "Macierz EUG",
2601 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2603 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2605 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2606 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2607 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2608 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2609 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2620 DtUg2(l,k,i-2)=0.0d0
2624 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2625 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2627 muder(k,i-2)=Ub2der(k,i-2)
2629 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2630 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2631 if (itype(i-1).le.ntyp) then
2632 iti1 = itortyp(itype(i-1))
2640 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2642 c write (iout,*) 'mu ',mu(:,i-2),i-2
2643 cd write (iout,*) 'mu1',mu1(:,i-2)
2644 cd write (iout,*) 'mu2',mu2(:,i-2)
2645 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2647 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2648 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2649 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2650 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2651 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2652 C Vectors and matrices dependent on a single virtual-bond dihedral.
2653 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2654 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2655 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2656 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2657 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2658 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2659 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2660 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2661 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2664 C Matrices dependent on two consecutive virtual-bond dihedrals.
2665 C The order of matrices is from left to right.
2666 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2668 c do i=max0(ivec_start,2),ivec_end
2670 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2671 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2672 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2673 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2674 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2675 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2676 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2677 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2680 #if defined(MPI) && defined(PARMAT)
2682 c if (fg_rank.eq.0) then
2683 write (iout,*) "Arrays UG and UGDER before GATHER"
2685 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2686 & ((ug(l,k,i),l=1,2),k=1,2),
2687 & ((ugder(l,k,i),l=1,2),k=1,2)
2689 write (iout,*) "Arrays UG2 and UG2DER"
2691 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2692 & ((ug2(l,k,i),l=1,2),k=1,2),
2693 & ((ug2der(l,k,i),l=1,2),k=1,2)
2695 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2697 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2698 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2699 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2701 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2703 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2704 & costab(i),sintab(i),costab2(i),sintab2(i)
2706 write (iout,*) "Array MUDER"
2708 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2712 if (nfgtasks.gt.1) then
2714 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2715 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2716 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2718 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2719 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2721 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2722 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2724 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2725 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2727 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2728 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2730 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2731 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2733 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2734 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2736 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2737 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2738 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2739 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2740 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2741 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2742 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2743 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2744 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2745 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2746 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2747 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2748 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2750 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2751 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2753 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2754 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2756 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2757 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2759 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2760 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2762 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2763 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2765 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2766 & ivec_count(fg_rank1),
2767 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2769 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2770 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2772 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2773 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2775 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2776 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2778 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2779 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2781 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2782 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2784 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2785 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2787 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2788 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2790 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2791 & ivec_count(fg_rank1),
2792 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2794 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2795 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2797 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2798 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2800 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2801 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2803 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2804 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2806 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2807 & ivec_count(fg_rank1),
2808 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2810 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2811 & ivec_count(fg_rank1),
2812 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2814 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2815 & ivec_count(fg_rank1),
2816 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2817 & MPI_MAT2,FG_COMM1,IERR)
2818 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2819 & ivec_count(fg_rank1),
2820 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2821 & MPI_MAT2,FG_COMM1,IERR)
2824 c Passes matrix info through the ring
2827 if (irecv.lt.0) irecv=nfgtasks1-1
2830 if (inext.ge.nfgtasks1) inext=0
2832 c write (iout,*) "isend",isend," irecv",irecv
2834 lensend=lentyp(isend)
2835 lenrecv=lentyp(irecv)
2836 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2837 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2838 c & MPI_ROTAT1(lensend),inext,2200+isend,
2839 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2840 c & iprev,2200+irecv,FG_COMM,status,IERR)
2841 c write (iout,*) "Gather ROTAT1"
2843 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2844 c & MPI_ROTAT2(lensend),inext,3300+isend,
2845 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2846 c & iprev,3300+irecv,FG_COMM,status,IERR)
2847 c write (iout,*) "Gather ROTAT2"
2849 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2850 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2851 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2852 & iprev,4400+irecv,FG_COMM,status,IERR)
2853 c write (iout,*) "Gather ROTAT_OLD"
2855 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2856 & MPI_PRECOMP11(lensend),inext,5500+isend,
2857 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2858 & iprev,5500+irecv,FG_COMM,status,IERR)
2859 c write (iout,*) "Gather PRECOMP11"
2861 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2862 & MPI_PRECOMP12(lensend),inext,6600+isend,
2863 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2864 & iprev,6600+irecv,FG_COMM,status,IERR)
2865 c write (iout,*) "Gather PRECOMP12"
2867 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2869 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2870 & MPI_ROTAT2(lensend),inext,7700+isend,
2871 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2872 & iprev,7700+irecv,FG_COMM,status,IERR)
2873 c write (iout,*) "Gather PRECOMP21"
2875 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2876 & MPI_PRECOMP22(lensend),inext,8800+isend,
2877 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2878 & iprev,8800+irecv,FG_COMM,status,IERR)
2879 c write (iout,*) "Gather PRECOMP22"
2881 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2882 & MPI_PRECOMP23(lensend),inext,9900+isend,
2883 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2884 & MPI_PRECOMP23(lenrecv),
2885 & iprev,9900+irecv,FG_COMM,status,IERR)
2886 c write (iout,*) "Gather PRECOMP23"
2891 if (irecv.lt.0) irecv=nfgtasks1-1
2894 time_gather=time_gather+MPI_Wtime()-time00
2897 c if (fg_rank.eq.0) then
2898 write (iout,*) "Arrays UG and UGDER"
2900 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2901 & ((ug(l,k,i),l=1,2),k=1,2),
2902 & ((ugder(l,k,i),l=1,2),k=1,2)
2904 write (iout,*) "Arrays UG2 and UG2DER"
2906 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2907 & ((ug2(l,k,i),l=1,2),k=1,2),
2908 & ((ug2der(l,k,i),l=1,2),k=1,2)
2910 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2912 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2913 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2914 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2916 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2918 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2919 & costab(i),sintab(i),costab2(i),sintab2(i)
2921 write (iout,*) "Array MUDER"
2923 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2929 cd iti = itortyp(itype(i))
2932 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2933 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2938 C--------------------------------------------------------------------------
2939 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2941 C This subroutine calculates the average interaction energy and its gradient
2942 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2943 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2944 C The potential depends both on the distance of peptide-group centers and on
2945 C the orientation of the CA-CA virtual bonds.
2947 implicit real*8 (a-h,o-z)
2951 include 'DIMENSIONS'
2952 include 'COMMON.CONTROL'
2953 include 'COMMON.SETUP'
2954 include 'COMMON.IOUNITS'
2955 include 'COMMON.GEO'
2956 include 'COMMON.VAR'
2957 include 'COMMON.LOCAL'
2958 include 'COMMON.CHAIN'
2959 include 'COMMON.DERIV'
2960 include 'COMMON.INTERACT'
2961 include 'COMMON.CONTACTS'
2962 include 'COMMON.TORSION'
2963 include 'COMMON.VECTORS'
2964 include 'COMMON.FFIELD'
2965 include 'COMMON.TIME1'
2966 include 'COMMON.SPLITELE'
2967 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2968 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2969 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2970 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2971 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2972 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2974 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2976 double precision scal_el /1.0d0/
2978 double precision scal_el /0.5d0/
2981 C 13-go grudnia roku pamietnego...
2982 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2983 & 0.0d0,1.0d0,0.0d0,
2984 & 0.0d0,0.0d0,1.0d0/
2985 cd write(iout,*) 'In EELEC'
2987 cd write(iout,*) 'Type',i
2988 cd write(iout,*) 'B1',B1(:,i)
2989 cd write(iout,*) 'B2',B2(:,i)
2990 cd write(iout,*) 'CC',CC(:,:,i)
2991 cd write(iout,*) 'DD',DD(:,:,i)
2992 cd write(iout,*) 'EE',EE(:,:,i)
2994 cd call check_vecgrad
2996 if (icheckgrad.eq.1) then
2998 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3000 dc_norm(k,i)=dc(k,i)*fac
3002 c write (iout,*) 'i',i,' fac',fac
3005 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3006 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3007 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3008 c call vec_and_deriv
3014 time_mat=time_mat+MPI_Wtime()-time01
3018 cd write (iout,*) 'i=',i
3020 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3023 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3024 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3037 cd print '(a)','Enter EELEC'
3038 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3040 gel_loc_loc(i)=0.0d0
3045 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3047 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3049 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3050 do i=iturn3_start,iturn3_end
3051 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3052 & .or. itype(i+2).eq.ntyp1
3053 & .or. itype(i+3).eq.ntyp1
3054 & .or. itype(i-1).eq.ntyp1
3055 & .or. itype(i+4).eq.ntyp1
3060 dx_normi=dc_norm(1,i)
3061 dy_normi=dc_norm(2,i)
3062 dz_normi=dc_norm(3,i)
3063 xmedi=c(1,i)+0.5d0*dxi
3064 ymedi=c(2,i)+0.5d0*dyi
3065 zmedi=c(3,i)+0.5d0*dzi
3066 xmedi=mod(xmedi,boxxsize)
3067 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3068 ymedi=mod(ymedi,boxysize)
3069 if (ymedi.lt.0) ymedi=ymedi+boxysize
3070 zmedi=mod(zmedi,boxzsize)
3071 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3073 call eelecij(i,i+2,ees,evdw1,eel_loc)
3074 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3075 num_cont_hb(i)=num_conti
3077 do i=iturn4_start,iturn4_end
3078 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3079 & .or. itype(i+3).eq.ntyp1
3080 & .or. itype(i+4).eq.ntyp1
3081 & .or. itype(i+5).eq.ntyp1
3082 & .or. itype(i).eq.ntyp1
3083 & .or. itype(i-1).eq.ntyp1
3088 dx_normi=dc_norm(1,i)
3089 dy_normi=dc_norm(2,i)
3090 dz_normi=dc_norm(3,i)
3091 xmedi=c(1,i)+0.5d0*dxi
3092 ymedi=c(2,i)+0.5d0*dyi
3093 zmedi=c(3,i)+0.5d0*dzi
3094 C Return atom into box, boxxsize is size of box in x dimension
3096 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3097 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3098 C Condition for being inside the proper box
3099 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3100 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3104 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3105 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3106 C Condition for being inside the proper box
3107 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3108 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3112 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3113 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3114 C Condition for being inside the proper box
3115 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3116 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3119 xmedi=mod(xmedi,boxxsize)
3120 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3121 ymedi=mod(ymedi,boxysize)
3122 if (ymedi.lt.0) ymedi=ymedi+boxysize
3123 zmedi=mod(zmedi,boxzsize)
3124 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3126 num_conti=num_cont_hb(i)
3127 c write(iout,*) "JESTEM W PETLI"
3128 call eelecij(i,i+3,ees,evdw1,eel_loc)
3129 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3130 & call eturn4(i,eello_turn4)
3131 num_cont_hb(i)=num_conti
3133 C Loop over all neighbouring boxes
3138 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3140 do i=iatel_s,iatel_e
3141 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3142 & .or. itype(i+2).eq.ntyp1
3143 & .or. itype(i-1).eq.ntyp1
3148 dx_normi=dc_norm(1,i)
3149 dy_normi=dc_norm(2,i)
3150 dz_normi=dc_norm(3,i)
3151 xmedi=c(1,i)+0.5d0*dxi
3152 ymedi=c(2,i)+0.5d0*dyi
3153 zmedi=c(3,i)+0.5d0*dzi
3154 xmedi=mod(xmedi,boxxsize)
3155 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3156 ymedi=mod(ymedi,boxysize)
3157 if (ymedi.lt.0) ymedi=ymedi+boxysize
3158 zmedi=mod(zmedi,boxzsize)
3159 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3160 C xmedi=xmedi+xshift*boxxsize
3161 C ymedi=ymedi+yshift*boxysize
3162 C zmedi=zmedi+zshift*boxzsize
3164 C Return tom into box, boxxsize is size of box in x dimension
3166 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3167 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3168 C Condition for being inside the proper box
3169 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3170 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3174 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3175 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3176 C Condition for being inside the proper box
3177 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3178 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3182 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3183 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3184 cC Condition for being inside the proper box
3185 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3186 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3190 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3191 num_conti=num_cont_hb(i)
3192 do j=ielstart(i),ielend(i)
3193 c write (iout,*) i,j,itype(i),itype(j)
3194 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3195 & .or.itype(j+2).eq.ntyp1
3196 & .or.itype(j-1).eq.ntyp1
3198 call eelecij(i,j,ees,evdw1,eel_loc)
3200 num_cont_hb(i)=num_conti
3206 c write (iout,*) "Number of loop steps in EELEC:",ind
3208 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3209 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3211 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3212 ccc eel_loc=eel_loc+eello_turn3
3213 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3216 C-------------------------------------------------------------------------------
3217 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3218 implicit real*8 (a-h,o-z)
3219 include 'DIMENSIONS'
3223 include 'COMMON.CONTROL'
3224 include 'COMMON.IOUNITS'
3225 include 'COMMON.GEO'
3226 include 'COMMON.VAR'
3227 include 'COMMON.LOCAL'
3228 include 'COMMON.CHAIN'
3229 include 'COMMON.DERIV'
3230 include 'COMMON.INTERACT'
3231 include 'COMMON.CONTACTS'
3232 include 'COMMON.TORSION'
3233 include 'COMMON.VECTORS'
3234 include 'COMMON.FFIELD'
3235 include 'COMMON.TIME1'
3236 include 'COMMON.SPLITELE'
3237 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3238 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3239 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3240 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3241 & gmuij2(4),gmuji2(4)
3242 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3243 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3245 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3247 double precision scal_el /1.0d0/
3249 double precision scal_el /0.5d0/
3252 C 13-go grudnia roku pamietnego...
3253 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3254 & 0.0d0,1.0d0,0.0d0,
3255 & 0.0d0,0.0d0,1.0d0/
3256 c time00=MPI_Wtime()
3257 cd write (iout,*) "eelecij",i,j
3261 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3262 aaa=app(iteli,itelj)
3263 bbb=bpp(iteli,itelj)
3264 ael6i=ael6(iteli,itelj)
3265 ael3i=ael3(iteli,itelj)
3269 dx_normj=dc_norm(1,j)
3270 dy_normj=dc_norm(2,j)
3271 dz_normj=dc_norm(3,j)
3272 C xj=c(1,j)+0.5D0*dxj-xmedi
3273 C yj=c(2,j)+0.5D0*dyj-ymedi
3274 C zj=c(3,j)+0.5D0*dzj-zmedi
3279 if (xj.lt.0) xj=xj+boxxsize
3281 if (yj.lt.0) yj=yj+boxysize
3283 if (zj.lt.0) zj=zj+boxzsize
3284 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3285 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3293 xj=xj_safe+xshift*boxxsize
3294 yj=yj_safe+yshift*boxysize
3295 zj=zj_safe+zshift*boxzsize
3296 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3297 if(dist_temp.lt.dist_init) then
3307 if (isubchap.eq.1) then
3316 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3318 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3319 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3320 C Condition for being inside the proper box
3321 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3322 c & (xj.lt.((-0.5d0)*boxxsize))) then
3326 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3327 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3328 C Condition for being inside the proper box
3329 c if ((yj.gt.((0.5d0)*boxysize)).or.
3330 c & (yj.lt.((-0.5d0)*boxysize))) then
3334 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3335 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3336 C Condition for being inside the proper box
3337 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3338 c & (zj.lt.((-0.5d0)*boxzsize))) then
3341 C endif !endPBC condintion
3345 rij=xj*xj+yj*yj+zj*zj
3347 sss=sscale(sqrt(rij))
3348 sssgrad=sscagrad(sqrt(rij))
3349 c if (sss.gt.0.0d0) then
3355 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3356 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3357 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3358 fac=cosa-3.0D0*cosb*cosg
3360 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3361 if (j.eq.i+2) ev1=scal_el*ev1
3366 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3370 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3371 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3373 evdw1=evdw1+evdwij*sss
3374 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3375 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3376 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3377 cd & xmedi,ymedi,zmedi,xj,yj,zj
3379 if (energy_dec) then
3380 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3382 &,iteli,itelj,aaa,evdw1
3383 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3387 C Calculate contributions to the Cartesian gradient.
3390 facvdw=-6*rrmij*(ev1+evdwij)*sss
3391 facel=-3*rrmij*(el1+eesij)
3397 * Radial derivatives. First process both termini of the fragment (i,j)
3403 c ghalf=0.5D0*ggg(k)
3404 c gelc(k,i)=gelc(k,i)+ghalf
3405 c gelc(k,j)=gelc(k,j)+ghalf
3407 c 9/28/08 AL Gradient compotents will be summed only at the end
3409 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3410 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3413 * Loop over residues i+1 thru j-1.
3417 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3420 if (sss.gt.0.0) then
3421 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3422 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3423 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3430 c ghalf=0.5D0*ggg(k)
3431 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3432 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3434 c 9/28/08 AL Gradient compotents will be summed only at the end
3436 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3437 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3440 * Loop over residues i+1 thru j-1.
3444 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3449 facvdw=(ev1+evdwij)*sss
3452 fac=-3*rrmij*(facvdw+facvdw+facel)
3457 * Radial derivatives. First process both termini of the fragment (i,j)
3463 c ghalf=0.5D0*ggg(k)
3464 c gelc(k,i)=gelc(k,i)+ghalf
3465 c gelc(k,j)=gelc(k,j)+ghalf
3467 c 9/28/08 AL Gradient compotents will be summed only at the end
3469 gelc_long(k,j)=gelc(k,j)+ggg(k)
3470 gelc_long(k,i)=gelc(k,i)-ggg(k)
3473 * Loop over residues i+1 thru j-1.
3477 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3480 c 9/28/08 AL Gradient compotents will be summed only at the end
3481 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3482 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3483 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3485 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3486 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3492 ecosa=2.0D0*fac3*fac1+fac4
3495 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3496 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3498 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3499 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3501 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3502 cd & (dcosg(k),k=1,3)
3504 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3507 c ghalf=0.5D0*ggg(k)
3508 c gelc(k,i)=gelc(k,i)+ghalf
3509 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3510 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3511 c gelc(k,j)=gelc(k,j)+ghalf
3512 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3513 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3517 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3522 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3523 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3525 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3526 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3527 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3528 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3532 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3533 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3534 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3536 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3537 C energy of a peptide unit is assumed in the form of a second-order
3538 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3539 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3540 C are computed for EVERY pair of non-contiguous peptide groups.
3543 if (j.lt.nres-1) then
3555 muij(kkk)=mu(k,i)*mu(l,j)
3556 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3558 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3559 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3560 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3561 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3562 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3563 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3567 cd write (iout,*) 'EELEC: i',i,' j',j
3568 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3569 cd write(iout,*) 'muij',muij
3570 ury=scalar(uy(1,i),erij)
3571 urz=scalar(uz(1,i),erij)
3572 vry=scalar(uy(1,j),erij)
3573 vrz=scalar(uz(1,j),erij)
3574 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3575 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3576 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3577 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3578 fac=dsqrt(-ael6i)*r3ij
3583 cd write (iout,'(4i5,4f10.5)')
3584 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3585 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3586 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3587 cd & uy(:,j),uz(:,j)
3588 cd write (iout,'(4f10.5)')
3589 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3590 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3591 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3592 cd write (iout,'(9f10.5/)')
3593 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3594 C Derivatives of the elements of A in virtual-bond vectors
3595 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3597 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3598 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3599 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3600 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3601 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3602 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3603 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3604 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3605 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3606 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3607 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3608 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3610 C Compute radial contributions to the gradient
3628 C Add the contributions coming from er
3631 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3632 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3633 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3634 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3637 C Derivatives in DC(i)
3638 cgrad ghalf1=0.5d0*agg(k,1)
3639 cgrad ghalf2=0.5d0*agg(k,2)
3640 cgrad ghalf3=0.5d0*agg(k,3)
3641 cgrad ghalf4=0.5d0*agg(k,4)
3642 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3643 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3644 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3645 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3646 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3647 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3648 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3649 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3650 C Derivatives in DC(i+1)
3651 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3652 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3653 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3654 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3655 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3656 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3657 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3658 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3659 C Derivatives in DC(j)
3660 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3661 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3662 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3663 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3664 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3665 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3666 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3667 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3668 C Derivatives in DC(j+1) or DC(nres-1)
3669 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3670 & -3.0d0*vryg(k,3)*ury)
3671 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3672 & -3.0d0*vrzg(k,3)*ury)
3673 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3674 & -3.0d0*vryg(k,3)*urz)
3675 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3676 & -3.0d0*vrzg(k,3)*urz)
3677 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3679 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3692 aggi(k,l)=-aggi(k,l)
3693 aggi1(k,l)=-aggi1(k,l)
3694 aggj(k,l)=-aggj(k,l)
3695 aggj1(k,l)=-aggj1(k,l)
3698 if (j.lt.nres-1) then
3704 aggi(k,l)=-aggi(k,l)
3705 aggi1(k,l)=-aggi1(k,l)
3706 aggj(k,l)=-aggj(k,l)
3707 aggj1(k,l)=-aggj1(k,l)
3718 aggi(k,l)=-aggi(k,l)
3719 aggi1(k,l)=-aggi1(k,l)
3720 aggj(k,l)=-aggj(k,l)
3721 aggj1(k,l)=-aggj1(k,l)
3726 IF (wel_loc.gt.0.0d0) THEN
3727 C Contribution to the local-electrostatic energy coming from the i-j pair
3728 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3730 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3731 c & ' eel_loc_ij',eel_loc_ij
3732 c write(iout,*) 'muije=',muij(1),muij(2),muij(3),muij(4)
3733 C Calculate patrial derivative for theta angle
3735 geel_loc_ij=a22*gmuij1(1)
3739 c write(iout,*) "derivative over thatai"
3740 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3742 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3743 & geel_loc_ij*wel_loc
3744 c write(iout,*) "derivative over thatai-1"
3745 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3752 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3753 & geel_loc_ij*wel_loc
3754 c Derivative over j residue
3755 geel_loc_ji=a22*gmuji1(1)
3759 c write(iout,*) "derivative over thataj"
3760 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3763 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3764 & geel_loc_ji*wel_loc
3770 c write(iout,*) "derivative over thataj-1"
3771 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3773 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3774 & geel_loc_ji*wel_loc
3776 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3778 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3779 & 'eelloc',i,j,eel_loc_ij
3780 c if (eel_loc_ij.ne.0)
3781 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3782 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3784 eel_loc=eel_loc+eel_loc_ij
3785 C Partial derivatives in virtual-bond dihedral angles gamma
3787 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3788 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3789 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3790 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3791 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3792 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3793 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3795 ggg(l)=agg(l,1)*muij(1)+
3796 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3797 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3798 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3799 cgrad ghalf=0.5d0*ggg(l)
3800 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3801 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3805 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3808 C Remaining derivatives of eello
3810 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3811 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3812 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3813 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3814 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3815 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3816 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3817 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3820 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3821 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3822 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3823 & .and. num_conti.le.maxconts) then
3824 c write (iout,*) i,j," entered corr"
3826 C Calculate the contact function. The ith column of the array JCONT will
3827 C contain the numbers of atoms that make contacts with the atom I (of numbers
3828 C greater than I). The arrays FACONT and GACONT will contain the values of
3829 C the contact function and its derivative.
3830 c r0ij=1.02D0*rpp(iteli,itelj)
3831 c r0ij=1.11D0*rpp(iteli,itelj)
3832 r0ij=2.20D0*rpp(iteli,itelj)
3833 c r0ij=1.55D0*rpp(iteli,itelj)
3834 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3835 if (fcont.gt.0.0D0) then
3836 num_conti=num_conti+1
3837 if (num_conti.gt.maxconts) then
3838 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3839 & ' will skip next contacts for this conf.'
3841 jcont_hb(num_conti,i)=j
3842 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3843 cd & " jcont_hb",jcont_hb(num_conti,i)
3844 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3845 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3846 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3848 d_cont(num_conti,i)=rij
3849 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3850 C --- Electrostatic-interaction matrix ---
3851 a_chuj(1,1,num_conti,i)=a22
3852 a_chuj(1,2,num_conti,i)=a23
3853 a_chuj(2,1,num_conti,i)=a32
3854 a_chuj(2,2,num_conti,i)=a33
3855 C --- Gradient of rij
3857 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3864 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3865 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3866 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3867 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3868 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3873 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3874 C Calculate contact energies
3876 wij=cosa-3.0D0*cosb*cosg
3879 c fac3=dsqrt(-ael6i)/r0ij**3
3880 fac3=dsqrt(-ael6i)*r3ij
3881 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3882 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3883 if (ees0tmp.gt.0) then
3884 ees0pij=dsqrt(ees0tmp)
3888 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3889 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3890 if (ees0tmp.gt.0) then
3891 ees0mij=dsqrt(ees0tmp)
3896 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3897 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3898 C Diagnostics. Comment out or remove after debugging!
3899 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3900 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3901 c ees0m(num_conti,i)=0.0D0
3903 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3904 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3905 C Angular derivatives of the contact function
3906 ees0pij1=fac3/ees0pij
3907 ees0mij1=fac3/ees0mij
3908 fac3p=-3.0D0*fac3*rrmij
3909 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3910 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3912 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3913 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3914 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3915 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3916 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3917 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3918 ecosap=ecosa1+ecosa2
3919 ecosbp=ecosb1+ecosb2
3920 ecosgp=ecosg1+ecosg2
3921 ecosam=ecosa1-ecosa2
3922 ecosbm=ecosb1-ecosb2
3923 ecosgm=ecosg1-ecosg2
3932 facont_hb(num_conti,i)=fcont
3933 fprimcont=fprimcont/rij
3934 cd facont_hb(num_conti,i)=1.0D0
3935 C Following line is for diagnostics.
3938 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3939 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3942 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3943 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3945 gggp(1)=gggp(1)+ees0pijp*xj
3946 gggp(2)=gggp(2)+ees0pijp*yj
3947 gggp(3)=gggp(3)+ees0pijp*zj
3948 gggm(1)=gggm(1)+ees0mijp*xj
3949 gggm(2)=gggm(2)+ees0mijp*yj
3950 gggm(3)=gggm(3)+ees0mijp*zj
3951 C Derivatives due to the contact function
3952 gacont_hbr(1,num_conti,i)=fprimcont*xj
3953 gacont_hbr(2,num_conti,i)=fprimcont*yj
3954 gacont_hbr(3,num_conti,i)=fprimcont*zj
3957 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3958 c following the change of gradient-summation algorithm.
3960 cgrad ghalfp=0.5D0*gggp(k)
3961 cgrad ghalfm=0.5D0*gggm(k)
3962 gacontp_hb1(k,num_conti,i)=!ghalfp
3963 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3964 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3965 gacontp_hb2(k,num_conti,i)=!ghalfp
3966 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3967 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3968 gacontp_hb3(k,num_conti,i)=gggp(k)
3969 gacontm_hb1(k,num_conti,i)=!ghalfm
3970 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3971 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3972 gacontm_hb2(k,num_conti,i)=!ghalfm
3973 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3974 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3975 gacontm_hb3(k,num_conti,i)=gggm(k)
3977 C Diagnostics. Comment out or remove after debugging!
3979 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3980 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3981 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3982 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3983 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3984 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3987 endif ! num_conti.le.maxconts
3990 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3993 ghalf=0.5d0*agg(l,k)
3994 aggi(l,k)=aggi(l,k)+ghalf
3995 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3996 aggj(l,k)=aggj(l,k)+ghalf
3999 if (j.eq.nres-1 .and. i.lt.j-2) then
4002 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4007 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4010 C-----------------------------------------------------------------------------
4011 subroutine eturn3(i,eello_turn3)
4012 C Third- and fourth-order contributions from turns
4013 implicit real*8 (a-h,o-z)
4014 include 'DIMENSIONS'
4015 include 'COMMON.IOUNITS'
4016 include 'COMMON.GEO'
4017 include 'COMMON.VAR'
4018 include 'COMMON.LOCAL'
4019 include 'COMMON.CHAIN'
4020 include 'COMMON.DERIV'
4021 include 'COMMON.INTERACT'
4022 include 'COMMON.CONTACTS'
4023 include 'COMMON.TORSION'
4024 include 'COMMON.VECTORS'
4025 include 'COMMON.FFIELD'
4026 include 'COMMON.CONTROL'
4028 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4029 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4030 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4031 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4032 & auxgmat2(2,2),auxgmatt2(2,2)
4033 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4034 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4035 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4036 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4039 c write (iout,*) "eturn3",i,j,j1,j2
4044 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4046 C Third-order contributions
4053 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4054 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4055 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4056 c auxalary matices for theta gradient
4057 c auxalary matrix for i+1 and constant i+2
4058 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4059 c auxalary matrix for i+2 and constant i+1
4060 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4061 call transpose2(auxmat(1,1),auxmat1(1,1))
4062 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4063 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4064 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4065 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4066 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4067 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4068 C Derivatives in theta
4069 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4070 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4071 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4072 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4074 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4075 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4076 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4077 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4078 cd & ' eello_turn3_num',4*eello_turn3_num
4079 C Derivatives in gamma(i)
4080 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4081 call transpose2(auxmat2(1,1),auxmat3(1,1))
4082 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4083 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4084 C Derivatives in gamma(i+1)
4085 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4086 call transpose2(auxmat2(1,1),auxmat3(1,1))
4087 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4088 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4089 & +0.5d0*(pizda(1,1)+pizda(2,2))
4090 C Cartesian derivatives
4092 c ghalf1=0.5d0*agg(l,1)
4093 c ghalf2=0.5d0*agg(l,2)
4094 c ghalf3=0.5d0*agg(l,3)
4095 c ghalf4=0.5d0*agg(l,4)
4096 a_temp(1,1)=aggi(l,1)!+ghalf1
4097 a_temp(1,2)=aggi(l,2)!+ghalf2
4098 a_temp(2,1)=aggi(l,3)!+ghalf3
4099 a_temp(2,2)=aggi(l,4)!+ghalf4
4100 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4101 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4102 & +0.5d0*(pizda(1,1)+pizda(2,2))
4103 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4104 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4105 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4106 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4107 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4108 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4109 & +0.5d0*(pizda(1,1)+pizda(2,2))
4110 a_temp(1,1)=aggj(l,1)!+ghalf1
4111 a_temp(1,2)=aggj(l,2)!+ghalf2
4112 a_temp(2,1)=aggj(l,3)!+ghalf3
4113 a_temp(2,2)=aggj(l,4)!+ghalf4
4114 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4115 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4116 & +0.5d0*(pizda(1,1)+pizda(2,2))
4117 a_temp(1,1)=aggj1(l,1)
4118 a_temp(1,2)=aggj1(l,2)
4119 a_temp(2,1)=aggj1(l,3)
4120 a_temp(2,2)=aggj1(l,4)
4121 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4122 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4123 & +0.5d0*(pizda(1,1)+pizda(2,2))
4127 C-------------------------------------------------------------------------------
4128 subroutine eturn4(i,eello_turn4)
4129 C Third- and fourth-order contributions from turns
4130 implicit real*8 (a-h,o-z)
4131 include 'DIMENSIONS'
4132 include 'COMMON.IOUNITS'
4133 include 'COMMON.GEO'
4134 include 'COMMON.VAR'
4135 include 'COMMON.LOCAL'
4136 include 'COMMON.CHAIN'
4137 include 'COMMON.DERIV'
4138 include 'COMMON.INTERACT'
4139 include 'COMMON.CONTACTS'
4140 include 'COMMON.TORSION'
4141 include 'COMMON.VECTORS'
4142 include 'COMMON.FFIELD'
4143 include 'COMMON.CONTROL'
4145 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4146 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4147 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4148 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4149 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4150 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4151 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4152 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4153 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4154 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4155 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4158 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4160 C Fourth-order contributions
4168 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4169 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4170 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4171 c write(iout,*)"WCHODZE W PROGRAM"
4176 iti1=itortyp(itype(i+1))
4177 iti2=itortyp(itype(i+2))
4178 iti3=itortyp(itype(i+3))
4179 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4180 call transpose2(EUg(1,1,i+1),e1t(1,1))
4181 call transpose2(Eug(1,1,i+2),e2t(1,1))
4182 call transpose2(Eug(1,1,i+3),e3t(1,1))
4183 C Ematrix derivative in theta
4184 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4185 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4186 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4187 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4188 c eta1 in derivative theta
4189 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4190 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4191 c auxgvec is derivative of Ub2 so i+3 theta
4192 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4193 c auxalary matrix of E i+1
4194 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4197 s1=scalar2(b1(1,i+2),auxvec(1))
4198 c derivative of theta i+2 with constant i+3
4199 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4200 c derivative of theta i+2 with constant i+2
4201 gs32=scalar2(b1(1,i+2),auxgvec(1))
4202 c derivative of E matix in theta of i+1
4203 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4205 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4206 c ea31 in derivative theta
4207 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4208 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4209 c auxilary matrix auxgvec of Ub2 with constant E matirx
4210 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4211 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4212 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4216 s2=scalar2(b1(1,i+1),auxvec(1))
4217 c derivative of theta i+1 with constant i+3
4218 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4219 c derivative of theta i+2 with constant i+1
4220 gs21=scalar2(b1(1,i+1),auxgvec(1))
4221 c derivative of theta i+3 with constant i+1
4222 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4223 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4225 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4226 c two derivatives over diffetent matrices
4227 c gtae3e2 is derivative over i+3
4228 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4229 c ae3gte2 is derivative over i+2
4230 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4231 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4232 c three possible derivative over theta E matices
4234 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4236 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4238 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4239 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4241 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4242 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4243 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4245 eello_turn4=eello_turn4-(s1+s2+s3)
4246 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4247 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4248 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4249 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4250 cd & ' eello_turn4_num',8*eello_turn4_num
4252 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4253 & -(gs13+gsE13+gsEE1)*wturn4
4254 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4255 & -(gs23+gs21+gsEE2)*wturn4
4256 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4257 & -(gs32+gsE31+gsEE3)*wturn4
4258 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4261 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4262 & 'eturn4',i,j,-(s1+s2+s3)
4263 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4264 c & ' eello_turn4_num',8*eello_turn4_num
4265 C Derivatives in gamma(i)
4266 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4267 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4268 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4269 s1=scalar2(b1(1,i+2),auxvec(1))
4270 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4271 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4272 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4273 C Derivatives in gamma(i+1)
4274 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4275 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4276 s2=scalar2(b1(1,i+1),auxvec(1))
4277 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4278 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4279 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4280 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4281 C Derivatives in gamma(i+2)
4282 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4283 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4284 s1=scalar2(b1(1,i+2),auxvec(1))
4285 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4286 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4287 s2=scalar2(b1(1,i+1),auxvec(1))
4288 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4289 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4290 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4291 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4292 C Cartesian derivatives
4293 C Derivatives of this turn contributions in DC(i+2)
4294 if (j.lt.nres-1) then
4296 a_temp(1,1)=agg(l,1)
4297 a_temp(1,2)=agg(l,2)
4298 a_temp(2,1)=agg(l,3)
4299 a_temp(2,2)=agg(l,4)
4300 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4301 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4302 s1=scalar2(b1(1,i+2),auxvec(1))
4303 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4304 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4305 s2=scalar2(b1(1,i+1),auxvec(1))
4306 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4307 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4308 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4310 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4313 C Remaining derivatives of this turn contribution
4315 a_temp(1,1)=aggi(l,1)
4316 a_temp(1,2)=aggi(l,2)
4317 a_temp(2,1)=aggi(l,3)
4318 a_temp(2,2)=aggi(l,4)
4319 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4320 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4321 s1=scalar2(b1(1,i+2),auxvec(1))
4322 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4323 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4324 s2=scalar2(b1(1,i+1),auxvec(1))
4325 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4326 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4327 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4328 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4329 a_temp(1,1)=aggi1(l,1)
4330 a_temp(1,2)=aggi1(l,2)
4331 a_temp(2,1)=aggi1(l,3)
4332 a_temp(2,2)=aggi1(l,4)
4333 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4334 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4335 s1=scalar2(b1(1,i+2),auxvec(1))
4336 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4337 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4338 s2=scalar2(b1(1,i+1),auxvec(1))
4339 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4340 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4341 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4342 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4343 a_temp(1,1)=aggj(l,1)
4344 a_temp(1,2)=aggj(l,2)
4345 a_temp(2,1)=aggj(l,3)
4346 a_temp(2,2)=aggj(l,4)
4347 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4348 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4349 s1=scalar2(b1(1,i+2),auxvec(1))
4350 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4351 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4352 s2=scalar2(b1(1,i+1),auxvec(1))
4353 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4354 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4355 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4356 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4357 a_temp(1,1)=aggj1(l,1)
4358 a_temp(1,2)=aggj1(l,2)
4359 a_temp(2,1)=aggj1(l,3)
4360 a_temp(2,2)=aggj1(l,4)
4361 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4362 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4363 s1=scalar2(b1(1,i+2),auxvec(1))
4364 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4365 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4366 s2=scalar2(b1(1,i+1),auxvec(1))
4367 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4368 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4369 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4370 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4371 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4375 C-----------------------------------------------------------------------------
4376 subroutine vecpr(u,v,w)
4377 implicit real*8(a-h,o-z)
4378 dimension u(3),v(3),w(3)
4379 w(1)=u(2)*v(3)-u(3)*v(2)
4380 w(2)=-u(1)*v(3)+u(3)*v(1)
4381 w(3)=u(1)*v(2)-u(2)*v(1)
4384 C-----------------------------------------------------------------------------
4385 subroutine unormderiv(u,ugrad,unorm,ungrad)
4386 C This subroutine computes the derivatives of a normalized vector u, given
4387 C the derivatives computed without normalization conditions, ugrad. Returns
4390 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4391 double precision vec(3)
4392 double precision scalar
4394 c write (2,*) 'ugrad',ugrad
4397 vec(i)=scalar(ugrad(1,i),u(1))
4399 c write (2,*) 'vec',vec
4402 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4405 c write (2,*) 'ungrad',ungrad
4408 C-----------------------------------------------------------------------------
4409 subroutine escp_soft_sphere(evdw2,evdw2_14)
4411 C This subroutine calculates the excluded-volume interaction energy between
4412 C peptide-group centers and side chains and its gradient in virtual-bond and
4413 C side-chain vectors.
4415 implicit real*8 (a-h,o-z)
4416 include 'DIMENSIONS'
4417 include 'COMMON.GEO'
4418 include 'COMMON.VAR'
4419 include 'COMMON.LOCAL'
4420 include 'COMMON.CHAIN'
4421 include 'COMMON.DERIV'
4422 include 'COMMON.INTERACT'
4423 include 'COMMON.FFIELD'
4424 include 'COMMON.IOUNITS'
4425 include 'COMMON.CONTROL'
4430 cd print '(a)','Enter ESCP'
4431 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4435 do i=iatscp_s,iatscp_e
4436 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4438 xi=0.5D0*(c(1,i)+c(1,i+1))
4439 yi=0.5D0*(c(2,i)+c(2,i+1))
4440 zi=0.5D0*(c(3,i)+c(3,i+1))
4441 C Return atom into box, boxxsize is size of box in x dimension
4443 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4444 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4445 C Condition for being inside the proper box
4446 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4447 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4451 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4452 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4453 C Condition for being inside the proper box
4454 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4455 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4459 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4460 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4461 cC Condition for being inside the proper box
4462 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4463 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4467 if (xi.lt.0) xi=xi+boxxsize
4469 if (yi.lt.0) yi=yi+boxysize
4471 if (zi.lt.0) zi=zi+boxzsize
4472 C xi=xi+xshift*boxxsize
4473 C yi=yi+yshift*boxysize
4474 C zi=zi+zshift*boxzsize
4475 do iint=1,nscp_gr(i)
4477 do j=iscpstart(i,iint),iscpend(i,iint)
4478 if (itype(j).eq.ntyp1) cycle
4479 itypj=iabs(itype(j))
4480 C Uncomment following three lines for SC-p interactions
4484 C Uncomment following three lines for Ca-p interactions
4489 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4490 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4491 C Condition for being inside the proper box
4492 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4493 c & (xj.lt.((-0.5d0)*boxxsize))) then
4497 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4498 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4499 cC Condition for being inside the proper box
4500 c if ((yj.gt.((0.5d0)*boxysize)).or.
4501 c & (yj.lt.((-0.5d0)*boxysize))) then
4505 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4506 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4507 C Condition for being inside the proper box
4508 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4509 c & (zj.lt.((-0.5d0)*boxzsize))) then
4512 if (xj.lt.0) xj=xj+boxxsize
4514 if (yj.lt.0) yj=yj+boxysize
4516 if (zj.lt.0) zj=zj+boxzsize
4517 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4525 xj=xj_safe+xshift*boxxsize
4526 yj=yj_safe+yshift*boxysize
4527 zj=zj_safe+zshift*boxzsize
4528 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4529 if(dist_temp.lt.dist_init) then
4539 if (subchap.eq.1) then
4552 rij=xj*xj+yj*yj+zj*zj
4556 if (rij.lt.r0ijsq) then
4557 evdwij=0.25d0*(rij-r0ijsq)**2
4565 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4570 cgrad if (j.lt.i) then
4571 cd write (iout,*) 'j<i'
4572 C Uncomment following three lines for SC-p interactions
4574 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4577 cd write (iout,*) 'j>i'
4579 cgrad ggg(k)=-ggg(k)
4580 C Uncomment following line for SC-p interactions
4581 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4585 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4587 cgrad kstart=min0(i+1,j)
4588 cgrad kend=max0(i-1,j-1)
4589 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4590 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4591 cgrad do k=kstart,kend
4593 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4597 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4598 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4609 C-----------------------------------------------------------------------------
4610 subroutine escp(evdw2,evdw2_14)
4612 C This subroutine calculates the excluded-volume interaction energy between
4613 C peptide-group centers and side chains and its gradient in virtual-bond and
4614 C side-chain vectors.
4616 implicit real*8 (a-h,o-z)
4617 include 'DIMENSIONS'
4618 include 'COMMON.GEO'
4619 include 'COMMON.VAR'
4620 include 'COMMON.LOCAL'
4621 include 'COMMON.CHAIN'
4622 include 'COMMON.DERIV'
4623 include 'COMMON.INTERACT'
4624 include 'COMMON.FFIELD'
4625 include 'COMMON.IOUNITS'
4626 include 'COMMON.CONTROL'
4627 include 'COMMON.SPLITELE'
4631 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4632 cd print '(a)','Enter ESCP'
4633 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4637 do i=iatscp_s,iatscp_e
4638 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4640 xi=0.5D0*(c(1,i)+c(1,i+1))
4641 yi=0.5D0*(c(2,i)+c(2,i+1))
4642 zi=0.5D0*(c(3,i)+c(3,i+1))
4644 if (xi.lt.0) xi=xi+boxxsize
4646 if (yi.lt.0) yi=yi+boxysize
4648 if (zi.lt.0) zi=zi+boxzsize
4649 c xi=xi+xshift*boxxsize
4650 c yi=yi+yshift*boxysize
4651 c zi=zi+zshift*boxzsize
4652 c print *,xi,yi,zi,'polozenie i'
4653 C Return atom into box, boxxsize is size of box in x dimension
4655 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4656 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4657 C Condition for being inside the proper box
4658 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4659 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4663 c print *,xi,boxxsize,"pierwszy"
4665 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4666 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4667 C Condition for being inside the proper box
4668 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4669 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4673 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4674 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4675 C Condition for being inside the proper box
4676 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4677 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4680 do iint=1,nscp_gr(i)
4682 do j=iscpstart(i,iint),iscpend(i,iint)
4683 itypj=iabs(itype(j))
4684 if (itypj.eq.ntyp1) cycle
4685 C Uncomment following three lines for SC-p interactions
4689 C Uncomment following three lines for Ca-p interactions
4694 if (xj.lt.0) xj=xj+boxxsize
4696 if (yj.lt.0) yj=yj+boxysize
4698 if (zj.lt.0) zj=zj+boxzsize
4700 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4701 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4702 C Condition for being inside the proper box
4703 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4704 c & (xj.lt.((-0.5d0)*boxxsize))) then
4708 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4709 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4710 cC Condition for being inside the proper box
4711 c if ((yj.gt.((0.5d0)*boxysize)).or.
4712 c & (yj.lt.((-0.5d0)*boxysize))) then
4716 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4717 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4718 C Condition for being inside the proper box
4719 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4720 c & (zj.lt.((-0.5d0)*boxzsize))) then
4723 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
4724 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4732 xj=xj_safe+xshift*boxxsize
4733 yj=yj_safe+yshift*boxysize
4734 zj=zj_safe+zshift*boxzsize
4735 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4736 if(dist_temp.lt.dist_init) then
4746 if (subchap.eq.1) then
4755 c print *,xj,yj,zj,'polozenie j'
4756 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4758 sss=sscale(1.0d0/(dsqrt(rrij)))
4759 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
4760 c if (sss.eq.0) print *,'czasem jest OK'
4761 if (sss.le.0.0d0) cycle
4762 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4764 e1=fac*fac*aad(itypj,iteli)
4765 e2=fac*bad(itypj,iteli)
4766 if (iabs(j-i) .le. 2) then
4769 evdw2_14=evdw2_14+(e1+e2)*sss
4772 evdw2=evdw2+evdwij*sss
4773 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4774 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4777 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4779 fac=-(evdwij+e1)*rrij*sss
4780 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4784 cgrad if (j.lt.i) then
4785 cd write (iout,*) 'j<i'
4786 C Uncomment following three lines for SC-p interactions
4788 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4791 cd write (iout,*) 'j>i'
4793 cgrad ggg(k)=-ggg(k)
4794 C Uncomment following line for SC-p interactions
4795 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4796 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4800 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4802 cgrad kstart=min0(i+1,j)
4803 cgrad kend=max0(i-1,j-1)
4804 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4805 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4806 cgrad do k=kstart,kend
4808 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4812 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4813 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4815 c endif !endif for sscale cutoff
4825 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4826 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4827 gradx_scp(j,i)=expon*gradx_scp(j,i)
4830 C******************************************************************************
4834 C To save time the factor EXPON has been extracted from ALL components
4835 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4838 C******************************************************************************
4841 C--------------------------------------------------------------------------
4842 subroutine edis(ehpb)
4844 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4846 implicit real*8 (a-h,o-z)
4847 include 'DIMENSIONS'
4848 include 'COMMON.SBRIDGE'
4849 include 'COMMON.CHAIN'
4850 include 'COMMON.DERIV'
4851 include 'COMMON.VAR'
4852 include 'COMMON.INTERACT'
4853 include 'COMMON.IOUNITS'
4856 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4857 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4858 if (link_end.eq.0) return
4859 do i=link_start,link_end
4860 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4861 C CA-CA distance used in regularization of structure.
4864 C iii and jjj point to the residues for which the distance is assigned.
4865 if (ii.gt.nres) then
4872 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4873 c & dhpb(i),dhpb1(i),forcon(i)
4874 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4875 C distance and angle dependent SS bond potential.
4876 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4877 & iabs(itype(jjj)).eq.1) then
4878 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4879 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4880 if (.not.dyn_ss .and. i.le.nss) then
4881 C 15/02/13 CC dynamic SSbond - additional check
4883 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4884 call ssbond_ene(iii,jjj,eij)
4887 cd write (iout,*) "eij",eij
4889 C Calculate the distance between the two points and its difference from the
4893 C Get the force constant corresponding to this distance.
4895 C Calculate the contribution to energy.
4896 ehpb=ehpb+waga*rdis*rdis
4898 C Evaluate gradient.
4901 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4902 cd & ' waga=',waga,' fac=',fac
4904 ggg(j)=fac*(c(j,jj)-c(j,ii))
4906 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4907 C If this is a SC-SC distance, we need to calculate the contributions to the
4908 C Cartesian gradient in the SC vectors (ghpbx).
4911 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4912 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4915 cgrad do j=iii,jjj-1
4917 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4921 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4922 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4929 C--------------------------------------------------------------------------
4930 subroutine ssbond_ene(i,j,eij)
4932 C Calculate the distance and angle dependent SS-bond potential energy
4933 C using a free-energy function derived based on RHF/6-31G** ab initio
4934 C calculations of diethyl disulfide.
4936 C A. Liwo and U. Kozlowska, 11/24/03
4938 implicit real*8 (a-h,o-z)
4939 include 'DIMENSIONS'
4940 include 'COMMON.SBRIDGE'
4941 include 'COMMON.CHAIN'
4942 include 'COMMON.DERIV'
4943 include 'COMMON.LOCAL'
4944 include 'COMMON.INTERACT'
4945 include 'COMMON.VAR'
4946 include 'COMMON.IOUNITS'
4947 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4948 itypi=iabs(itype(i))
4952 dxi=dc_norm(1,nres+i)
4953 dyi=dc_norm(2,nres+i)
4954 dzi=dc_norm(3,nres+i)
4955 c dsci_inv=dsc_inv(itypi)
4956 dsci_inv=vbld_inv(nres+i)
4957 itypj=iabs(itype(j))
4958 c dscj_inv=dsc_inv(itypj)
4959 dscj_inv=vbld_inv(nres+j)
4963 dxj=dc_norm(1,nres+j)
4964 dyj=dc_norm(2,nres+j)
4965 dzj=dc_norm(3,nres+j)
4966 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4971 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4972 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4973 om12=dxi*dxj+dyi*dyj+dzi*dzj
4975 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4976 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4982 deltat12=om2-om1+2.0d0
4984 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4985 & +akct*deltad*deltat12
4986 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4987 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4988 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4989 c & " deltat12",deltat12," eij",eij
4990 ed=2*akcm*deltad+akct*deltat12
4992 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4993 eom1=-2*akth*deltat1-pom1-om2*pom2
4994 eom2= 2*akth*deltat2+pom1-om1*pom2
4997 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4998 ghpbx(k,i)=ghpbx(k,i)-ggk
4999 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5000 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5001 ghpbx(k,j)=ghpbx(k,j)+ggk
5002 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5003 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5004 ghpbc(k,i)=ghpbc(k,i)-ggk
5005 ghpbc(k,j)=ghpbc(k,j)+ggk
5008 C Calculate the components of the gradient in DC and X
5012 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5017 C--------------------------------------------------------------------------
5018 subroutine ebond(estr)
5020 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5022 implicit real*8 (a-h,o-z)
5023 include 'DIMENSIONS'
5024 include 'COMMON.LOCAL'
5025 include 'COMMON.GEO'
5026 include 'COMMON.INTERACT'
5027 include 'COMMON.DERIV'
5028 include 'COMMON.VAR'
5029 include 'COMMON.CHAIN'
5030 include 'COMMON.IOUNITS'
5031 include 'COMMON.NAMES'
5032 include 'COMMON.FFIELD'
5033 include 'COMMON.CONTROL'
5034 include 'COMMON.SETUP'
5035 double precision u(3),ud(3)
5038 do i=ibondp_start,ibondp_end
5039 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5040 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5042 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5043 c & *dc(j,i-1)/vbld(i)
5045 c if (energy_dec) write(iout,*)
5046 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5048 C Checking if it involves dummy (NH3+ or COO-) group
5049 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5050 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5051 diff = vbld(i)-vbldpDUM
5053 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5054 diff = vbld(i)-vbldp0
5056 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5057 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5060 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5062 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5065 estr=0.5d0*AKP*estr+estr1
5067 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5069 do i=ibond_start,ibond_end
5071 if (iti.ne.10 .and. iti.ne.ntyp1) then
5074 diff=vbld(i+nres)-vbldsc0(1,iti)
5075 if (energy_dec) write (iout,*)
5076 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5077 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5078 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5080 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5084 diff=vbld(i+nres)-vbldsc0(j,iti)
5085 ud(j)=aksc(j,iti)*diff
5086 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5100 uprod2=uprod2*u(k)*u(k)
5104 usumsqder=usumsqder+ud(j)*uprod2
5106 estr=estr+uprod/usum
5108 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5116 C--------------------------------------------------------------------------
5117 subroutine ebend(etheta)
5119 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5120 C angles gamma and its derivatives in consecutive thetas and gammas.
5122 implicit real*8 (a-h,o-z)
5123 include 'DIMENSIONS'
5124 include 'COMMON.LOCAL'
5125 include 'COMMON.GEO'
5126 include 'COMMON.INTERACT'
5127 include 'COMMON.DERIV'
5128 include 'COMMON.VAR'
5129 include 'COMMON.CHAIN'
5130 include 'COMMON.IOUNITS'
5131 include 'COMMON.NAMES'
5132 include 'COMMON.FFIELD'
5133 include 'COMMON.CONTROL'
5134 common /calcthet/ term1,term2,termm,diffak,ratak,
5135 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5136 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5137 double precision y(2),z(2)
5139 c time11=dexp(-2*time)
5142 c write (*,'(a,i2)') 'EBEND ICG=',icg
5143 do i=ithet_start,ithet_end
5144 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5145 & .or.itype(i).eq.ntyp1) cycle
5146 C Zero the energy function and its derivative at 0 or pi.
5147 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5149 ichir1=isign(1,itype(i-2))
5150 ichir2=isign(1,itype(i))
5151 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5152 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5153 if (itype(i-1).eq.10) then
5154 itype1=isign(10,itype(i-2))
5155 ichir11=isign(1,itype(i-2))
5156 ichir12=isign(1,itype(i-2))
5157 itype2=isign(10,itype(i))
5158 ichir21=isign(1,itype(i))
5159 ichir22=isign(1,itype(i))
5162 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5165 if (phii.ne.phii) phii=150.0
5175 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5178 if (phii1.ne.phii1) phii1=150.0
5190 C Calculate the "mean" value of theta from the part of the distribution
5191 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5192 C In following comments this theta will be referred to as t_c.
5193 thet_pred_mean=0.0d0
5195 athetk=athet(k,it,ichir1,ichir2)
5196 bthetk=bthet(k,it,ichir1,ichir2)
5198 athetk=athet(k,itype1,ichir11,ichir12)
5199 bthetk=bthet(k,itype2,ichir21,ichir22)
5201 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5202 c write(iout,*) 'chuj tu', y(k),z(k)
5204 dthett=thet_pred_mean*ssd
5205 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5206 C Derivatives of the "mean" values in gamma1 and gamma2.
5207 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5208 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5209 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5210 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5212 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5213 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5214 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5215 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5217 if (theta(i).gt.pi-delta) then
5218 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5220 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5221 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5222 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5224 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5226 else if (theta(i).lt.delta) then
5227 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5228 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5229 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5231 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5232 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5235 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5238 etheta=etheta+ethetai
5239 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5240 & 'ebend',i,ethetai,theta(i),itype(i)
5241 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5242 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5243 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5245 C Ufff.... We've done all this!!!
5248 C---------------------------------------------------------------------------
5249 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5251 implicit real*8 (a-h,o-z)
5252 include 'DIMENSIONS'
5253 include 'COMMON.LOCAL'
5254 include 'COMMON.IOUNITS'
5255 common /calcthet/ term1,term2,termm,diffak,ratak,
5256 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5257 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5258 C Calculate the contributions to both Gaussian lobes.
5259 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5260 C The "polynomial part" of the "standard deviation" of this part of
5261 C the distributioni.
5262 ccc write (iout,*) thetai,thet_pred_mean
5265 sig=sig*thet_pred_mean+polthet(j,it)
5267 C Derivative of the "interior part" of the "standard deviation of the"
5268 C gamma-dependent Gaussian lobe in t_c.
5269 sigtc=3*polthet(3,it)
5271 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5274 C Set the parameters of both Gaussian lobes of the distribution.
5275 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5276 fac=sig*sig+sigc0(it)
5279 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5280 sigsqtc=-4.0D0*sigcsq*sigtc
5281 c print *,i,sig,sigtc,sigsqtc
5282 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5283 sigtc=-sigtc/(fac*fac)
5284 C Following variable is sigma(t_c)**(-2)
5285 sigcsq=sigcsq*sigcsq
5287 sig0inv=1.0D0/sig0i**2
5288 delthec=thetai-thet_pred_mean
5289 delthe0=thetai-theta0i
5290 term1=-0.5D0*sigcsq*delthec*delthec
5291 term2=-0.5D0*sig0inv*delthe0*delthe0
5292 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5293 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5294 C NaNs in taking the logarithm. We extract the largest exponent which is added
5295 C to the energy (this being the log of the distribution) at the end of energy
5296 C term evaluation for this virtual-bond angle.
5297 if (term1.gt.term2) then
5299 term2=dexp(term2-termm)
5303 term1=dexp(term1-termm)
5306 C The ratio between the gamma-independent and gamma-dependent lobes of
5307 C the distribution is a Gaussian function of thet_pred_mean too.
5308 diffak=gthet(2,it)-thet_pred_mean
5309 ratak=diffak/gthet(3,it)**2
5310 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5311 C Let's differentiate it in thet_pred_mean NOW.
5313 C Now put together the distribution terms to make complete distribution.
5314 termexp=term1+ak*term2
5315 termpre=sigc+ak*sig0i
5316 C Contribution of the bending energy from this theta is just the -log of
5317 C the sum of the contributions from the two lobes and the pre-exponential
5318 C factor. Simple enough, isn't it?
5319 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5320 C write (iout,*) 'termexp',termexp,termm,termpre,i
5321 C NOW the derivatives!!!
5322 C 6/6/97 Take into account the deformation.
5323 E_theta=(delthec*sigcsq*term1
5324 & +ak*delthe0*sig0inv*term2)/termexp
5325 E_tc=((sigtc+aktc*sig0i)/termpre
5326 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5327 & aktc*term2)/termexp)
5330 c-----------------------------------------------------------------------------
5331 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5332 implicit real*8 (a-h,o-z)
5333 include 'DIMENSIONS'
5334 include 'COMMON.LOCAL'
5335 include 'COMMON.IOUNITS'
5336 common /calcthet/ term1,term2,termm,diffak,ratak,
5337 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5338 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5339 delthec=thetai-thet_pred_mean
5340 delthe0=thetai-theta0i
5341 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5342 t3 = thetai-thet_pred_mean
5346 t14 = t12+t6*sigsqtc
5348 t21 = thetai-theta0i
5354 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5355 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5356 & *(-t12*t9-ak*sig0inv*t27)
5360 C--------------------------------------------------------------------------
5361 subroutine ebend(etheta)
5363 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5364 C angles gamma and its derivatives in consecutive thetas and gammas.
5365 C ab initio-derived potentials from
5366 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5368 implicit real*8 (a-h,o-z)
5369 include 'DIMENSIONS'
5370 include 'COMMON.LOCAL'
5371 include 'COMMON.GEO'
5372 include 'COMMON.INTERACT'
5373 include 'COMMON.DERIV'
5374 include 'COMMON.VAR'
5375 include 'COMMON.CHAIN'
5376 include 'COMMON.IOUNITS'
5377 include 'COMMON.NAMES'
5378 include 'COMMON.FFIELD'
5379 include 'COMMON.CONTROL'
5380 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5381 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5382 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5383 & sinph1ph2(maxdouble,maxdouble)
5384 logical lprn /.false./, lprn1 /.false./
5386 do i=ithet_start,ithet_end
5387 c print *,i,itype(i-1),itype(i),itype(i-2)
5388 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5389 & .or.itype(i).eq.ntyp1) cycle
5390 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5392 if (iabs(itype(i+1)).eq.20) iblock=2
5393 if (iabs(itype(i+1)).ne.20) iblock=1
5397 theti2=0.5d0*theta(i)
5398 ityp2=ithetyp((itype(i-1)))
5400 coskt(k)=dcos(k*theti2)
5401 sinkt(k)=dsin(k*theti2)
5403 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5406 if (phii.ne.phii) phii=150.0
5410 ityp1=ithetyp((itype(i-2)))
5411 C propagation of chirality for glycine type
5413 cosph1(k)=dcos(k*phii)
5414 sinph1(k)=dsin(k*phii)
5424 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5427 if (phii1.ne.phii1) phii1=150.0
5432 ityp3=ithetyp((itype(i)))
5434 cosph2(k)=dcos(k*phii1)
5435 sinph2(k)=dsin(k*phii1)
5445 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5448 ccl=cosph1(l)*cosph2(k-l)
5449 ssl=sinph1(l)*sinph2(k-l)
5450 scl=sinph1(l)*cosph2(k-l)
5451 csl=cosph1(l)*sinph2(k-l)
5452 cosph1ph2(l,k)=ccl-ssl
5453 cosph1ph2(k,l)=ccl+ssl
5454 sinph1ph2(l,k)=scl+csl
5455 sinph1ph2(k,l)=scl-csl
5459 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5460 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5461 write (iout,*) "coskt and sinkt"
5463 write (iout,*) k,coskt(k),sinkt(k)
5467 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5468 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5471 & write (iout,*) "k",k,"
5472 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5473 & " ethetai",ethetai
5476 write (iout,*) "cosph and sinph"
5478 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5480 write (iout,*) "cosph1ph2 and sinph2ph2"
5483 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5484 & sinph1ph2(l,k),sinph1ph2(k,l)
5487 write(iout,*) "ethetai",ethetai
5491 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5492 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5493 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5494 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5495 ethetai=ethetai+sinkt(m)*aux
5496 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5497 dephii=dephii+k*sinkt(m)*(
5498 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5499 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5500 dephii1=dephii1+k*sinkt(m)*(
5501 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5502 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5504 & write (iout,*) "m",m," k",k," bbthet",
5505 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5506 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5507 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5508 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5512 & write(iout,*) "ethetai",ethetai
5516 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5517 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5518 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5519 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5520 ethetai=ethetai+sinkt(m)*aux
5521 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5522 dephii=dephii+l*sinkt(m)*(
5523 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5524 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5525 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5526 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5527 dephii1=dephii1+(k-l)*sinkt(m)*(
5528 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5529 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5530 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5531 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5533 write (iout,*) "m",m," k",k," l",l," ffthet",
5534 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5535 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5536 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5537 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5538 & " ethetai",ethetai
5539 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5540 & cosph1ph2(k,l)*sinkt(m),
5541 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5549 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5550 & i,theta(i)*rad2deg,phii*rad2deg,
5551 & phii1*rad2deg,ethetai
5553 etheta=etheta+ethetai
5554 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5555 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5556 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
5562 c-----------------------------------------------------------------------------
5563 subroutine esc(escloc)
5564 C Calculate the local energy of a side chain and its derivatives in the
5565 C corresponding virtual-bond valence angles THETA and the spherical angles
5567 implicit real*8 (a-h,o-z)
5568 include 'DIMENSIONS'
5569 include 'COMMON.GEO'
5570 include 'COMMON.LOCAL'
5571 include 'COMMON.VAR'
5572 include 'COMMON.INTERACT'
5573 include 'COMMON.DERIV'
5574 include 'COMMON.CHAIN'
5575 include 'COMMON.IOUNITS'
5576 include 'COMMON.NAMES'
5577 include 'COMMON.FFIELD'
5578 include 'COMMON.CONTROL'
5579 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5580 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5581 common /sccalc/ time11,time12,time112,theti,it,nlobit
5584 c write (iout,'(a)') 'ESC'
5585 do i=loc_start,loc_end
5587 if (it.eq.ntyp1) cycle
5588 if (it.eq.10) goto 1
5589 nlobit=nlob(iabs(it))
5590 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5591 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5592 theti=theta(i+1)-pipol
5597 if (x(2).gt.pi-delta) then
5601 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5603 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5604 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5606 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5607 & ddersc0(1),dersc(1))
5608 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5609 & ddersc0(3),dersc(3))
5611 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5613 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5614 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5615 & dersc0(2),esclocbi,dersc02)
5616 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5618 call splinthet(x(2),0.5d0*delta,ss,ssd)
5623 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5625 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5626 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5628 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5630 c write (iout,*) escloci
5631 else if (x(2).lt.delta) then
5635 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5637 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5638 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5640 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5641 & ddersc0(1),dersc(1))
5642 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5643 & ddersc0(3),dersc(3))
5645 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5647 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5648 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5649 & dersc0(2),esclocbi,dersc02)
5650 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5655 call splinthet(x(2),0.5d0*delta,ss,ssd)
5657 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5659 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5660 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5662 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5663 c write (iout,*) escloci
5665 call enesc(x,escloci,dersc,ddummy,.false.)
5668 escloc=escloc+escloci
5669 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5670 & 'escloc',i,escloci
5671 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5673 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5675 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5676 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5681 C---------------------------------------------------------------------------
5682 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5683 implicit real*8 (a-h,o-z)
5684 include 'DIMENSIONS'
5685 include 'COMMON.GEO'
5686 include 'COMMON.LOCAL'
5687 include 'COMMON.IOUNITS'
5688 common /sccalc/ time11,time12,time112,theti,it,nlobit
5689 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5690 double precision contr(maxlob,-1:1)
5692 c write (iout,*) 'it=',it,' nlobit=',nlobit
5696 if (mixed) ddersc(j)=0.0d0
5700 C Because of periodicity of the dependence of the SC energy in omega we have
5701 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5702 C To avoid underflows, first compute & store the exponents.
5710 z(k)=x(k)-censc(k,j,it)
5715 Axk=Axk+gaussc(l,k,j,it)*z(l)
5721 expfac=expfac+Ax(k,j,iii)*z(k)
5729 C As in the case of ebend, we want to avoid underflows in exponentiation and
5730 C subsequent NaNs and INFs in energy calculation.
5731 C Find the largest exponent
5735 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5739 cd print *,'it=',it,' emin=',emin
5741 C Compute the contribution to SC energy and derivatives
5746 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5747 if(adexp.ne.adexp) adexp=1.0
5750 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5752 cd print *,'j=',j,' expfac=',expfac
5753 escloc_i=escloc_i+expfac
5755 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5759 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5760 & +gaussc(k,2,j,it))*expfac
5767 dersc(1)=dersc(1)/cos(theti)**2
5768 ddersc(1)=ddersc(1)/cos(theti)**2
5771 escloci=-(dlog(escloc_i)-emin)
5773 dersc(j)=dersc(j)/escloc_i
5777 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5782 C------------------------------------------------------------------------------
5783 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5784 implicit real*8 (a-h,o-z)
5785 include 'DIMENSIONS'
5786 include 'COMMON.GEO'
5787 include 'COMMON.LOCAL'
5788 include 'COMMON.IOUNITS'
5789 common /sccalc/ time11,time12,time112,theti,it,nlobit
5790 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5791 double precision contr(maxlob)
5802 z(k)=x(k)-censc(k,j,it)
5808 Axk=Axk+gaussc(l,k,j,it)*z(l)
5814 expfac=expfac+Ax(k,j)*z(k)
5819 C As in the case of ebend, we want to avoid underflows in exponentiation and
5820 C subsequent NaNs and INFs in energy calculation.
5821 C Find the largest exponent
5824 if (emin.gt.contr(j)) emin=contr(j)
5828 C Compute the contribution to SC energy and derivatives
5832 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5833 escloc_i=escloc_i+expfac
5835 dersc(k)=dersc(k)+Ax(k,j)*expfac
5837 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5838 & +gaussc(1,2,j,it))*expfac
5842 dersc(1)=dersc(1)/cos(theti)**2
5843 dersc12=dersc12/cos(theti)**2
5844 escloci=-(dlog(escloc_i)-emin)
5846 dersc(j)=dersc(j)/escloc_i
5848 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5852 c----------------------------------------------------------------------------------
5853 subroutine esc(escloc)
5854 C Calculate the local energy of a side chain and its derivatives in the
5855 C corresponding virtual-bond valence angles THETA and the spherical angles
5856 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5857 C added by Urszula Kozlowska. 07/11/2007
5859 implicit real*8 (a-h,o-z)
5860 include 'DIMENSIONS'
5861 include 'COMMON.GEO'
5862 include 'COMMON.LOCAL'
5863 include 'COMMON.VAR'
5864 include 'COMMON.SCROT'
5865 include 'COMMON.INTERACT'
5866 include 'COMMON.DERIV'
5867 include 'COMMON.CHAIN'
5868 include 'COMMON.IOUNITS'
5869 include 'COMMON.NAMES'
5870 include 'COMMON.FFIELD'
5871 include 'COMMON.CONTROL'
5872 include 'COMMON.VECTORS'
5873 double precision x_prime(3),y_prime(3),z_prime(3)
5874 & , sumene,dsc_i,dp2_i,x(65),
5875 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5876 & de_dxx,de_dyy,de_dzz,de_dt
5877 double precision s1_t,s1_6_t,s2_t,s2_6_t
5879 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5880 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5881 & dt_dCi(3),dt_dCi1(3)
5882 common /sccalc/ time11,time12,time112,theti,it,nlobit
5885 do i=loc_start,loc_end
5886 if (itype(i).eq.ntyp1) cycle
5887 costtab(i+1) =dcos(theta(i+1))
5888 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5889 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5890 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5891 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5892 cosfac=dsqrt(cosfac2)
5893 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5894 sinfac=dsqrt(sinfac2)
5896 if (it.eq.10) goto 1
5898 C Compute the axes of tghe local cartesian coordinates system; store in
5899 c x_prime, y_prime and z_prime
5906 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5907 C & dc_norm(3,i+nres)
5909 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5910 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5913 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5916 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5917 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5918 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5919 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5920 c & " xy",scalar(x_prime(1),y_prime(1)),
5921 c & " xz",scalar(x_prime(1),z_prime(1)),
5922 c & " yy",scalar(y_prime(1),y_prime(1)),
5923 c & " yz",scalar(y_prime(1),z_prime(1)),
5924 c & " zz",scalar(z_prime(1),z_prime(1))
5926 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5927 C to local coordinate system. Store in xx, yy, zz.
5933 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5934 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5935 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5942 C Compute the energy of the ith side cbain
5944 c write (2,*) "xx",xx," yy",yy," zz",zz
5947 x(j) = sc_parmin(j,it)
5950 Cc diagnostics - remove later
5952 yy1 = dsin(alph(2))*dcos(omeg(2))
5953 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5954 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5955 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5957 C," --- ", xx_w,yy_w,zz_w
5960 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5961 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5963 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5964 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5966 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5967 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5968 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5969 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5970 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5972 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5973 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5974 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5975 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5976 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5978 dsc_i = 0.743d0+x(61)
5980 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5981 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5982 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5983 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5984 s1=(1+x(63))/(0.1d0 + dscp1)
5985 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5986 s2=(1+x(65))/(0.1d0 + dscp2)
5987 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5988 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5989 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5990 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5992 c & dscp1,dscp2,sumene
5993 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5994 escloc = escloc + sumene
5995 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6000 C This section to check the numerical derivatives of the energy of ith side
6001 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6002 C #define DEBUG in the code to turn it on.
6004 write (2,*) "sumene =",sumene
6008 write (2,*) xx,yy,zz
6009 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6010 de_dxx_num=(sumenep-sumene)/aincr
6012 write (2,*) "xx+ sumene from enesc=",sumenep
6015 write (2,*) xx,yy,zz
6016 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6017 de_dyy_num=(sumenep-sumene)/aincr
6019 write (2,*) "yy+ sumene from enesc=",sumenep
6022 write (2,*) xx,yy,zz
6023 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6024 de_dzz_num=(sumenep-sumene)/aincr
6026 write (2,*) "zz+ sumene from enesc=",sumenep
6027 costsave=cost2tab(i+1)
6028 sintsave=sint2tab(i+1)
6029 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6030 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6031 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6032 de_dt_num=(sumenep-sumene)/aincr
6033 write (2,*) " t+ sumene from enesc=",sumenep
6034 cost2tab(i+1)=costsave
6035 sint2tab(i+1)=sintsave
6036 C End of diagnostics section.
6039 C Compute the gradient of esc
6041 c zz=zz*dsign(1.0,dfloat(itype(i)))
6042 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6043 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6044 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6045 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6046 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6047 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6048 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6049 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6050 pom1=(sumene3*sint2tab(i+1)+sumene1)
6051 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6052 pom2=(sumene4*cost2tab(i+1)+sumene2)
6053 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6054 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6055 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6056 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6058 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6059 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6060 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6062 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6063 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6064 & +(pom1+pom2)*pom_dx
6066 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6069 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6070 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6071 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6073 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6074 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6075 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6076 & +x(59)*zz**2 +x(60)*xx*zz
6077 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6078 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6079 & +(pom1-pom2)*pom_dy
6081 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6084 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6085 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6086 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6087 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6088 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6089 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6090 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6091 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6093 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6096 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6097 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6098 & +pom1*pom_dt1+pom2*pom_dt2
6100 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6105 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6106 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6107 cosfac2xx=cosfac2*xx
6108 sinfac2yy=sinfac2*yy
6110 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6112 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6114 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6115 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6116 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6117 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6118 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6119 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6120 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6121 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6122 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6123 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6127 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6128 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6129 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6130 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6133 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6134 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6135 dZZ_XYZ(k)=vbld_inv(i+nres)*
6136 & (z_prime(k)-zz*dC_norm(k,i+nres))
6138 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6139 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6143 dXX_Ctab(k,i)=dXX_Ci(k)
6144 dXX_C1tab(k,i)=dXX_Ci1(k)
6145 dYY_Ctab(k,i)=dYY_Ci(k)
6146 dYY_C1tab(k,i)=dYY_Ci1(k)
6147 dZZ_Ctab(k,i)=dZZ_Ci(k)
6148 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6149 dXX_XYZtab(k,i)=dXX_XYZ(k)
6150 dYY_XYZtab(k,i)=dYY_XYZ(k)
6151 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6155 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6156 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6157 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6158 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6159 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6161 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6162 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6163 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6164 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6165 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6166 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6167 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6168 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6170 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6171 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6173 C to check gradient call subroutine check_grad
6179 c------------------------------------------------------------------------------
6180 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6182 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6183 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6184 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6185 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6187 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6188 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6190 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6191 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6192 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6193 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6194 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6196 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6197 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6198 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6199 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6200 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6202 dsc_i = 0.743d0+x(61)
6204 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6205 & *(xx*cost2+yy*sint2))
6206 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6207 & *(xx*cost2-yy*sint2))
6208 s1=(1+x(63))/(0.1d0 + dscp1)
6209 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6210 s2=(1+x(65))/(0.1d0 + dscp2)
6211 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6212 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6213 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6218 c------------------------------------------------------------------------------
6219 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6221 C This procedure calculates two-body contact function g(rij) and its derivative:
6224 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6227 C where x=(rij-r0ij)/delta
6229 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6232 double precision rij,r0ij,eps0ij,fcont,fprimcont
6233 double precision x,x2,x4,delta
6237 if (x.lt.-1.0D0) then
6240 else if (x.le.1.0D0) then
6243 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6244 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6251 c------------------------------------------------------------------------------
6252 subroutine splinthet(theti,delta,ss,ssder)
6253 implicit real*8 (a-h,o-z)
6254 include 'DIMENSIONS'
6255 include 'COMMON.VAR'
6256 include 'COMMON.GEO'
6259 if (theti.gt.pipol) then
6260 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6262 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6267 c------------------------------------------------------------------------------
6268 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6270 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6271 double precision ksi,ksi2,ksi3,a1,a2,a3
6272 a1=fprim0*delta/(f1-f0)
6278 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6279 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6282 c------------------------------------------------------------------------------
6283 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6285 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6286 double precision ksi,ksi2,ksi3,a1,a2,a3
6291 a2=3*(f1x-f0x)-2*fprim0x*delta
6292 a3=fprim0x*delta-2*(f1x-f0x)
6293 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6296 C-----------------------------------------------------------------------------
6298 C-----------------------------------------------------------------------------
6299 subroutine etor(etors,edihcnstr)
6300 implicit real*8 (a-h,o-z)
6301 include 'DIMENSIONS'
6302 include 'COMMON.VAR'
6303 include 'COMMON.GEO'
6304 include 'COMMON.LOCAL'
6305 include 'COMMON.TORSION'
6306 include 'COMMON.INTERACT'
6307 include 'COMMON.DERIV'
6308 include 'COMMON.CHAIN'
6309 include 'COMMON.NAMES'
6310 include 'COMMON.IOUNITS'
6311 include 'COMMON.FFIELD'
6312 include 'COMMON.TORCNSTR'
6313 include 'COMMON.CONTROL'
6315 C Set lprn=.true. for debugging
6319 do i=iphi_start,iphi_end
6321 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6322 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6323 itori=itortyp(itype(i-2))
6324 itori1=itortyp(itype(i-1))
6327 C Proline-Proline pair is a special case...
6328 if (itori.eq.3 .and. itori1.eq.3) then
6329 if (phii.gt.-dwapi3) then
6331 fac=1.0D0/(1.0D0-cosphi)
6332 etorsi=v1(1,3,3)*fac
6333 etorsi=etorsi+etorsi
6334 etors=etors+etorsi-v1(1,3,3)
6335 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6336 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6339 v1ij=v1(j+1,itori,itori1)
6340 v2ij=v2(j+1,itori,itori1)
6343 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6344 if (energy_dec) etors_ii=etors_ii+
6345 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6346 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6350 v1ij=v1(j,itori,itori1)
6351 v2ij=v2(j,itori,itori1)
6354 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6355 if (energy_dec) etors_ii=etors_ii+
6356 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6357 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6360 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6363 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6364 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6365 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6366 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6367 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6369 ! 6/20/98 - dihedral angle constraints
6372 itori=idih_constr(i)
6375 if (difi.gt.drange(i)) then
6377 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6378 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6379 else if (difi.lt.-drange(i)) then
6381 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6382 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6384 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6385 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6387 ! write (iout,*) 'edihcnstr',edihcnstr
6390 c------------------------------------------------------------------------------
6391 subroutine etor_d(etors_d)
6395 c----------------------------------------------------------------------------
6397 subroutine etor(etors,edihcnstr)
6398 implicit real*8 (a-h,o-z)
6399 include 'DIMENSIONS'
6400 include 'COMMON.VAR'
6401 include 'COMMON.GEO'
6402 include 'COMMON.LOCAL'
6403 include 'COMMON.TORSION'
6404 include 'COMMON.INTERACT'
6405 include 'COMMON.DERIV'
6406 include 'COMMON.CHAIN'
6407 include 'COMMON.NAMES'
6408 include 'COMMON.IOUNITS'
6409 include 'COMMON.FFIELD'
6410 include 'COMMON.TORCNSTR'
6411 include 'COMMON.CONTROL'
6413 C Set lprn=.true. for debugging
6417 do i=iphi_start,iphi_end
6418 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6419 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6420 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6421 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6422 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6423 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6424 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6425 C For introducing the NH3+ and COO- group please check the etor_d for reference
6428 if (iabs(itype(i)).eq.20) then
6433 itori=itortyp(itype(i-2))
6434 itori1=itortyp(itype(i-1))
6437 C Regular cosine and sine terms
6438 do j=1,nterm(itori,itori1,iblock)
6439 v1ij=v1(j,itori,itori1,iblock)
6440 v2ij=v2(j,itori,itori1,iblock)
6443 etors=etors+v1ij*cosphi+v2ij*sinphi
6444 if (energy_dec) etors_ii=etors_ii+
6445 & v1ij*cosphi+v2ij*sinphi
6446 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6450 C E = SUM ----------------------------------- - v1
6451 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6453 cosphi=dcos(0.5d0*phii)
6454 sinphi=dsin(0.5d0*phii)
6455 do j=1,nlor(itori,itori1,iblock)
6456 vl1ij=vlor1(j,itori,itori1)
6457 vl2ij=vlor2(j,itori,itori1)
6458 vl3ij=vlor3(j,itori,itori1)
6459 pom=vl2ij*cosphi+vl3ij*sinphi
6460 pom1=1.0d0/(pom*pom+1.0d0)
6461 etors=etors+vl1ij*pom1
6462 if (energy_dec) etors_ii=etors_ii+
6465 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6467 C Subtract the constant term
6468 etors=etors-v0(itori,itori1,iblock)
6469 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6470 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6472 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6473 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6474 & (v1(j,itori,itori1,iblock),j=1,6),
6475 & (v2(j,itori,itori1,iblock),j=1,6)
6476 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6477 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6479 ! 6/20/98 - dihedral angle constraints
6481 c do i=1,ndih_constr
6482 do i=idihconstr_start,idihconstr_end
6483 itori=idih_constr(i)
6485 difi=pinorm(phii-phi0(i))
6486 if (difi.gt.drange(i)) then
6488 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6489 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6490 else if (difi.lt.-drange(i)) then
6492 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6493 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6497 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6498 cd & rad2deg*phi0(i), rad2deg*drange(i),
6499 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6501 cd write (iout,*) 'edihcnstr',edihcnstr
6504 c----------------------------------------------------------------------------
6505 subroutine etor_d(etors_d)
6506 C 6/23/01 Compute double torsional energy
6507 implicit real*8 (a-h,o-z)
6508 include 'DIMENSIONS'
6509 include 'COMMON.VAR'
6510 include 'COMMON.GEO'
6511 include 'COMMON.LOCAL'
6512 include 'COMMON.TORSION'
6513 include 'COMMON.INTERACT'
6514 include 'COMMON.DERIV'
6515 include 'COMMON.CHAIN'
6516 include 'COMMON.NAMES'
6517 include 'COMMON.IOUNITS'
6518 include 'COMMON.FFIELD'
6519 include 'COMMON.TORCNSTR'
6521 C Set lprn=.true. for debugging
6525 c write(iout,*) "a tu??"
6526 do i=iphid_start,iphid_end
6527 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6528 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6529 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6530 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6531 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6532 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6533 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6534 & (itype(i+1).eq.ntyp1)) cycle
6535 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6536 itori=itortyp(itype(i-2))
6537 itori1=itortyp(itype(i-1))
6538 itori2=itortyp(itype(i))
6544 if (iabs(itype(i+1)).eq.20) iblock=2
6545 C Iblock=2 Proline type
6546 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6547 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6548 C if (itype(i+1).eq.ntyp1) iblock=3
6549 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6550 C IS or IS NOT need for this
6551 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6552 C is (itype(i-3).eq.ntyp1) ntblock=2
6553 C ntblock is N-terminal blocking group
6555 C Regular cosine and sine terms
6556 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6557 C Example of changes for NH3+ blocking group
6558 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6559 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6560 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6561 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6562 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6563 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6564 cosphi1=dcos(j*phii)
6565 sinphi1=dsin(j*phii)
6566 cosphi2=dcos(j*phii1)
6567 sinphi2=dsin(j*phii1)
6568 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6569 & v2cij*cosphi2+v2sij*sinphi2
6570 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6571 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6573 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6575 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6576 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6577 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6578 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6579 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6580 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6581 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6582 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6583 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6584 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6585 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6586 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6587 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6588 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6591 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6592 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6597 c------------------------------------------------------------------------------
6598 subroutine eback_sc_corr(esccor)
6599 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6600 c conformational states; temporarily implemented as differences
6601 c between UNRES torsional potentials (dependent on three types of
6602 c residues) and the torsional potentials dependent on all 20 types
6603 c of residues computed from AM1 energy surfaces of terminally-blocked
6604 c amino-acid residues.
6605 implicit real*8 (a-h,o-z)
6606 include 'DIMENSIONS'
6607 include 'COMMON.VAR'
6608 include 'COMMON.GEO'
6609 include 'COMMON.LOCAL'
6610 include 'COMMON.TORSION'
6611 include 'COMMON.SCCOR'
6612 include 'COMMON.INTERACT'
6613 include 'COMMON.DERIV'
6614 include 'COMMON.CHAIN'
6615 include 'COMMON.NAMES'
6616 include 'COMMON.IOUNITS'
6617 include 'COMMON.FFIELD'
6618 include 'COMMON.CONTROL'
6620 C Set lprn=.true. for debugging
6623 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6625 do i=itau_start,itau_end
6626 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6628 isccori=isccortyp(itype(i-2))
6629 isccori1=isccortyp(itype(i-1))
6630 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6632 do intertyp=1,3 !intertyp
6633 cc Added 09 May 2012 (Adasko)
6634 cc Intertyp means interaction type of backbone mainchain correlation:
6635 c 1 = SC...Ca...Ca...Ca
6636 c 2 = Ca...Ca...Ca...SC
6637 c 3 = SC...Ca...Ca...SCi
6639 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6640 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6641 & (itype(i-1).eq.ntyp1)))
6642 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6643 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6644 & .or.(itype(i).eq.ntyp1)))
6645 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6646 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6647 & (itype(i-3).eq.ntyp1)))) cycle
6648 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6649 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6651 do j=1,nterm_sccor(isccori,isccori1)
6652 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6653 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6654 cosphi=dcos(j*tauangle(intertyp,i))
6655 sinphi=dsin(j*tauangle(intertyp,i))
6656 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6657 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6659 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6660 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6662 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6663 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6664 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6665 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6666 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6672 c----------------------------------------------------------------------------
6673 subroutine multibody(ecorr)
6674 C This subroutine calculates multi-body contributions to energy following
6675 C the idea of Skolnick et al. If side chains I and J make a contact and
6676 C at the same time side chains I+1 and J+1 make a contact, an extra
6677 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6678 implicit real*8 (a-h,o-z)
6679 include 'DIMENSIONS'
6680 include 'COMMON.IOUNITS'
6681 include 'COMMON.DERIV'
6682 include 'COMMON.INTERACT'
6683 include 'COMMON.CONTACTS'
6684 double precision gx(3),gx1(3)
6687 C Set lprn=.true. for debugging
6691 write (iout,'(a)') 'Contact function values:'
6693 write (iout,'(i2,20(1x,i2,f10.5))')
6694 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6709 num_conti=num_cont(i)
6710 num_conti1=num_cont(i1)
6715 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6716 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6717 cd & ' ishift=',ishift
6718 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6719 C The system gains extra energy.
6720 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6721 endif ! j1==j+-ishift
6730 c------------------------------------------------------------------------------
6731 double precision function esccorr(i,j,k,l,jj,kk)
6732 implicit real*8 (a-h,o-z)
6733 include 'DIMENSIONS'
6734 include 'COMMON.IOUNITS'
6735 include 'COMMON.DERIV'
6736 include 'COMMON.INTERACT'
6737 include 'COMMON.CONTACTS'
6738 double precision gx(3),gx1(3)
6743 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6744 C Calculate the multi-body contribution to energy.
6745 C Calculate multi-body contributions to the gradient.
6746 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6747 cd & k,l,(gacont(m,kk,k),m=1,3)
6749 gx(m) =ekl*gacont(m,jj,i)
6750 gx1(m)=eij*gacont(m,kk,k)
6751 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6752 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6753 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6754 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6758 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6763 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6769 c------------------------------------------------------------------------------
6770 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6771 C This subroutine calculates multi-body contributions to hydrogen-bonding
6772 implicit real*8 (a-h,o-z)
6773 include 'DIMENSIONS'
6774 include 'COMMON.IOUNITS'
6777 parameter (max_cont=maxconts)
6778 parameter (max_dim=26)
6779 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6780 double precision zapas(max_dim,maxconts,max_fg_procs),
6781 & zapas_recv(max_dim,maxconts,max_fg_procs)
6782 common /przechowalnia/ zapas
6783 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6784 & status_array(MPI_STATUS_SIZE,maxconts*2)
6786 include 'COMMON.SETUP'
6787 include 'COMMON.FFIELD'
6788 include 'COMMON.DERIV'
6789 include 'COMMON.INTERACT'
6790 include 'COMMON.CONTACTS'
6791 include 'COMMON.CONTROL'
6792 include 'COMMON.LOCAL'
6793 double precision gx(3),gx1(3),time00
6796 C Set lprn=.true. for debugging
6801 if (nfgtasks.le.1) goto 30
6803 write (iout,'(a)') 'Contact function values before RECEIVE:'
6805 write (iout,'(2i3,50(1x,i2,f5.2))')
6806 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6807 & j=1,num_cont_hb(i))
6811 do i=1,ntask_cont_from
6814 do i=1,ntask_cont_to
6817 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6819 C Make the list of contacts to send to send to other procesors
6820 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6822 do i=iturn3_start,iturn3_end
6823 c write (iout,*) "make contact list turn3",i," num_cont",
6825 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6827 do i=iturn4_start,iturn4_end
6828 c write (iout,*) "make contact list turn4",i," num_cont",
6830 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6834 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6836 do j=1,num_cont_hb(i)
6839 iproc=iint_sent_local(k,jjc,ii)
6840 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6841 if (iproc.gt.0) then
6842 ncont_sent(iproc)=ncont_sent(iproc)+1
6843 nn=ncont_sent(iproc)
6845 zapas(2,nn,iproc)=jjc
6846 zapas(3,nn,iproc)=facont_hb(j,i)
6847 zapas(4,nn,iproc)=ees0p(j,i)
6848 zapas(5,nn,iproc)=ees0m(j,i)
6849 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6850 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6851 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6852 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6853 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6854 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6855 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6856 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6857 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6858 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6859 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6860 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6861 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6862 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6863 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6864 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6865 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6866 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6867 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6868 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6869 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6876 & "Numbers of contacts to be sent to other processors",
6877 & (ncont_sent(i),i=1,ntask_cont_to)
6878 write (iout,*) "Contacts sent"
6879 do ii=1,ntask_cont_to
6881 iproc=itask_cont_to(ii)
6882 write (iout,*) nn," contacts to processor",iproc,
6883 & " of CONT_TO_COMM group"
6885 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6893 CorrelID1=nfgtasks+fg_rank+1
6895 C Receive the numbers of needed contacts from other processors
6896 do ii=1,ntask_cont_from
6897 iproc=itask_cont_from(ii)
6899 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6900 & FG_COMM,req(ireq),IERR)
6902 c write (iout,*) "IRECV ended"
6904 C Send the number of contacts needed by other processors
6905 do ii=1,ntask_cont_to
6906 iproc=itask_cont_to(ii)
6908 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6909 & FG_COMM,req(ireq),IERR)
6911 c write (iout,*) "ISEND ended"
6912 c write (iout,*) "number of requests (nn)",ireq
6915 & call MPI_Waitall(ireq,req,status_array,ierr)
6917 c & "Numbers of contacts to be received from other processors",
6918 c & (ncont_recv(i),i=1,ntask_cont_from)
6922 do ii=1,ntask_cont_from
6923 iproc=itask_cont_from(ii)
6925 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6926 c & " of CONT_TO_COMM group"
6930 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6931 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6932 c write (iout,*) "ireq,req",ireq,req(ireq)
6935 C Send the contacts to processors that need them
6936 do ii=1,ntask_cont_to
6937 iproc=itask_cont_to(ii)
6939 c write (iout,*) nn," contacts to processor",iproc,
6940 c & " of CONT_TO_COMM group"
6943 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6944 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6945 c write (iout,*) "ireq,req",ireq,req(ireq)
6947 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6951 c write (iout,*) "number of requests (contacts)",ireq
6952 c write (iout,*) "req",(req(i),i=1,4)
6955 & call MPI_Waitall(ireq,req,status_array,ierr)
6956 do iii=1,ntask_cont_from
6957 iproc=itask_cont_from(iii)
6960 write (iout,*) "Received",nn," contacts from processor",iproc,
6961 & " of CONT_FROM_COMM group"
6964 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6969 ii=zapas_recv(1,i,iii)
6970 c Flag the received contacts to prevent double-counting
6971 jj=-zapas_recv(2,i,iii)
6972 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6974 nnn=num_cont_hb(ii)+1
6977 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6978 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6979 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6980 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6981 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6982 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6983 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6984 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6985 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6986 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6987 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6988 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6989 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6990 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6991 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6992 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6993 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6994 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6995 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6996 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6997 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6998 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6999 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7000 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7005 write (iout,'(a)') 'Contact function values after receive:'
7007 write (iout,'(2i3,50(1x,i3,f5.2))')
7008 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7009 & j=1,num_cont_hb(i))
7016 write (iout,'(a)') 'Contact function values:'
7018 write (iout,'(2i3,50(1x,i3,f5.2))')
7019 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7020 & j=1,num_cont_hb(i))
7024 C Remove the loop below after debugging !!!
7031 C Calculate the local-electrostatic correlation terms
7032 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7034 num_conti=num_cont_hb(i)
7035 num_conti1=num_cont_hb(i+1)
7042 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7043 c & ' jj=',jj,' kk=',kk
7044 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7045 & .or. j.lt.0 .and. j1.gt.0) .and.
7046 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7047 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7048 C The system gains extra energy.
7049 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7050 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7051 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7053 else if (j1.eq.j) then
7054 C Contacts I-J and I-(J+1) occur simultaneously.
7055 C The system loses extra energy.
7056 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7061 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7062 c & ' jj=',jj,' kk=',kk
7064 C Contacts I-J and (I+1)-J occur simultaneously.
7065 C The system loses extra energy.
7066 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7073 c------------------------------------------------------------------------------
7074 subroutine add_hb_contact(ii,jj,itask)
7075 implicit real*8 (a-h,o-z)
7076 include "DIMENSIONS"
7077 include "COMMON.IOUNITS"
7080 parameter (max_cont=maxconts)
7081 parameter (max_dim=26)
7082 include "COMMON.CONTACTS"
7083 double precision zapas(max_dim,maxconts,max_fg_procs),
7084 & zapas_recv(max_dim,maxconts,max_fg_procs)
7085 common /przechowalnia/ zapas
7086 integer i,j,ii,jj,iproc,itask(4),nn
7087 c write (iout,*) "itask",itask
7090 if (iproc.gt.0) then
7091 do j=1,num_cont_hb(ii)
7093 c write (iout,*) "i",ii," j",jj," jjc",jjc
7095 ncont_sent(iproc)=ncont_sent(iproc)+1
7096 nn=ncont_sent(iproc)
7097 zapas(1,nn,iproc)=ii
7098 zapas(2,nn,iproc)=jjc
7099 zapas(3,nn,iproc)=facont_hb(j,ii)
7100 zapas(4,nn,iproc)=ees0p(j,ii)
7101 zapas(5,nn,iproc)=ees0m(j,ii)
7102 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7103 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7104 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7105 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7106 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7107 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7108 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7109 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7110 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7111 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7112 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7113 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7114 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7115 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7116 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7117 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7118 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7119 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7120 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7121 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7122 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7130 c------------------------------------------------------------------------------
7131 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7133 C This subroutine calculates multi-body contributions to hydrogen-bonding
7134 implicit real*8 (a-h,o-z)
7135 include 'DIMENSIONS'
7136 include 'COMMON.IOUNITS'
7139 parameter (max_cont=maxconts)
7140 parameter (max_dim=70)
7141 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7142 double precision zapas(max_dim,maxconts,max_fg_procs),
7143 & zapas_recv(max_dim,maxconts,max_fg_procs)
7144 common /przechowalnia/ zapas
7145 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7146 & status_array(MPI_STATUS_SIZE,maxconts*2)
7148 include 'COMMON.SETUP'
7149 include 'COMMON.FFIELD'
7150 include 'COMMON.DERIV'
7151 include 'COMMON.LOCAL'
7152 include 'COMMON.INTERACT'
7153 include 'COMMON.CONTACTS'
7154 include 'COMMON.CHAIN'
7155 include 'COMMON.CONTROL'
7156 double precision gx(3),gx1(3)
7157 integer num_cont_hb_old(maxres)
7159 double precision eello4,eello5,eelo6,eello_turn6
7160 external eello4,eello5,eello6,eello_turn6
7161 C Set lprn=.true. for debugging
7166 num_cont_hb_old(i)=num_cont_hb(i)
7170 if (nfgtasks.le.1) goto 30
7172 write (iout,'(a)') 'Contact function values before RECEIVE:'
7174 write (iout,'(2i3,50(1x,i2,f5.2))')
7175 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7176 & j=1,num_cont_hb(i))
7180 do i=1,ntask_cont_from
7183 do i=1,ntask_cont_to
7186 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7188 C Make the list of contacts to send to send to other procesors
7189 do i=iturn3_start,iturn3_end
7190 c write (iout,*) "make contact list turn3",i," num_cont",
7192 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7194 do i=iturn4_start,iturn4_end
7195 c write (iout,*) "make contact list turn4",i," num_cont",
7197 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7201 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7203 do j=1,num_cont_hb(i)
7206 iproc=iint_sent_local(k,jjc,ii)
7207 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7208 if (iproc.ne.0) then
7209 ncont_sent(iproc)=ncont_sent(iproc)+1
7210 nn=ncont_sent(iproc)
7212 zapas(2,nn,iproc)=jjc
7213 zapas(3,nn,iproc)=d_cont(j,i)
7217 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7222 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7230 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7241 & "Numbers of contacts to be sent to other processors",
7242 & (ncont_sent(i),i=1,ntask_cont_to)
7243 write (iout,*) "Contacts sent"
7244 do ii=1,ntask_cont_to
7246 iproc=itask_cont_to(ii)
7247 write (iout,*) nn," contacts to processor",iproc,
7248 & " of CONT_TO_COMM group"
7250 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7258 CorrelID1=nfgtasks+fg_rank+1
7260 C Receive the numbers of needed contacts from other processors
7261 do ii=1,ntask_cont_from
7262 iproc=itask_cont_from(ii)
7264 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7265 & FG_COMM,req(ireq),IERR)
7267 c write (iout,*) "IRECV ended"
7269 C Send the number of contacts needed by other processors
7270 do ii=1,ntask_cont_to
7271 iproc=itask_cont_to(ii)
7273 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7274 & FG_COMM,req(ireq),IERR)
7276 c write (iout,*) "ISEND ended"
7277 c write (iout,*) "number of requests (nn)",ireq
7280 & call MPI_Waitall(ireq,req,status_array,ierr)
7282 c & "Numbers of contacts to be received from other processors",
7283 c & (ncont_recv(i),i=1,ntask_cont_from)
7287 do ii=1,ntask_cont_from
7288 iproc=itask_cont_from(ii)
7290 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7291 c & " of CONT_TO_COMM group"
7295 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7296 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7297 c write (iout,*) "ireq,req",ireq,req(ireq)
7300 C Send the contacts to processors that need them
7301 do ii=1,ntask_cont_to
7302 iproc=itask_cont_to(ii)
7304 c write (iout,*) nn," contacts to processor",iproc,
7305 c & " of CONT_TO_COMM group"
7308 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7309 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7310 c write (iout,*) "ireq,req",ireq,req(ireq)
7312 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7316 c write (iout,*) "number of requests (contacts)",ireq
7317 c write (iout,*) "req",(req(i),i=1,4)
7320 & call MPI_Waitall(ireq,req,status_array,ierr)
7321 do iii=1,ntask_cont_from
7322 iproc=itask_cont_from(iii)
7325 write (iout,*) "Received",nn," contacts from processor",iproc,
7326 & " of CONT_FROM_COMM group"
7329 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7334 ii=zapas_recv(1,i,iii)
7335 c Flag the received contacts to prevent double-counting
7336 jj=-zapas_recv(2,i,iii)
7337 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7339 nnn=num_cont_hb(ii)+1
7342 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7346 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7351 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7359 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7368 write (iout,'(a)') 'Contact function values after receive:'
7370 write (iout,'(2i3,50(1x,i3,5f6.3))')
7371 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7372 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7379 write (iout,'(a)') 'Contact function values:'
7381 write (iout,'(2i3,50(1x,i2,5f6.3))')
7382 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7383 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7389 C Remove the loop below after debugging !!!
7396 C Calculate the dipole-dipole interaction energies
7397 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7398 do i=iatel_s,iatel_e+1
7399 num_conti=num_cont_hb(i)
7408 C Calculate the local-electrostatic correlation terms
7409 c write (iout,*) "gradcorr5 in eello5 before loop"
7411 c write (iout,'(i5,3f10.5)')
7412 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7414 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7415 c write (iout,*) "corr loop i",i
7417 num_conti=num_cont_hb(i)
7418 num_conti1=num_cont_hb(i+1)
7425 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7426 c & ' jj=',jj,' kk=',kk
7427 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7428 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7429 & .or. j.lt.0 .and. j1.gt.0) .and.
7430 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7431 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7432 C The system gains extra energy.
7434 sqd1=dsqrt(d_cont(jj,i))
7435 sqd2=dsqrt(d_cont(kk,i1))
7436 sred_geom = sqd1*sqd2
7437 IF (sred_geom.lt.cutoff_corr) THEN
7438 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7440 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7441 cd & ' jj=',jj,' kk=',kk
7442 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7443 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7445 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7446 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7449 cd write (iout,*) 'sred_geom=',sred_geom,
7450 cd & ' ekont=',ekont,' fprim=',fprimcont,
7451 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7452 cd write (iout,*) "g_contij",g_contij
7453 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7454 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7455 call calc_eello(i,jp,i+1,jp1,jj,kk)
7456 if (wcorr4.gt.0.0d0)
7457 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7458 if (energy_dec.and.wcorr4.gt.0.0d0)
7459 1 write (iout,'(a6,4i5,0pf7.3)')
7460 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7461 c write (iout,*) "gradcorr5 before eello5"
7463 c write (iout,'(i5,3f10.5)')
7464 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7466 if (wcorr5.gt.0.0d0)
7467 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7468 c write (iout,*) "gradcorr5 after eello5"
7470 c write (iout,'(i5,3f10.5)')
7471 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7473 if (energy_dec.and.wcorr5.gt.0.0d0)
7474 1 write (iout,'(a6,4i5,0pf7.3)')
7475 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7476 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7477 cd write(2,*)'ijkl',i,jp,i+1,jp1
7478 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7479 & .or. wturn6.eq.0.0d0))then
7480 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7481 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7482 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7483 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7484 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7485 cd & 'ecorr6=',ecorr6
7486 cd write (iout,'(4e15.5)') sred_geom,
7487 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7488 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7489 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7490 else if (wturn6.gt.0.0d0
7491 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7492 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7493 eturn6=eturn6+eello_turn6(i,jj,kk)
7494 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7495 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7496 cd write (2,*) 'multibody_eello:eturn6',eturn6
7505 num_cont_hb(i)=num_cont_hb_old(i)
7507 c write (iout,*) "gradcorr5 in eello5"
7509 c write (iout,'(i5,3f10.5)')
7510 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7514 c------------------------------------------------------------------------------
7515 subroutine add_hb_contact_eello(ii,jj,itask)
7516 implicit real*8 (a-h,o-z)
7517 include "DIMENSIONS"
7518 include "COMMON.IOUNITS"
7521 parameter (max_cont=maxconts)
7522 parameter (max_dim=70)
7523 include "COMMON.CONTACTS"
7524 double precision zapas(max_dim,maxconts,max_fg_procs),
7525 & zapas_recv(max_dim,maxconts,max_fg_procs)
7526 common /przechowalnia/ zapas
7527 integer i,j,ii,jj,iproc,itask(4),nn
7528 c write (iout,*) "itask",itask
7531 if (iproc.gt.0) then
7532 do j=1,num_cont_hb(ii)
7534 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7536 ncont_sent(iproc)=ncont_sent(iproc)+1
7537 nn=ncont_sent(iproc)
7538 zapas(1,nn,iproc)=ii
7539 zapas(2,nn,iproc)=jjc
7540 zapas(3,nn,iproc)=d_cont(j,ii)
7544 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7549 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7557 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7569 c------------------------------------------------------------------------------
7570 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7571 implicit real*8 (a-h,o-z)
7572 include 'DIMENSIONS'
7573 include 'COMMON.IOUNITS'
7574 include 'COMMON.DERIV'
7575 include 'COMMON.INTERACT'
7576 include 'COMMON.CONTACTS'
7577 double precision gx(3),gx1(3)
7587 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7588 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7589 C Following 4 lines for diagnostics.
7594 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7595 c & 'Contacts ',i,j,
7596 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7597 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7599 C Calculate the multi-body contribution to energy.
7600 c ecorr=ecorr+ekont*ees
7601 C Calculate multi-body contributions to the gradient.
7602 coeffpees0pij=coeffp*ees0pij
7603 coeffmees0mij=coeffm*ees0mij
7604 coeffpees0pkl=coeffp*ees0pkl
7605 coeffmees0mkl=coeffm*ees0mkl
7607 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7608 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7609 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7610 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7611 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7612 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7613 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7614 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7615 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7616 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7617 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7618 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7619 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7620 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7621 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7622 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7623 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7624 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7625 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7626 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7627 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7628 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7629 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7630 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7631 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7636 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7637 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7638 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7639 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7644 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7645 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7646 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7647 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7650 c write (iout,*) "ehbcorr",ekont*ees
7655 C---------------------------------------------------------------------------
7656 subroutine dipole(i,j,jj)
7657 implicit real*8 (a-h,o-z)
7658 include 'DIMENSIONS'
7659 include 'COMMON.IOUNITS'
7660 include 'COMMON.CHAIN'
7661 include 'COMMON.FFIELD'
7662 include 'COMMON.DERIV'
7663 include 'COMMON.INTERACT'
7664 include 'COMMON.CONTACTS'
7665 include 'COMMON.TORSION'
7666 include 'COMMON.VAR'
7667 include 'COMMON.GEO'
7668 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7670 iti1 = itortyp(itype(i+1))
7671 if (j.lt.nres-1) then
7672 itj1 = itortyp(itype(j+1))
7677 dipi(iii,1)=Ub2(iii,i)
7678 dipderi(iii)=Ub2der(iii,i)
7679 dipi(iii,2)=b1(iii,i+1)
7680 dipj(iii,1)=Ub2(iii,j)
7681 dipderj(iii)=Ub2der(iii,j)
7682 dipj(iii,2)=b1(iii,j+1)
7686 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7689 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7696 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7700 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7705 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7706 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7708 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7710 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7712 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7717 C---------------------------------------------------------------------------
7718 subroutine calc_eello(i,j,k,l,jj,kk)
7720 C This subroutine computes matrices and vectors needed to calculate
7721 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7723 implicit real*8 (a-h,o-z)
7724 include 'DIMENSIONS'
7725 include 'COMMON.IOUNITS'
7726 include 'COMMON.CHAIN'
7727 include 'COMMON.DERIV'
7728 include 'COMMON.INTERACT'
7729 include 'COMMON.CONTACTS'
7730 include 'COMMON.TORSION'
7731 include 'COMMON.VAR'
7732 include 'COMMON.GEO'
7733 include 'COMMON.FFIELD'
7734 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7735 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7738 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7739 cd & ' jj=',jj,' kk=',kk
7740 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7741 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7742 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7745 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7746 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7749 call transpose2(aa1(1,1),aa1t(1,1))
7750 call transpose2(aa2(1,1),aa2t(1,1))
7753 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7754 & aa1tder(1,1,lll,kkk))
7755 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7756 & aa2tder(1,1,lll,kkk))
7760 C parallel orientation of the two CA-CA-CA frames.
7762 iti=itortyp(itype(i))
7766 itk1=itortyp(itype(k+1))
7767 itj=itortyp(itype(j))
7768 if (l.lt.nres-1) then
7769 itl1=itortyp(itype(l+1))
7773 C A1 kernel(j+1) A2T
7775 cd write (iout,'(3f10.5,5x,3f10.5)')
7776 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7778 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7779 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7780 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7781 C Following matrices are needed only for 6-th order cumulants
7782 IF (wcorr6.gt.0.0d0) THEN
7783 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7784 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7785 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7786 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7787 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7788 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7789 & ADtEAderx(1,1,1,1,1,1))
7791 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7792 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7793 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7794 & ADtEA1derx(1,1,1,1,1,1))
7796 C End 6-th order cumulants
7799 cd write (2,*) 'In calc_eello6'
7801 cd write (2,*) 'iii=',iii
7803 cd write (2,*) 'kkk=',kkk
7805 cd write (2,'(3(2f10.5),5x)')
7806 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7811 call transpose2(EUgder(1,1,k),auxmat(1,1))
7812 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7813 call transpose2(EUg(1,1,k),auxmat(1,1))
7814 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7815 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7819 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7820 & EAEAderx(1,1,lll,kkk,iii,1))
7824 C A1T kernel(i+1) A2
7825 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7826 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7827 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7828 C Following matrices are needed only for 6-th order cumulants
7829 IF (wcorr6.gt.0.0d0) THEN
7830 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7831 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7832 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7833 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7834 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7835 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7836 & ADtEAderx(1,1,1,1,1,2))
7837 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7838 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7839 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7840 & ADtEA1derx(1,1,1,1,1,2))
7842 C End 6-th order cumulants
7843 call transpose2(EUgder(1,1,l),auxmat(1,1))
7844 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7845 call transpose2(EUg(1,1,l),auxmat(1,1))
7846 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7847 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7851 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7852 & EAEAderx(1,1,lll,kkk,iii,2))
7857 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7858 C They are needed only when the fifth- or the sixth-order cumulants are
7860 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7861 call transpose2(AEA(1,1,1),auxmat(1,1))
7862 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7863 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7864 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7865 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7866 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7867 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7868 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7869 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7870 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7871 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7872 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7873 call transpose2(AEA(1,1,2),auxmat(1,1))
7874 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7875 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7876 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7877 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7878 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7879 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7880 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7881 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7882 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7883 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7884 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7885 C Calculate the Cartesian derivatives of the vectors.
7889 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7890 call matvec2(auxmat(1,1),b1(1,i),
7891 & AEAb1derx(1,lll,kkk,iii,1,1))
7892 call matvec2(auxmat(1,1),Ub2(1,i),
7893 & AEAb2derx(1,lll,kkk,iii,1,1))
7894 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7895 & AEAb1derx(1,lll,kkk,iii,2,1))
7896 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7897 & AEAb2derx(1,lll,kkk,iii,2,1))
7898 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7899 call matvec2(auxmat(1,1),b1(1,j),
7900 & AEAb1derx(1,lll,kkk,iii,1,2))
7901 call matvec2(auxmat(1,1),Ub2(1,j),
7902 & AEAb2derx(1,lll,kkk,iii,1,2))
7903 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7904 & AEAb1derx(1,lll,kkk,iii,2,2))
7905 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7906 & AEAb2derx(1,lll,kkk,iii,2,2))
7913 C Antiparallel orientation of the two CA-CA-CA frames.
7915 iti=itortyp(itype(i))
7919 itk1=itortyp(itype(k+1))
7920 itl=itortyp(itype(l))
7921 itj=itortyp(itype(j))
7922 if (j.lt.nres-1) then
7923 itj1=itortyp(itype(j+1))
7927 C A2 kernel(j-1)T A1T
7928 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7929 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7930 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7931 C Following matrices are needed only for 6-th order cumulants
7932 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7933 & j.eq.i+4 .and. l.eq.i+3)) THEN
7934 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7935 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7936 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7937 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7938 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7939 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7940 & ADtEAderx(1,1,1,1,1,1))
7941 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7942 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7943 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7944 & ADtEA1derx(1,1,1,1,1,1))
7946 C End 6-th order cumulants
7947 call transpose2(EUgder(1,1,k),auxmat(1,1))
7948 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7949 call transpose2(EUg(1,1,k),auxmat(1,1))
7950 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7951 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7955 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7956 & EAEAderx(1,1,lll,kkk,iii,1))
7960 C A2T kernel(i+1)T A1
7961 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7962 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7963 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7964 C Following matrices are needed only for 6-th order cumulants
7965 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7966 & j.eq.i+4 .and. l.eq.i+3)) THEN
7967 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7968 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7969 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7970 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7971 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7972 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7973 & ADtEAderx(1,1,1,1,1,2))
7974 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7975 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7976 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7977 & ADtEA1derx(1,1,1,1,1,2))
7979 C End 6-th order cumulants
7980 call transpose2(EUgder(1,1,j),auxmat(1,1))
7981 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7982 call transpose2(EUg(1,1,j),auxmat(1,1))
7983 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7984 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7988 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7989 & EAEAderx(1,1,lll,kkk,iii,2))
7994 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7995 C They are needed only when the fifth- or the sixth-order cumulants are
7997 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7998 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7999 call transpose2(AEA(1,1,1),auxmat(1,1))
8000 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8001 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8002 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8003 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8004 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8005 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8006 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8007 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8008 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8009 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8010 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8011 call transpose2(AEA(1,1,2),auxmat(1,1))
8012 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8013 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8014 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8015 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8016 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8017 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8018 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8019 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8020 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8021 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8022 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8023 C Calculate the Cartesian derivatives of the vectors.
8027 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8028 call matvec2(auxmat(1,1),b1(1,i),
8029 & AEAb1derx(1,lll,kkk,iii,1,1))
8030 call matvec2(auxmat(1,1),Ub2(1,i),
8031 & AEAb2derx(1,lll,kkk,iii,1,1))
8032 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8033 & AEAb1derx(1,lll,kkk,iii,2,1))
8034 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8035 & AEAb2derx(1,lll,kkk,iii,2,1))
8036 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8037 call matvec2(auxmat(1,1),b1(1,l),
8038 & AEAb1derx(1,lll,kkk,iii,1,2))
8039 call matvec2(auxmat(1,1),Ub2(1,l),
8040 & AEAb2derx(1,lll,kkk,iii,1,2))
8041 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8042 & AEAb1derx(1,lll,kkk,iii,2,2))
8043 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8044 & AEAb2derx(1,lll,kkk,iii,2,2))
8053 C---------------------------------------------------------------------------
8054 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8055 & KK,KKderg,AKA,AKAderg,AKAderx)
8059 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8060 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8061 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8066 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8068 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8071 cd if (lprn) write (2,*) 'In kernel'
8073 cd if (lprn) write (2,*) 'kkk=',kkk
8075 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8076 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8078 cd write (2,*) 'lll=',lll
8079 cd write (2,*) 'iii=1'
8081 cd write (2,'(3(2f10.5),5x)')
8082 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8085 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8086 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8088 cd write (2,*) 'lll=',lll
8089 cd write (2,*) 'iii=2'
8091 cd write (2,'(3(2f10.5),5x)')
8092 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8099 C---------------------------------------------------------------------------
8100 double precision function eello4(i,j,k,l,jj,kk)
8101 implicit real*8 (a-h,o-z)
8102 include 'DIMENSIONS'
8103 include 'COMMON.IOUNITS'
8104 include 'COMMON.CHAIN'
8105 include 'COMMON.DERIV'
8106 include 'COMMON.INTERACT'
8107 include 'COMMON.CONTACTS'
8108 include 'COMMON.TORSION'
8109 include 'COMMON.VAR'
8110 include 'COMMON.GEO'
8111 double precision pizda(2,2),ggg1(3),ggg2(3)
8112 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8116 cd print *,'eello4:',i,j,k,l,jj,kk
8117 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8118 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8119 cold eij=facont_hb(jj,i)
8120 cold ekl=facont_hb(kk,k)
8122 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8123 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8124 gcorr_loc(k-1)=gcorr_loc(k-1)
8125 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8127 gcorr_loc(l-1)=gcorr_loc(l-1)
8128 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8130 gcorr_loc(j-1)=gcorr_loc(j-1)
8131 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8136 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8137 & -EAEAderx(2,2,lll,kkk,iii,1)
8138 cd derx(lll,kkk,iii)=0.0d0
8142 cd gcorr_loc(l-1)=0.0d0
8143 cd gcorr_loc(j-1)=0.0d0
8144 cd gcorr_loc(k-1)=0.0d0
8146 cd write (iout,*)'Contacts have occurred for peptide groups',
8147 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8148 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8149 if (j.lt.nres-1) then
8156 if (l.lt.nres-1) then
8164 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8165 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8166 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8167 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8168 cgrad ghalf=0.5d0*ggg1(ll)
8169 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8170 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8171 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8172 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8173 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8174 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8175 cgrad ghalf=0.5d0*ggg2(ll)
8176 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8177 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8178 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8179 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8180 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8181 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8185 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8190 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8195 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8200 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8204 cd write (2,*) iii,gcorr_loc(iii)
8207 cd write (2,*) 'ekont',ekont
8208 cd write (iout,*) 'eello4',ekont*eel4
8211 C---------------------------------------------------------------------------
8212 double precision function eello5(i,j,k,l,jj,kk)
8213 implicit real*8 (a-h,o-z)
8214 include 'DIMENSIONS'
8215 include 'COMMON.IOUNITS'
8216 include 'COMMON.CHAIN'
8217 include 'COMMON.DERIV'
8218 include 'COMMON.INTERACT'
8219 include 'COMMON.CONTACTS'
8220 include 'COMMON.TORSION'
8221 include 'COMMON.VAR'
8222 include 'COMMON.GEO'
8223 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8224 double precision ggg1(3),ggg2(3)
8225 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8230 C /l\ / \ \ / \ / \ / C
8231 C / \ / \ \ / \ / \ / C
8232 C j| o |l1 | o | o| o | | o |o C
8233 C \ |/k\| |/ \| / |/ \| |/ \| C
8234 C \i/ \ / \ / / \ / \ C
8236 C (I) (II) (III) (IV) C
8238 C eello5_1 eello5_2 eello5_3 eello5_4 C
8240 C Antiparallel chains C
8243 C /j\ / \ \ / \ / \ / C
8244 C / \ / \ \ / \ / \ / C
8245 C j1| o |l | o | o| o | | o |o C
8246 C \ |/k\| |/ \| / |/ \| |/ \| C
8247 C \i/ \ / \ / / \ / \ C
8249 C (I) (II) (III) (IV) C
8251 C eello5_1 eello5_2 eello5_3 eello5_4 C
8253 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8255 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8256 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8261 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8263 itk=itortyp(itype(k))
8264 itl=itortyp(itype(l))
8265 itj=itortyp(itype(j))
8270 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8271 cd & eel5_3_num,eel5_4_num)
8275 derx(lll,kkk,iii)=0.0d0
8279 cd eij=facont_hb(jj,i)
8280 cd ekl=facont_hb(kk,k)
8282 cd write (iout,*)'Contacts have occurred for peptide groups',
8283 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8285 C Contribution from the graph I.
8286 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8287 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8288 call transpose2(EUg(1,1,k),auxmat(1,1))
8289 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8290 vv(1)=pizda(1,1)-pizda(2,2)
8291 vv(2)=pizda(1,2)+pizda(2,1)
8292 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8293 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8294 C Explicit gradient in virtual-dihedral angles.
8295 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8296 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8297 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8298 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8299 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8300 vv(1)=pizda(1,1)-pizda(2,2)
8301 vv(2)=pizda(1,2)+pizda(2,1)
8302 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8303 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8304 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8305 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8306 vv(1)=pizda(1,1)-pizda(2,2)
8307 vv(2)=pizda(1,2)+pizda(2,1)
8309 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8310 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8311 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8313 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8314 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8315 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8317 C Cartesian gradient
8321 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8323 vv(1)=pizda(1,1)-pizda(2,2)
8324 vv(2)=pizda(1,2)+pizda(2,1)
8325 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8326 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8327 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8333 C Contribution from graph II
8334 call transpose2(EE(1,1,itk),auxmat(1,1))
8335 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8336 vv(1)=pizda(1,1)+pizda(2,2)
8337 vv(2)=pizda(2,1)-pizda(1,2)
8338 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8339 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8340 C Explicit gradient in virtual-dihedral angles.
8341 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8342 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8343 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8344 vv(1)=pizda(1,1)+pizda(2,2)
8345 vv(2)=pizda(2,1)-pizda(1,2)
8347 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8348 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8349 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8351 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8352 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8353 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8355 C Cartesian gradient
8359 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8361 vv(1)=pizda(1,1)+pizda(2,2)
8362 vv(2)=pizda(2,1)-pizda(1,2)
8363 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8364 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8365 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8373 C Parallel orientation
8374 C Contribution from graph III
8375 call transpose2(EUg(1,1,l),auxmat(1,1))
8376 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8377 vv(1)=pizda(1,1)-pizda(2,2)
8378 vv(2)=pizda(1,2)+pizda(2,1)
8379 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8380 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8381 C Explicit gradient in virtual-dihedral angles.
8382 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8383 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8384 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8385 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8386 vv(1)=pizda(1,1)-pizda(2,2)
8387 vv(2)=pizda(1,2)+pizda(2,1)
8388 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8389 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8390 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8391 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8392 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8393 vv(1)=pizda(1,1)-pizda(2,2)
8394 vv(2)=pizda(1,2)+pizda(2,1)
8395 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8396 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8397 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8398 C Cartesian gradient
8402 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8404 vv(1)=pizda(1,1)-pizda(2,2)
8405 vv(2)=pizda(1,2)+pizda(2,1)
8406 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8407 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8408 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8413 C Contribution from graph IV
8415 call transpose2(EE(1,1,itl),auxmat(1,1))
8416 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8417 vv(1)=pizda(1,1)+pizda(2,2)
8418 vv(2)=pizda(2,1)-pizda(1,2)
8419 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8420 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8421 C Explicit gradient in virtual-dihedral angles.
8422 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8423 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8424 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8425 vv(1)=pizda(1,1)+pizda(2,2)
8426 vv(2)=pizda(2,1)-pizda(1,2)
8427 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8428 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8429 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8430 C Cartesian gradient
8434 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8436 vv(1)=pizda(1,1)+pizda(2,2)
8437 vv(2)=pizda(2,1)-pizda(1,2)
8438 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8439 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8440 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8445 C Antiparallel orientation
8446 C Contribution from graph III
8448 call transpose2(EUg(1,1,j),auxmat(1,1))
8449 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8450 vv(1)=pizda(1,1)-pizda(2,2)
8451 vv(2)=pizda(1,2)+pizda(2,1)
8452 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8453 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8454 C Explicit gradient in virtual-dihedral angles.
8455 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8456 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8457 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8458 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8459 vv(1)=pizda(1,1)-pizda(2,2)
8460 vv(2)=pizda(1,2)+pizda(2,1)
8461 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8462 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8463 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8464 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8465 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8466 vv(1)=pizda(1,1)-pizda(2,2)
8467 vv(2)=pizda(1,2)+pizda(2,1)
8468 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8469 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8470 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8471 C Cartesian gradient
8475 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8477 vv(1)=pizda(1,1)-pizda(2,2)
8478 vv(2)=pizda(1,2)+pizda(2,1)
8479 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8480 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8481 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8486 C Contribution from graph IV
8488 call transpose2(EE(1,1,itj),auxmat(1,1))
8489 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8490 vv(1)=pizda(1,1)+pizda(2,2)
8491 vv(2)=pizda(2,1)-pizda(1,2)
8492 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8493 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8494 C Explicit gradient in virtual-dihedral angles.
8495 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8496 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8497 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8498 vv(1)=pizda(1,1)+pizda(2,2)
8499 vv(2)=pizda(2,1)-pizda(1,2)
8500 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8501 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8502 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8503 C Cartesian gradient
8507 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8509 vv(1)=pizda(1,1)+pizda(2,2)
8510 vv(2)=pizda(2,1)-pizda(1,2)
8511 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8512 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8513 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8519 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8520 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8521 cd write (2,*) 'ijkl',i,j,k,l
8522 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8523 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8525 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8526 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8527 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8528 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8529 if (j.lt.nres-1) then
8536 if (l.lt.nres-1) then
8546 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8547 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8548 C summed up outside the subrouine as for the other subroutines
8549 C handling long-range interactions. The old code is commented out
8550 C with "cgrad" to keep track of changes.
8552 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8553 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8554 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8555 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8556 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8557 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8558 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8559 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8560 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8561 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8563 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8564 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8565 cgrad ghalf=0.5d0*ggg1(ll)
8567 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8568 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8569 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8570 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8571 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8572 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8573 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8574 cgrad ghalf=0.5d0*ggg2(ll)
8576 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8577 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8578 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8579 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8580 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8581 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8586 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8587 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8592 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8593 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8599 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8604 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8608 cd write (2,*) iii,g_corr5_loc(iii)
8611 cd write (2,*) 'ekont',ekont
8612 cd write (iout,*) 'eello5',ekont*eel5
8615 c--------------------------------------------------------------------------
8616 double precision function eello6(i,j,k,l,jj,kk)
8617 implicit real*8 (a-h,o-z)
8618 include 'DIMENSIONS'
8619 include 'COMMON.IOUNITS'
8620 include 'COMMON.CHAIN'
8621 include 'COMMON.DERIV'
8622 include 'COMMON.INTERACT'
8623 include 'COMMON.CONTACTS'
8624 include 'COMMON.TORSION'
8625 include 'COMMON.VAR'
8626 include 'COMMON.GEO'
8627 include 'COMMON.FFIELD'
8628 double precision ggg1(3),ggg2(3)
8629 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8634 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8642 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8643 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8647 derx(lll,kkk,iii)=0.0d0
8651 cd eij=facont_hb(jj,i)
8652 cd ekl=facont_hb(kk,k)
8658 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8659 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8660 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8661 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8662 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8663 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8665 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8666 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8667 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8668 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8669 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8670 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8674 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8676 C If turn contributions are considered, they will be handled separately.
8677 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8678 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8679 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8680 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8681 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8682 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8683 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8685 if (j.lt.nres-1) then
8692 if (l.lt.nres-1) then
8700 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8701 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8702 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8703 cgrad ghalf=0.5d0*ggg1(ll)
8705 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8706 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8707 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8708 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8709 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8710 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8711 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8712 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8713 cgrad ghalf=0.5d0*ggg2(ll)
8714 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8716 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8717 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8718 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8719 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8720 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8721 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8726 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8727 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8732 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8733 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8739 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8744 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8748 cd write (2,*) iii,g_corr6_loc(iii)
8751 cd write (2,*) 'ekont',ekont
8752 cd write (iout,*) 'eello6',ekont*eel6
8755 c--------------------------------------------------------------------------
8756 double precision function eello6_graph1(i,j,k,l,imat,swap)
8757 implicit real*8 (a-h,o-z)
8758 include 'DIMENSIONS'
8759 include 'COMMON.IOUNITS'
8760 include 'COMMON.CHAIN'
8761 include 'COMMON.DERIV'
8762 include 'COMMON.INTERACT'
8763 include 'COMMON.CONTACTS'
8764 include 'COMMON.TORSION'
8765 include 'COMMON.VAR'
8766 include 'COMMON.GEO'
8767 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8771 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8773 C Parallel Antiparallel C
8779 C \ j|/k\| / \ |/k\|l / C
8784 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8785 itk=itortyp(itype(k))
8786 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8787 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8788 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8789 call transpose2(EUgC(1,1,k),auxmat(1,1))
8790 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8791 vv1(1)=pizda1(1,1)-pizda1(2,2)
8792 vv1(2)=pizda1(1,2)+pizda1(2,1)
8793 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8794 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8795 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8796 s5=scalar2(vv(1),Dtobr2(1,i))
8797 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8798 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8799 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8800 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8801 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8802 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8803 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8804 & +scalar2(vv(1),Dtobr2der(1,i)))
8805 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8806 vv1(1)=pizda1(1,1)-pizda1(2,2)
8807 vv1(2)=pizda1(1,2)+pizda1(2,1)
8808 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8809 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8811 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8812 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8813 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8814 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8815 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8817 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8818 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8819 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8820 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8821 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8823 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8824 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8825 vv1(1)=pizda1(1,1)-pizda1(2,2)
8826 vv1(2)=pizda1(1,2)+pizda1(2,1)
8827 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8828 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8829 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8830 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8839 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8840 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8841 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8842 call transpose2(EUgC(1,1,k),auxmat(1,1))
8843 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8845 vv1(1)=pizda1(1,1)-pizda1(2,2)
8846 vv1(2)=pizda1(1,2)+pizda1(2,1)
8847 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8848 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8849 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8850 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8851 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8852 s5=scalar2(vv(1),Dtobr2(1,i))
8853 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8859 c----------------------------------------------------------------------------
8860 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8861 implicit real*8 (a-h,o-z)
8862 include 'DIMENSIONS'
8863 include 'COMMON.IOUNITS'
8864 include 'COMMON.CHAIN'
8865 include 'COMMON.DERIV'
8866 include 'COMMON.INTERACT'
8867 include 'COMMON.CONTACTS'
8868 include 'COMMON.TORSION'
8869 include 'COMMON.VAR'
8870 include 'COMMON.GEO'
8872 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8873 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8876 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8878 C Parallel Antiparallel C
8884 C \ j|/k\| \ |/k\|l C
8889 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8890 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8891 C AL 7/4/01 s1 would occur in the sixth-order moment,
8892 C but not in a cluster cumulant
8894 s1=dip(1,jj,i)*dip(1,kk,k)
8896 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8897 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8898 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8899 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8900 call transpose2(EUg(1,1,k),auxmat(1,1))
8901 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8902 vv(1)=pizda(1,1)-pizda(2,2)
8903 vv(2)=pizda(1,2)+pizda(2,1)
8904 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8905 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8907 eello6_graph2=-(s1+s2+s3+s4)
8909 eello6_graph2=-(s2+s3+s4)
8912 C Derivatives in gamma(i-1)
8915 s1=dipderg(1,jj,i)*dip(1,kk,k)
8917 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8918 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8919 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8920 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8922 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8924 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8926 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8928 C Derivatives in gamma(k-1)
8930 s1=dip(1,jj,i)*dipderg(1,kk,k)
8932 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8933 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8934 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8935 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8936 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8937 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8938 vv(1)=pizda(1,1)-pizda(2,2)
8939 vv(2)=pizda(1,2)+pizda(2,1)
8940 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8942 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8944 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8946 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8947 C Derivatives in gamma(j-1) or gamma(l-1)
8950 s1=dipderg(3,jj,i)*dip(1,kk,k)
8952 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8953 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8954 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8955 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8956 vv(1)=pizda(1,1)-pizda(2,2)
8957 vv(2)=pizda(1,2)+pizda(2,1)
8958 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8961 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8963 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8966 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8967 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8969 C Derivatives in gamma(l-1) or gamma(j-1)
8972 s1=dip(1,jj,i)*dipderg(3,kk,k)
8974 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8975 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8976 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8977 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8978 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8979 vv(1)=pizda(1,1)-pizda(2,2)
8980 vv(2)=pizda(1,2)+pizda(2,1)
8981 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8984 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8986 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8989 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8990 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8992 C Cartesian derivatives.
8994 write (2,*) 'In eello6_graph2'
8996 write (2,*) 'iii=',iii
8998 write (2,*) 'kkk=',kkk
9000 write (2,'(3(2f10.5),5x)')
9001 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9011 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9013 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9016 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9018 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9019 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9021 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9022 call transpose2(EUg(1,1,k),auxmat(1,1))
9023 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9025 vv(1)=pizda(1,1)-pizda(2,2)
9026 vv(2)=pizda(1,2)+pizda(2,1)
9027 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9028 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9030 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9032 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9035 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9037 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9044 c----------------------------------------------------------------------------
9045 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9046 implicit real*8 (a-h,o-z)
9047 include 'DIMENSIONS'
9048 include 'COMMON.IOUNITS'
9049 include 'COMMON.CHAIN'
9050 include 'COMMON.DERIV'
9051 include 'COMMON.INTERACT'
9052 include 'COMMON.CONTACTS'
9053 include 'COMMON.TORSION'
9054 include 'COMMON.VAR'
9055 include 'COMMON.GEO'
9056 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9058 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9060 C Parallel Antiparallel C
9066 C j|/k\| / |/k\|l / C
9071 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9073 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9074 C energy moment and not to the cluster cumulant.
9075 iti=itortyp(itype(i))
9076 if (j.lt.nres-1) then
9077 itj1=itortyp(itype(j+1))
9081 itk=itortyp(itype(k))
9082 itk1=itortyp(itype(k+1))
9083 if (l.lt.nres-1) then
9084 itl1=itortyp(itype(l+1))
9089 s1=dip(4,jj,i)*dip(4,kk,k)
9091 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9092 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9093 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9094 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9095 call transpose2(EE(1,1,itk),auxmat(1,1))
9096 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9097 vv(1)=pizda(1,1)+pizda(2,2)
9098 vv(2)=pizda(2,1)-pizda(1,2)
9099 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9100 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9101 cd & "sum",-(s2+s3+s4)
9103 eello6_graph3=-(s1+s2+s3+s4)
9105 eello6_graph3=-(s2+s3+s4)
9108 C Derivatives in gamma(k-1)
9109 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9110 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9111 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9112 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9113 C Derivatives in gamma(l-1)
9114 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9115 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9116 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9117 vv(1)=pizda(1,1)+pizda(2,2)
9118 vv(2)=pizda(2,1)-pizda(1,2)
9119 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9120 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9121 C Cartesian derivatives.
9127 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9129 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9132 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9134 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9135 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9137 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9138 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9140 vv(1)=pizda(1,1)+pizda(2,2)
9141 vv(2)=pizda(2,1)-pizda(1,2)
9142 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9144 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9146 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9149 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9151 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9153 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9159 c----------------------------------------------------------------------------
9160 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9161 implicit real*8 (a-h,o-z)
9162 include 'DIMENSIONS'
9163 include 'COMMON.IOUNITS'
9164 include 'COMMON.CHAIN'
9165 include 'COMMON.DERIV'
9166 include 'COMMON.INTERACT'
9167 include 'COMMON.CONTACTS'
9168 include 'COMMON.TORSION'
9169 include 'COMMON.VAR'
9170 include 'COMMON.GEO'
9171 include 'COMMON.FFIELD'
9172 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9173 & auxvec1(2),auxmat1(2,2)
9175 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9177 C Parallel Antiparallel C
9183 C \ j|/k\| \ |/k\|l C
9188 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9190 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9191 C energy moment and not to the cluster cumulant.
9192 cd write (2,*) 'eello_graph4: wturn6',wturn6
9193 iti=itortyp(itype(i))
9194 itj=itortyp(itype(j))
9195 if (j.lt.nres-1) then
9196 itj1=itortyp(itype(j+1))
9200 itk=itortyp(itype(k))
9201 if (k.lt.nres-1) then
9202 itk1=itortyp(itype(k+1))
9206 itl=itortyp(itype(l))
9207 if (l.lt.nres-1) then
9208 itl1=itortyp(itype(l+1))
9212 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9213 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9214 cd & ' itl',itl,' itl1',itl1
9217 s1=dip(3,jj,i)*dip(3,kk,k)
9219 s1=dip(2,jj,j)*dip(2,kk,l)
9222 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9223 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9225 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9226 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9228 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9229 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9231 call transpose2(EUg(1,1,k),auxmat(1,1))
9232 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9233 vv(1)=pizda(1,1)-pizda(2,2)
9234 vv(2)=pizda(2,1)+pizda(1,2)
9235 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9236 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9238 eello6_graph4=-(s1+s2+s3+s4)
9240 eello6_graph4=-(s2+s3+s4)
9242 C Derivatives in gamma(i-1)
9246 s1=dipderg(2,jj,i)*dip(3,kk,k)
9248 s1=dipderg(4,jj,j)*dip(2,kk,l)
9251 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9253 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9254 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9256 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9257 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9259 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9260 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9261 cd write (2,*) 'turn6 derivatives'
9263 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9265 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9269 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9271 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9275 C Derivatives in gamma(k-1)
9278 s1=dip(3,jj,i)*dipderg(2,kk,k)
9280 s1=dip(2,jj,j)*dipderg(4,kk,l)
9283 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9284 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9286 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9287 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9289 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9290 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9292 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9293 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9294 vv(1)=pizda(1,1)-pizda(2,2)
9295 vv(2)=pizda(2,1)+pizda(1,2)
9296 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9297 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9299 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9301 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9305 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9307 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9310 C Derivatives in gamma(j-1) or gamma(l-1)
9311 if (l.eq.j+1 .and. l.gt.1) then
9312 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9313 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9314 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9315 vv(1)=pizda(1,1)-pizda(2,2)
9316 vv(2)=pizda(2,1)+pizda(1,2)
9317 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9318 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9319 else if (j.gt.1) then
9320 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9321 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9322 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9323 vv(1)=pizda(1,1)-pizda(2,2)
9324 vv(2)=pizda(2,1)+pizda(1,2)
9325 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9326 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9327 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9329 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9332 C Cartesian derivatives.
9339 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9341 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9345 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9347 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9351 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9353 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9355 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9356 & b1(1,j+1),auxvec(1))
9357 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9359 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9360 & b1(1,l+1),auxvec(1))
9361 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9363 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9365 vv(1)=pizda(1,1)-pizda(2,2)
9366 vv(2)=pizda(2,1)+pizda(1,2)
9367 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9369 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9371 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9374 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9377 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9380 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9382 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9384 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9388 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9390 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9393 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9395 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9403 c----------------------------------------------------------------------------
9404 double precision function eello_turn6(i,jj,kk)
9405 implicit real*8 (a-h,o-z)
9406 include 'DIMENSIONS'
9407 include 'COMMON.IOUNITS'
9408 include 'COMMON.CHAIN'
9409 include 'COMMON.DERIV'
9410 include 'COMMON.INTERACT'
9411 include 'COMMON.CONTACTS'
9412 include 'COMMON.TORSION'
9413 include 'COMMON.VAR'
9414 include 'COMMON.GEO'
9415 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9416 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9418 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9419 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9420 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9421 C the respective energy moment and not to the cluster cumulant.
9430 iti=itortyp(itype(i))
9431 itk=itortyp(itype(k))
9432 itk1=itortyp(itype(k+1))
9433 itl=itortyp(itype(l))
9434 itj=itortyp(itype(j))
9435 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9436 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9437 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9442 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9444 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9448 derx_turn(lll,kkk,iii)=0.0d0
9455 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9457 cd write (2,*) 'eello6_5',eello6_5
9459 call transpose2(AEA(1,1,1),auxmat(1,1))
9460 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9461 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9462 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9464 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9465 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9466 s2 = scalar2(b1(1,k),vtemp1(1))
9468 call transpose2(AEA(1,1,2),atemp(1,1))
9469 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9470 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9471 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9473 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9474 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9475 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9477 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9478 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9479 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9480 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9481 ss13 = scalar2(b1(1,k),vtemp4(1))
9482 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9484 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9490 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9491 C Derivatives in gamma(i+2)
9495 call transpose2(AEA(1,1,1),auxmatd(1,1))
9496 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9497 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9498 call transpose2(AEAderg(1,1,2),atempd(1,1))
9499 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9500 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9502 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9503 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9504 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9510 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9511 C Derivatives in gamma(i+3)
9513 call transpose2(AEA(1,1,1),auxmatd(1,1))
9514 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9515 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9516 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9518 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9519 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9520 s2d = scalar2(b1(1,k),vtemp1d(1))
9522 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9523 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9525 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9527 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9528 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9529 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9537 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9538 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9540 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9541 & -0.5d0*ekont*(s2d+s12d)
9543 C Derivatives in gamma(i+4)
9544 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9545 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9546 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9548 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9549 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9550 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9558 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9560 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9562 C Derivatives in gamma(i+5)
9564 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9565 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9566 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9568 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9569 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9570 s2d = scalar2(b1(1,k),vtemp1d(1))
9572 call transpose2(AEA(1,1,2),atempd(1,1))
9573 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9574 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9576 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9577 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9579 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9580 ss13d = scalar2(b1(1,k),vtemp4d(1))
9581 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9589 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9590 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9592 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9593 & -0.5d0*ekont*(s2d+s12d)
9595 C Cartesian derivatives
9600 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9601 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9602 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9604 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9605 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9607 s2d = scalar2(b1(1,k),vtemp1d(1))
9609 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9610 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9611 s8d = -(atempd(1,1)+atempd(2,2))*
9612 & scalar2(cc(1,1,itl),vtemp2(1))
9614 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9616 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9617 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9624 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9627 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9631 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9632 & - 0.5d0*(s8d+s12d)
9634 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9643 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9645 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9646 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9647 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9648 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9649 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9651 ss13d = scalar2(b1(1,k),vtemp4d(1))
9652 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9653 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9657 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9658 cd & 16*eel_turn6_num
9660 if (j.lt.nres-1) then
9667 if (l.lt.nres-1) then
9675 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9676 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9677 cgrad ghalf=0.5d0*ggg1(ll)
9679 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9680 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9681 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9682 & +ekont*derx_turn(ll,2,1)
9683 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9684 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9685 & +ekont*derx_turn(ll,4,1)
9686 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9687 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9688 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9689 cgrad ghalf=0.5d0*ggg2(ll)
9691 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9692 & +ekont*derx_turn(ll,2,2)
9693 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9694 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9695 & +ekont*derx_turn(ll,4,2)
9696 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9697 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9698 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9703 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9708 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9714 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9719 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9723 cd write (2,*) iii,g_corr6_loc(iii)
9725 eello_turn6=ekont*eel_turn6
9726 cd write (2,*) 'ekont',ekont
9727 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9731 C-----------------------------------------------------------------------------
9732 double precision function scalar(u,v)
9733 !DIR$ INLINEALWAYS scalar
9735 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9738 double precision u(3),v(3)
9739 cd double precision sc
9747 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9750 crc-------------------------------------------------
9751 SUBROUTINE MATVEC2(A1,V1,V2)
9752 !DIR$ INLINEALWAYS MATVEC2
9754 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9756 implicit real*8 (a-h,o-z)
9757 include 'DIMENSIONS'
9758 DIMENSION A1(2,2),V1(2),V2(2)
9762 c 3 VI=VI+A1(I,K)*V1(K)
9766 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9767 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9772 C---------------------------------------
9773 SUBROUTINE MATMAT2(A1,A2,A3)
9775 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9777 implicit real*8 (a-h,o-z)
9778 include 'DIMENSIONS'
9779 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9780 c DIMENSION AI3(2,2)
9784 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9790 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9791 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9792 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9793 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9801 c-------------------------------------------------------------------------
9802 double precision function scalar2(u,v)
9803 !DIR$ INLINEALWAYS scalar2
9805 double precision u(2),v(2)
9808 scalar2=u(1)*v(1)+u(2)*v(2)
9812 C-----------------------------------------------------------------------------
9814 subroutine transpose2(a,at)
9815 !DIR$ INLINEALWAYS transpose2
9817 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9820 double precision a(2,2),at(2,2)
9827 c--------------------------------------------------------------------------
9828 subroutine transpose(n,a,at)
9831 double precision a(n,n),at(n,n)
9839 C---------------------------------------------------------------------------
9840 subroutine prodmat3(a1,a2,kk,transp,prod)
9841 !DIR$ INLINEALWAYS prodmat3
9843 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9847 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9849 crc double precision auxmat(2,2),prod_(2,2)
9852 crc call transpose2(kk(1,1),auxmat(1,1))
9853 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9854 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9856 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9857 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9858 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9859 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9860 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9861 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9862 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9863 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9866 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9867 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9869 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9870 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9871 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9872 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9873 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9874 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9875 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9876 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9879 c call transpose2(a2(1,1),a2t(1,1))
9882 crc print *,((prod_(i,j),i=1,2),j=1,2)
9883 crc print *,((prod(i,j),i=1,2),j=1,2)