1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
27 include 'COMMON.SPLITELE'
29 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
30 c & " nfgtasks",nfgtasks
31 if (nfgtasks.gt.1) then
33 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
34 if (fg_rank.eq.0) then
35 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
36 c print *,"Processor",myrank," BROADCAST iorder"
37 C FG master sets up the WEIGHTS_ array which will be broadcast to the
38 C FG slaves as WEIGHTS array.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
85 time_Bcast=time_Bcast+MPI_Wtime()-time00
86 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
87 c call chainbuild_cart
89 c print *,'Processor',myrank,' calling etotal ipot=',ipot
90 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
92 c if (modecalc.eq.12.or.modecalc.eq.14) then
93 c call int_from_cart1(.false.)
100 C Compute the side-chain and electrostatic interaction energy
102 goto (101,102,103,104,105,106) ipot
103 C Lennard-Jones potential.
105 cd print '(a)','Exit ELJ'
107 C Lennard-Jones-Kihara potential (shifted).
110 C Berne-Pechukas potential (dilated LJ, angular dependence).
113 C Gay-Berne potential (shifted LJ, angular dependence).
116 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
119 C Soft-sphere potential
120 106 call e_softsphere(evdw)
122 C Calculate electrostatic (H-bonding) energy of the main chain.
126 cmc Sep-06: egb takes care of dynamic ss bonds too
128 c if (dyn_ss) call dyn_set_nss
130 c print *,"Processor",myrank," computed USCSC"
136 time_vec=time_vec+MPI_Wtime()-time01
138 c print *,"Processor",myrank," left VEC_AND_DERIV"
141 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
142 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
143 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
144 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
146 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
147 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
148 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
149 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
151 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
160 write (iout,*) "Soft-spheer ELEC potential"
161 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
164 c print *,"Processor",myrank," computed UELEC"
166 C Calculate excluded-volume interaction energy between peptide groups
171 call escp(evdw2,evdw2_14)
177 c write (iout,*) "Soft-sphere SCP potential"
178 call escp_soft_sphere(evdw2,evdw2_14)
181 c Calculate the bond-stretching energy
185 C Calculate the disulfide-bridge and other energy and the contributions
186 C from other distance constraints.
187 cd print *,'Calling EHPB'
189 cd print *,'EHPB exitted succesfully.'
191 C Calculate the virtual-bond-angle energy.
193 if (wang.gt.0d0) then
198 c print *,"Processor",myrank," computed UB"
200 C Calculate the SC local energy.
203 c print *,"Processor",myrank," computed USC"
205 C Calculate the virtual-bond torsional energy.
207 cd print *,'nterm=',nterm
209 call etor(etors,edihcnstr)
214 c print *,"Processor",myrank," computed Utor"
216 C 6/23/01 Calculate double-torsional energy
218 if (wtor_d.gt.0) then
223 c print *,"Processor",myrank," computed Utord"
225 C 21/5/07 Calculate local sicdechain correlation energy
227 if (wsccor.gt.0.0d0) then
228 call eback_sc_corr(esccor)
232 c print *,"Processor",myrank," computed Usccorr"
234 C 12/1/95 Multi-body terms
238 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
239 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
240 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
241 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
242 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
249 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
250 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
251 cd write (iout,*) "multibody_hb ecorr",ecorr
253 c print *,"Processor",myrank," computed Ucorr"
255 C If performing constraint dynamics, call the constraint energy
256 C after the equilibration time
257 if(usampl.and.totT.gt.eq_time) then
265 time_enecalc=time_enecalc+MPI_Wtime()-time00
267 c print *,"Processor",myrank," computed Uconstr"
276 energia(2)=evdw2-evdw2_14
293 energia(8)=eello_turn3
294 energia(9)=eello_turn4
301 energia(19)=edihcnstr
303 energia(20)=Uconst+Uconst_back
305 c Here are the energies showed per procesor if the are more processors
306 c per molecule then we sum it up in sum_energy subroutine
307 c print *," Processor",myrank," calls SUM_ENERGY"
308 call sum_energy(energia,.true.)
309 if (dyn_ss) call dyn_set_nss
310 c print *," Processor",myrank," left SUM_ENERGY"
312 time_sumene=time_sumene+MPI_Wtime()-time00
316 c-------------------------------------------------------------------------------
317 subroutine sum_energy(energia,reduce)
318 implicit real*8 (a-h,o-z)
323 cMS$ATTRIBUTES C :: proc_proc
329 include 'COMMON.SETUP'
330 include 'COMMON.IOUNITS'
331 double precision energia(0:n_ene),enebuff(0:n_ene+1)
332 include 'COMMON.FFIELD'
333 include 'COMMON.DERIV'
334 include 'COMMON.INTERACT'
335 include 'COMMON.SBRIDGE'
336 include 'COMMON.CHAIN'
338 include 'COMMON.CONTROL'
339 include 'COMMON.TIME1'
342 if (nfgtasks.gt.1 .and. reduce) then
344 write (iout,*) "energies before REDUCE"
345 call enerprint(energia)
349 enebuff(i)=energia(i)
352 call MPI_Barrier(FG_COMM,IERR)
353 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
355 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
356 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
358 write (iout,*) "energies after REDUCE"
359 call enerprint(energia)
362 time_Reduce=time_Reduce+MPI_Wtime()-time00
364 if (fg_rank.eq.0) then
368 evdw2=energia(2)+energia(18)
384 eello_turn3=energia(8)
385 eello_turn4=energia(9)
392 edihcnstr=energia(19)
397 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
398 & +wang*ebe+wtor*etors+wscloc*escloc
399 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
400 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
401 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
402 & +wbond*estr+Uconst+wsccor*esccor
404 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
405 & +wang*ebe+wtor*etors+wscloc*escloc
406 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
407 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
408 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
409 & +wbond*estr+Uconst+wsccor*esccor
415 if (isnan(etot).ne.0) energia(0)=1.0d+99
417 if (isnan(etot)) energia(0)=1.0d+99
422 idumm=proc_proc(etot,i)
424 call proc_proc(etot,i)
426 if(i.eq.1)energia(0)=1.0d+99
433 c-------------------------------------------------------------------------------
434 subroutine sum_gradient
435 implicit real*8 (a-h,o-z)
440 cMS$ATTRIBUTES C :: proc_proc
446 double precision gradbufc(3,maxres),gradbufx(3,maxres),
447 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
448 include 'COMMON.SETUP'
449 include 'COMMON.IOUNITS'
450 include 'COMMON.FFIELD'
451 include 'COMMON.DERIV'
452 include 'COMMON.INTERACT'
453 include 'COMMON.SBRIDGE'
454 include 'COMMON.CHAIN'
456 include 'COMMON.CONTROL'
457 include 'COMMON.TIME1'
458 include 'COMMON.MAXGRAD'
459 include 'COMMON.SCCOR'
464 write (iout,*) "sum_gradient gvdwc, gvdwx"
466 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
467 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
472 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
473 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
474 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
477 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
478 C in virtual-bond-vector coordinates
481 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
483 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
484 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
486 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
488 c write (iout,'(i5,3f10.5,2x,f10.5)')
489 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
491 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
493 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
494 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
502 gradbufc(j,i)=wsc*gvdwc(j,i)+
503 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
504 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
505 & wel_loc*gel_loc_long(j,i)+
506 & wcorr*gradcorr_long(j,i)+
507 & wcorr5*gradcorr5_long(j,i)+
508 & wcorr6*gradcorr6_long(j,i)+
509 & wturn6*gcorr6_turn_long(j,i)+
516 gradbufc(j,i)=wsc*gvdwc(j,i)+
517 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
518 & welec*gelc_long(j,i)+
520 & wel_loc*gel_loc_long(j,i)+
521 & wcorr*gradcorr_long(j,i)+
522 & wcorr5*gradcorr5_long(j,i)+
523 & wcorr6*gradcorr6_long(j,i)+
524 & wturn6*gcorr6_turn_long(j,i)+
530 if (nfgtasks.gt.1) then
533 write (iout,*) "gradbufc before allreduce"
535 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
541 gradbufc_sum(j,i)=gradbufc(j,i)
544 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
545 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
546 c time_reduce=time_reduce+MPI_Wtime()-time00
548 c write (iout,*) "gradbufc_sum after allreduce"
550 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
555 c time_allreduce=time_allreduce+MPI_Wtime()-time00
563 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
564 write (iout,*) (i," jgrad_start",jgrad_start(i),
565 & " jgrad_end ",jgrad_end(i),
566 & i=igrad_start,igrad_end)
569 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
570 c do not parallelize this part.
572 c do i=igrad_start,igrad_end
573 c do j=jgrad_start(i),jgrad_end(i)
575 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
580 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
584 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
588 write (iout,*) "gradbufc after summing"
590 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
597 write (iout,*) "gradbufc"
599 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
605 gradbufc_sum(j,i)=gradbufc(j,i)
610 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
614 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
619 c gradbufc(k,i)=0.0d0
623 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
628 write (iout,*) "gradbufc after summing"
630 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
638 gradbufc(k,nres)=0.0d0
643 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
644 & wel_loc*gel_loc(j,i)+
645 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
646 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
647 & wel_loc*gel_loc_long(j,i)+
648 & wcorr*gradcorr_long(j,i)+
649 & wcorr5*gradcorr5_long(j,i)+
650 & wcorr6*gradcorr6_long(j,i)+
651 & wturn6*gcorr6_turn_long(j,i))+
653 & wcorr*gradcorr(j,i)+
654 & wturn3*gcorr3_turn(j,i)+
655 & wturn4*gcorr4_turn(j,i)+
656 & wcorr5*gradcorr5(j,i)+
657 & wcorr6*gradcorr6(j,i)+
658 & wturn6*gcorr6_turn(j,i)+
659 & wsccor*gsccorc(j,i)
660 & +wscloc*gscloc(j,i)
662 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
663 & wel_loc*gel_loc(j,i)+
664 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
665 & welec*gelc_long(j,i)
666 & wel_loc*gel_loc_long(j,i)+
667 & wcorr*gcorr_long(j,i)+
668 & wcorr5*gradcorr5_long(j,i)+
669 & wcorr6*gradcorr6_long(j,i)+
670 & wturn6*gcorr6_turn_long(j,i))+
672 & wcorr*gradcorr(j,i)+
673 & wturn3*gcorr3_turn(j,i)+
674 & wturn4*gcorr4_turn(j,i)+
675 & wcorr5*gradcorr5(j,i)+
676 & wcorr6*gradcorr6(j,i)+
677 & wturn6*gcorr6_turn(j,i)+
678 & wsccor*gsccorc(j,i)
679 & +wscloc*gscloc(j,i)
681 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
683 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
684 & wsccor*gsccorx(j,i)
685 & +wscloc*gsclocx(j,i)
689 write (iout,*) "gloc before adding corr"
691 write (iout,*) i,gloc(i,icg)
695 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
696 & +wcorr5*g_corr5_loc(i)
697 & +wcorr6*g_corr6_loc(i)
698 & +wturn4*gel_loc_turn4(i)
699 & +wturn3*gel_loc_turn3(i)
700 & +wturn6*gel_loc_turn6(i)
701 & +wel_loc*gel_loc_loc(i)
704 write (iout,*) "gloc after adding corr"
706 write (iout,*) i,gloc(i,icg)
710 if (nfgtasks.gt.1) then
713 gradbufc(j,i)=gradc(j,i,icg)
714 gradbufx(j,i)=gradx(j,i,icg)
718 glocbuf(i)=gloc(i,icg)
722 write (iout,*) "gloc_sc before reduce"
725 write (iout,*) i,j,gloc_sc(j,i,icg)
732 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
736 call MPI_Barrier(FG_COMM,IERR)
737 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
739 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
740 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
741 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
742 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
743 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
744 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
745 time_reduce=time_reduce+MPI_Wtime()-time00
746 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
747 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
748 time_reduce=time_reduce+MPI_Wtime()-time00
751 write (iout,*) "gloc_sc after reduce"
754 write (iout,*) i,j,gloc_sc(j,i,icg)
760 write (iout,*) "gloc after reduce"
762 write (iout,*) i,gloc(i,icg)
767 if (gnorm_check) then
769 c Compute the maximum elements of the gradient
779 gcorr3_turn_max=0.0d0
780 gcorr4_turn_max=0.0d0
783 gcorr6_turn_max=0.0d0
793 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
794 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
795 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
796 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
797 & gvdwc_scp_max=gvdwc_scp_norm
798 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
799 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
800 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
801 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
802 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
803 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
804 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
805 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
806 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
807 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
808 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
809 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
810 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
812 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
813 & gcorr3_turn_max=gcorr3_turn_norm
814 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
816 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
817 & gcorr4_turn_max=gcorr4_turn_norm
818 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
819 if (gradcorr5_norm.gt.gradcorr5_max)
820 & gradcorr5_max=gradcorr5_norm
821 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
822 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
823 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
825 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
826 & gcorr6_turn_max=gcorr6_turn_norm
827 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
828 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
829 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
830 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
831 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
832 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
833 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
834 if (gradx_scp_norm.gt.gradx_scp_max)
835 & gradx_scp_max=gradx_scp_norm
836 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
837 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
838 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
839 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
840 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
841 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
842 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
843 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
847 open(istat,file=statname,position="append")
849 open(istat,file=statname,access="append")
851 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
852 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
853 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
854 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
855 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
856 & gsccorx_max,gsclocx_max
858 if (gvdwc_max.gt.1.0d4) then
859 write (iout,*) "gvdwc gvdwx gradb gradbx"
861 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
862 & gradb(j,i),gradbx(j,i),j=1,3)
864 call pdbout(0.0d0,'cipiszcze',iout)
870 write (iout,*) "gradc gradx gloc"
872 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
873 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
877 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
881 c-------------------------------------------------------------------------------
882 subroutine rescale_weights(t_bath)
883 implicit real*8 (a-h,o-z)
885 include 'COMMON.IOUNITS'
886 include 'COMMON.FFIELD'
887 include 'COMMON.SBRIDGE'
888 double precision kfac /2.4d0/
889 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
891 c facT=2*temp0/(t_bath+temp0)
892 if (rescale_mode.eq.0) then
898 else if (rescale_mode.eq.1) then
899 facT=kfac/(kfac-1.0d0+t_bath/temp0)
900 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
901 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
902 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
903 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
904 else if (rescale_mode.eq.2) then
910 facT=licznik/dlog(dexp(x)+dexp(-x))
911 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
912 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
913 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
914 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
916 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
917 write (*,*) "Wrong RESCALE_MODE",rescale_mode
919 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
923 welec=weights(3)*fact
924 wcorr=weights(4)*fact3
925 wcorr5=weights(5)*fact4
926 wcorr6=weights(6)*fact5
927 wel_loc=weights(7)*fact2
928 wturn3=weights(8)*fact2
929 wturn4=weights(9)*fact3
930 wturn6=weights(10)*fact5
931 wtor=weights(13)*fact
932 wtor_d=weights(14)*fact2
933 wsccor=weights(21)*fact
937 C------------------------------------------------------------------------
938 subroutine enerprint(energia)
939 implicit real*8 (a-h,o-z)
941 include 'COMMON.IOUNITS'
942 include 'COMMON.FFIELD'
943 include 'COMMON.SBRIDGE'
945 double precision energia(0:n_ene)
950 evdw2=energia(2)+energia(18)
962 eello_turn3=energia(8)
963 eello_turn4=energia(9)
964 eello_turn6=energia(10)
970 edihcnstr=energia(19)
975 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
976 & estr,wbond,ebe,wang,
977 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
979 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
980 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
983 10 format (/'Virtual-chain energies:'//
984 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
985 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
986 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
987 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
988 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
989 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
990 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
991 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
992 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
993 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
994 & ' (SS bridges & dist. cnstr.)'/
995 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
996 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
997 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
998 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
999 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1000 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1001 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1002 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1003 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1004 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1005 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1006 & 'ETOT= ',1pE16.6,' (total)')
1008 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1009 & estr,wbond,ebe,wang,
1010 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1012 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1013 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1014 & ebr*nss,Uconst,etot
1015 10 format (/'Virtual-chain energies:'//
1016 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1017 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1018 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1019 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1020 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1021 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1022 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1023 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1024 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1025 & ' (SS bridges & dist. cnstr.)'/
1026 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1027 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1028 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1029 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1030 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1031 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1032 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1033 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1034 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1035 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1036 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1037 & 'ETOT= ',1pE16.6,' (total)')
1041 C-----------------------------------------------------------------------
1042 subroutine elj(evdw)
1044 C This subroutine calculates the interaction energy of nonbonded side chains
1045 C assuming the LJ potential of interaction.
1047 implicit real*8 (a-h,o-z)
1048 include 'DIMENSIONS'
1049 parameter (accur=1.0d-10)
1050 include 'COMMON.GEO'
1051 include 'COMMON.VAR'
1052 include 'COMMON.LOCAL'
1053 include 'COMMON.CHAIN'
1054 include 'COMMON.DERIV'
1055 include 'COMMON.INTERACT'
1056 include 'COMMON.TORSION'
1057 include 'COMMON.SBRIDGE'
1058 include 'COMMON.NAMES'
1059 include 'COMMON.IOUNITS'
1060 include 'COMMON.CONTACTS'
1062 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1064 do i=iatsc_s,iatsc_e
1065 itypi=iabs(itype(i))
1066 if (itypi.eq.ntyp1) cycle
1067 itypi1=iabs(itype(i+1))
1074 C Calculate SC interaction energy.
1076 do iint=1,nint_gr(i)
1077 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1078 cd & 'iend=',iend(i,iint)
1079 do j=istart(i,iint),iend(i,iint)
1080 itypj=iabs(itype(j))
1081 if (itypj.eq.ntyp1) cycle
1085 C Change 12/1/95 to calculate four-body interactions
1086 rij=xj*xj+yj*yj+zj*zj
1088 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1089 eps0ij=eps(itypi,itypj)
1091 e1=fac*fac*aa(itypi,itypj)
1092 e2=fac*bb(itypi,itypj)
1094 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1095 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1096 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1097 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1098 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1099 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1102 C Calculate the components of the gradient in DC and X
1104 fac=-rrij*(e1+evdwij)
1109 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1110 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1111 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1112 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1116 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1120 C 12/1/95, revised on 5/20/97
1122 C Calculate the contact function. The ith column of the array JCONT will
1123 C contain the numbers of atoms that make contacts with the atom I (of numbers
1124 C greater than I). The arrays FACONT and GACONT will contain the values of
1125 C the contact function and its derivative.
1127 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1128 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1129 C Uncomment next line, if the correlation interactions are contact function only
1130 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1132 sigij=sigma(itypi,itypj)
1133 r0ij=rs0(itypi,itypj)
1135 C Check whether the SC's are not too far to make a contact.
1138 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1139 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1141 if (fcont.gt.0.0D0) then
1142 C If the SC-SC distance if close to sigma, apply spline.
1143 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1144 cAdam & fcont1,fprimcont1)
1145 cAdam fcont1=1.0d0-fcont1
1146 cAdam if (fcont1.gt.0.0d0) then
1147 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1148 cAdam fcont=fcont*fcont1
1150 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1151 cga eps0ij=1.0d0/dsqrt(eps0ij)
1153 cga gg(k)=gg(k)*eps0ij
1155 cga eps0ij=-evdwij*eps0ij
1156 C Uncomment for AL's type of SC correlation interactions.
1157 cadam eps0ij=-evdwij
1158 num_conti=num_conti+1
1159 jcont(num_conti,i)=j
1160 facont(num_conti,i)=fcont*eps0ij
1161 fprimcont=eps0ij*fprimcont/rij
1163 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1164 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1165 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1166 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1167 gacont(1,num_conti,i)=-fprimcont*xj
1168 gacont(2,num_conti,i)=-fprimcont*yj
1169 gacont(3,num_conti,i)=-fprimcont*zj
1170 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1171 cd write (iout,'(2i3,3f10.5)')
1172 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1178 num_cont(i)=num_conti
1182 gvdwc(j,i)=expon*gvdwc(j,i)
1183 gvdwx(j,i)=expon*gvdwx(j,i)
1186 C******************************************************************************
1190 C To save time, the factor of EXPON has been extracted from ALL components
1191 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1194 C******************************************************************************
1197 C-----------------------------------------------------------------------------
1198 subroutine eljk(evdw)
1200 C This subroutine calculates the interaction energy of nonbonded side chains
1201 C assuming the LJK potential of interaction.
1203 implicit real*8 (a-h,o-z)
1204 include 'DIMENSIONS'
1205 include 'COMMON.GEO'
1206 include 'COMMON.VAR'
1207 include 'COMMON.LOCAL'
1208 include 'COMMON.CHAIN'
1209 include 'COMMON.DERIV'
1210 include 'COMMON.INTERACT'
1211 include 'COMMON.IOUNITS'
1212 include 'COMMON.NAMES'
1215 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1217 do i=iatsc_s,iatsc_e
1218 itypi=iabs(itype(i))
1219 if (itypi.eq.ntyp1) cycle
1220 itypi1=iabs(itype(i+1))
1225 C Calculate SC interaction energy.
1227 do iint=1,nint_gr(i)
1228 do j=istart(i,iint),iend(i,iint)
1229 itypj=iabs(itype(j))
1230 if (itypj.eq.ntyp1) cycle
1234 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1235 fac_augm=rrij**expon
1236 e_augm=augm(itypi,itypj)*fac_augm
1237 r_inv_ij=dsqrt(rrij)
1239 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1240 fac=r_shift_inv**expon
1241 e1=fac*fac*aa(itypi,itypj)
1242 e2=fac*bb(itypi,itypj)
1244 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1245 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1246 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1247 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1248 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1249 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1250 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1253 C Calculate the components of the gradient in DC and X
1255 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1260 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1261 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1262 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1263 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1267 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1275 gvdwc(j,i)=expon*gvdwc(j,i)
1276 gvdwx(j,i)=expon*gvdwx(j,i)
1281 C-----------------------------------------------------------------------------
1282 subroutine ebp(evdw)
1284 C This subroutine calculates the interaction energy of nonbonded side chains
1285 C assuming the Berne-Pechukas potential of interaction.
1287 implicit real*8 (a-h,o-z)
1288 include 'DIMENSIONS'
1289 include 'COMMON.GEO'
1290 include 'COMMON.VAR'
1291 include 'COMMON.LOCAL'
1292 include 'COMMON.CHAIN'
1293 include 'COMMON.DERIV'
1294 include 'COMMON.NAMES'
1295 include 'COMMON.INTERACT'
1296 include 'COMMON.IOUNITS'
1297 include 'COMMON.CALC'
1298 common /srutu/ icall
1299 c double precision rrsave(maxdim)
1302 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1304 c if (icall.eq.0) then
1310 do i=iatsc_s,iatsc_e
1311 itypi=iabs(itype(i))
1312 if (itypi.eq.ntyp1) cycle
1313 itypi1=iabs(itype(i+1))
1317 dxi=dc_norm(1,nres+i)
1318 dyi=dc_norm(2,nres+i)
1319 dzi=dc_norm(3,nres+i)
1320 c dsci_inv=dsc_inv(itypi)
1321 dsci_inv=vbld_inv(i+nres)
1323 C Calculate SC interaction energy.
1325 do iint=1,nint_gr(i)
1326 do j=istart(i,iint),iend(i,iint)
1328 itypj=iabs(itype(j))
1329 if (itypj.eq.ntyp1) cycle
1330 c dscj_inv=dsc_inv(itypj)
1331 dscj_inv=vbld_inv(j+nres)
1332 chi1=chi(itypi,itypj)
1333 chi2=chi(itypj,itypi)
1340 alf12=0.5D0*(alf1+alf2)
1341 C For diagnostics only!!!
1354 dxj=dc_norm(1,nres+j)
1355 dyj=dc_norm(2,nres+j)
1356 dzj=dc_norm(3,nres+j)
1357 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1358 cd if (icall.eq.0) then
1364 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1366 C Calculate whole angle-dependent part of epsilon and contributions
1367 C to its derivatives
1368 fac=(rrij*sigsq)**expon2
1369 e1=fac*fac*aa(itypi,itypj)
1370 e2=fac*bb(itypi,itypj)
1371 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1372 eps2der=evdwij*eps3rt
1373 eps3der=evdwij*eps2rt
1374 evdwij=evdwij*eps2rt*eps3rt
1377 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1378 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1379 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1380 cd & restyp(itypi),i,restyp(itypj),j,
1381 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1382 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1383 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1386 C Calculate gradient components.
1387 e1=e1*eps1*eps2rt**2*eps3rt**2
1388 fac=-expon*(e1+evdwij)
1391 C Calculate radial part of the gradient
1395 C Calculate the angular part of the gradient and sum add the contributions
1396 C to the appropriate components of the Cartesian gradient.
1404 C-----------------------------------------------------------------------------
1405 subroutine egb(evdw)
1407 C This subroutine calculates the interaction energy of nonbonded side chains
1408 C assuming the Gay-Berne potential of interaction.
1410 implicit real*8 (a-h,o-z)
1411 include 'DIMENSIONS'
1412 include 'COMMON.GEO'
1413 include 'COMMON.VAR'
1414 include 'COMMON.LOCAL'
1415 include 'COMMON.CHAIN'
1416 include 'COMMON.DERIV'
1417 include 'COMMON.NAMES'
1418 include 'COMMON.INTERACT'
1419 include 'COMMON.IOUNITS'
1420 include 'COMMON.CALC'
1421 include 'COMMON.CONTROL'
1422 include 'COMMON.SPLITELE'
1423 include 'COMMON.SBRIDGE'
1425 integer xshift,yshift,zshift
1427 ccccc energy_dec=.false.
1428 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1431 c if (icall.eq.0) lprn=.false.
1433 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1434 C we have the original box)
1438 do i=iatsc_s,iatsc_e
1439 itypi=iabs(itype(i))
1440 if (itypi.eq.ntyp1) cycle
1441 itypi1=iabs(itype(i+1))
1445 C Return atom into box, boxxsize is size of box in x dimension
1447 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1448 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1449 C Condition for being inside the proper box
1450 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1451 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1455 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1456 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1457 C Condition for being inside the proper box
1458 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1459 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1463 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1464 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1465 C Condition for being inside the proper box
1466 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1467 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1471 if (xi.lt.0) xi=xi+boxxsize
1473 if (yi.lt.0) yi=yi+boxysize
1475 if (zi.lt.0) zi=zi+boxzsize
1476 C xi=xi+xshift*boxxsize
1477 C yi=yi+yshift*boxysize
1478 C zi=zi+zshift*boxzsize
1480 dxi=dc_norm(1,nres+i)
1481 dyi=dc_norm(2,nres+i)
1482 dzi=dc_norm(3,nres+i)
1483 c dsci_inv=dsc_inv(itypi)
1484 dsci_inv=vbld_inv(i+nres)
1485 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1486 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1488 C Calculate SC interaction energy.
1490 do iint=1,nint_gr(i)
1491 do j=istart(i,iint),iend(i,iint)
1492 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1493 call dyn_ssbond_ene(i,j,evdwij)
1495 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1496 & 'evdw',i,j,evdwij,' ss'
1499 itypj=iabs(itype(j))
1500 if (itypj.eq.ntyp1) cycle
1501 c dscj_inv=dsc_inv(itypj)
1502 dscj_inv=vbld_inv(j+nres)
1503 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1504 c & 1.0d0/vbld(j+nres)
1505 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1506 sig0ij=sigma(itypi,itypj)
1507 chi1=chi(itypi,itypj)
1508 chi2=chi(itypj,itypi)
1515 alf12=0.5D0*(alf1+alf2)
1516 C For diagnostics only!!!
1529 C Return atom J into box the original box
1531 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1532 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1533 C Condition for being inside the proper box
1534 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1535 c & (xj.lt.((-0.5d0)*boxxsize))) then
1539 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1540 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1541 C Condition for being inside the proper box
1542 c if ((yj.gt.((0.5d0)*boxysize)).or.
1543 c & (yj.lt.((-0.5d0)*boxysize))) then
1547 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1548 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1549 C Condition for being inside the proper box
1550 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1551 c & (zj.lt.((-0.5d0)*boxzsize))) then
1555 if (xj.lt.0) xj=xj+boxxsize
1557 if (yj.lt.0) yj=yj+boxysize
1559 if (zj.lt.0) zj=zj+boxzsize
1560 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1568 xj=xj_safe+xshift*boxxsize
1569 yj=yj_safe+yshift*boxysize
1570 zj=zj_safe+zshift*boxzsize
1571 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1572 if(dist_temp.lt.dist_init) then
1582 if (subchap.eq.1) then
1591 dxj=dc_norm(1,nres+j)
1592 dyj=dc_norm(2,nres+j)
1593 dzj=dc_norm(3,nres+j)
1597 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1598 c write (iout,*) "j",j," dc_norm",
1599 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1600 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1602 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1603 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1605 c write (iout,'(a7,4f8.3)')
1606 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1607 if (sss.gt.0.0d0) then
1608 C Calculate angle-dependent terms of energy and contributions to their
1612 sig=sig0ij*dsqrt(sigsq)
1613 rij_shift=1.0D0/rij-sig+sig0ij
1614 c for diagnostics; uncomment
1615 c rij_shift=1.2*sig0ij
1616 C I hate to put IF's in the loops, but here don't have another choice!!!!
1617 if (rij_shift.le.0.0D0) then
1619 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1620 cd & restyp(itypi),i,restyp(itypj),j,
1621 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1625 c---------------------------------------------------------------
1626 rij_shift=1.0D0/rij_shift
1627 fac=rij_shift**expon
1628 e1=fac*fac*aa(itypi,itypj)
1629 e2=fac*bb(itypi,itypj)
1630 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1631 eps2der=evdwij*eps3rt
1632 eps3der=evdwij*eps2rt
1633 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1634 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1635 evdwij=evdwij*eps2rt*eps3rt
1636 evdw=evdw+evdwij*sss
1638 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1639 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1640 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1641 & restyp(itypi),i,restyp(itypj),j,
1642 & epsi,sigm,chi1,chi2,chip1,chip2,
1643 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1644 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1648 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1651 C Calculate gradient components.
1652 e1=e1*eps1*eps2rt**2*eps3rt**2
1653 fac=-expon*(e1+evdwij)*rij_shift
1656 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1657 c & evdwij,fac,sigma(itypi,itypj),expon
1658 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1660 C Calculate the radial part of the gradient
1664 C Calculate angular part of the gradient.
1674 c write (iout,*) "Number of loop steps in EGB:",ind
1675 cccc energy_dec=.false.
1678 C-----------------------------------------------------------------------------
1679 subroutine egbv(evdw)
1681 C This subroutine calculates the interaction energy of nonbonded side chains
1682 C assuming the Gay-Berne-Vorobjev potential of interaction.
1684 implicit real*8 (a-h,o-z)
1685 include 'DIMENSIONS'
1686 include 'COMMON.GEO'
1687 include 'COMMON.VAR'
1688 include 'COMMON.LOCAL'
1689 include 'COMMON.CHAIN'
1690 include 'COMMON.DERIV'
1691 include 'COMMON.NAMES'
1692 include 'COMMON.INTERACT'
1693 include 'COMMON.IOUNITS'
1694 include 'COMMON.CALC'
1695 common /srutu/ icall
1698 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1701 c if (icall.eq.0) lprn=.true.
1703 do i=iatsc_s,iatsc_e
1704 itypi=iabs(itype(i))
1705 if (itypi.eq.ntyp1) cycle
1706 itypi1=iabs(itype(i+1))
1710 dxi=dc_norm(1,nres+i)
1711 dyi=dc_norm(2,nres+i)
1712 dzi=dc_norm(3,nres+i)
1713 c dsci_inv=dsc_inv(itypi)
1714 dsci_inv=vbld_inv(i+nres)
1716 C Calculate SC interaction energy.
1718 do iint=1,nint_gr(i)
1719 do j=istart(i,iint),iend(i,iint)
1721 itypj=iabs(itype(j))
1722 if (itypj.eq.ntyp1) cycle
1723 c dscj_inv=dsc_inv(itypj)
1724 dscj_inv=vbld_inv(j+nres)
1725 sig0ij=sigma(itypi,itypj)
1726 r0ij=r0(itypi,itypj)
1727 chi1=chi(itypi,itypj)
1728 chi2=chi(itypj,itypi)
1735 alf12=0.5D0*(alf1+alf2)
1736 C For diagnostics only!!!
1749 dxj=dc_norm(1,nres+j)
1750 dyj=dc_norm(2,nres+j)
1751 dzj=dc_norm(3,nres+j)
1752 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1754 C Calculate angle-dependent terms of energy and contributions to their
1758 sig=sig0ij*dsqrt(sigsq)
1759 rij_shift=1.0D0/rij-sig+r0ij
1760 C I hate to put IF's in the loops, but here don't have another choice!!!!
1761 if (rij_shift.le.0.0D0) then
1766 c---------------------------------------------------------------
1767 rij_shift=1.0D0/rij_shift
1768 fac=rij_shift**expon
1769 e1=fac*fac*aa(itypi,itypj)
1770 e2=fac*bb(itypi,itypj)
1771 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1772 eps2der=evdwij*eps3rt
1773 eps3der=evdwij*eps2rt
1774 fac_augm=rrij**expon
1775 e_augm=augm(itypi,itypj)*fac_augm
1776 evdwij=evdwij*eps2rt*eps3rt
1777 evdw=evdw+evdwij+e_augm
1779 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1780 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1781 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1782 & restyp(itypi),i,restyp(itypj),j,
1783 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1784 & chi1,chi2,chip1,chip2,
1785 & eps1,eps2rt**2,eps3rt**2,
1786 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1789 C Calculate gradient components.
1790 e1=e1*eps1*eps2rt**2*eps3rt**2
1791 fac=-expon*(e1+evdwij)*rij_shift
1793 fac=rij*fac-2*expon*rrij*e_augm
1794 C Calculate the radial part of the gradient
1798 C Calculate angular part of the gradient.
1804 C-----------------------------------------------------------------------------
1805 subroutine sc_angular
1806 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1807 C om12. Called by ebp, egb, and egbv.
1809 include 'COMMON.CALC'
1810 include 'COMMON.IOUNITS'
1814 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1815 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1816 om12=dxi*dxj+dyi*dyj+dzi*dzj
1818 C Calculate eps1(om12) and its derivative in om12
1819 faceps1=1.0D0-om12*chiom12
1820 faceps1_inv=1.0D0/faceps1
1821 eps1=dsqrt(faceps1_inv)
1822 C Following variable is eps1*deps1/dom12
1823 eps1_om12=faceps1_inv*chiom12
1828 c write (iout,*) "om12",om12," eps1",eps1
1829 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1834 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1835 sigsq=1.0D0-facsig*faceps1_inv
1836 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1837 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1838 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1844 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1845 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1847 C Calculate eps2 and its derivatives in om1, om2, and om12.
1850 chipom12=chip12*om12
1851 facp=1.0D0-om12*chipom12
1853 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1854 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1855 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1856 C Following variable is the square root of eps2
1857 eps2rt=1.0D0-facp1*facp_inv
1858 C Following three variables are the derivatives of the square root of eps
1859 C in om1, om2, and om12.
1860 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1861 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1862 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1863 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1864 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1865 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1866 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1867 c & " eps2rt_om12",eps2rt_om12
1868 C Calculate whole angle-dependent part of epsilon and contributions
1869 C to its derivatives
1872 C----------------------------------------------------------------------------
1874 implicit real*8 (a-h,o-z)
1875 include 'DIMENSIONS'
1876 include 'COMMON.CHAIN'
1877 include 'COMMON.DERIV'
1878 include 'COMMON.CALC'
1879 include 'COMMON.IOUNITS'
1880 double precision dcosom1(3),dcosom2(3)
1881 cc print *,'sss=',sss
1882 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1883 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1884 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1885 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1889 c eom12=evdwij*eps1_om12
1891 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1892 c & " sigder",sigder
1893 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1894 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1896 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1897 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1900 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
1902 c write (iout,*) "gg",(gg(k),k=1,3)
1904 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1905 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1906 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
1907 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1908 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1909 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
1910 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1911 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1912 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1913 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1916 C Calculate the components of the gradient in DC and X
1920 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1924 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1925 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1929 C-----------------------------------------------------------------------
1930 subroutine e_softsphere(evdw)
1932 C This subroutine calculates the interaction energy of nonbonded side chains
1933 C assuming the LJ potential of interaction.
1935 implicit real*8 (a-h,o-z)
1936 include 'DIMENSIONS'
1937 parameter (accur=1.0d-10)
1938 include 'COMMON.GEO'
1939 include 'COMMON.VAR'
1940 include 'COMMON.LOCAL'
1941 include 'COMMON.CHAIN'
1942 include 'COMMON.DERIV'
1943 include 'COMMON.INTERACT'
1944 include 'COMMON.TORSION'
1945 include 'COMMON.SBRIDGE'
1946 include 'COMMON.NAMES'
1947 include 'COMMON.IOUNITS'
1948 include 'COMMON.CONTACTS'
1950 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1952 do i=iatsc_s,iatsc_e
1953 itypi=iabs(itype(i))
1954 if (itypi.eq.ntyp1) cycle
1955 itypi1=iabs(itype(i+1))
1960 C Calculate SC interaction energy.
1962 do iint=1,nint_gr(i)
1963 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1964 cd & 'iend=',iend(i,iint)
1965 do j=istart(i,iint),iend(i,iint)
1966 itypj=iabs(itype(j))
1967 if (itypj.eq.ntyp1) cycle
1971 rij=xj*xj+yj*yj+zj*zj
1972 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1973 r0ij=r0(itypi,itypj)
1975 c print *,i,j,r0ij,dsqrt(rij)
1976 if (rij.lt.r0ijsq) then
1977 evdwij=0.25d0*(rij-r0ijsq)**2
1985 C Calculate the components of the gradient in DC and X
1991 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1992 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1993 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1994 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1998 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2006 C--------------------------------------------------------------------------
2007 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2010 C Soft-sphere potential of p-p interaction
2012 implicit real*8 (a-h,o-z)
2013 include 'DIMENSIONS'
2014 include 'COMMON.CONTROL'
2015 include 'COMMON.IOUNITS'
2016 include 'COMMON.GEO'
2017 include 'COMMON.VAR'
2018 include 'COMMON.LOCAL'
2019 include 'COMMON.CHAIN'
2020 include 'COMMON.DERIV'
2021 include 'COMMON.INTERACT'
2022 include 'COMMON.CONTACTS'
2023 include 'COMMON.TORSION'
2024 include 'COMMON.VECTORS'
2025 include 'COMMON.FFIELD'
2027 C write(iout,*) 'In EELEC_soft_sphere'
2034 do i=iatel_s,iatel_e
2035 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2039 xmedi=c(1,i)+0.5d0*dxi
2040 ymedi=c(2,i)+0.5d0*dyi
2041 zmedi=c(3,i)+0.5d0*dzi
2042 xmedi=mod(xmedi,boxxsize)
2043 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2044 ymedi=mod(ymedi,boxysize)
2045 if (ymedi.lt.0) ymedi=ymedi+boxysize
2046 zmedi=mod(zmedi,boxzsize)
2047 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2049 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2050 do j=ielstart(i),ielend(i)
2051 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2055 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2056 r0ij=rpp(iteli,itelj)
2065 if (xj.lt.0) xj=xj+boxxsize
2067 if (yj.lt.0) yj=yj+boxysize
2069 if (zj.lt.0) zj=zj+boxzsize
2070 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2078 xj=xj_safe+xshift*boxxsize
2079 yj=yj_safe+yshift*boxysize
2080 zj=zj_safe+zshift*boxzsize
2081 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2082 if(dist_temp.lt.dist_init) then
2092 if (isubchap.eq.1) then
2101 rij=xj*xj+yj*yj+zj*zj
2102 sss=sscale(sqrt(rij))
2103 sssgrad=sscagrad(sqrt(rij))
2104 if (rij.lt.r0ijsq) then
2105 evdw1ij=0.25d0*(rij-r0ijsq)**2
2111 evdw1=evdw1+evdw1ij*sss
2113 C Calculate contributions to the Cartesian gradient.
2115 ggg(1)=fac*xj*sssgrad
2116 ggg(2)=fac*yj*sssgrad
2117 ggg(3)=fac*zj*sssgrad
2119 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2120 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2123 * Loop over residues i+1 thru j-1.
2127 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2132 cgrad do i=nnt,nct-1
2134 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2136 cgrad do j=i+1,nct-1
2138 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2144 c------------------------------------------------------------------------------
2145 subroutine vec_and_deriv
2146 implicit real*8 (a-h,o-z)
2147 include 'DIMENSIONS'
2151 include 'COMMON.IOUNITS'
2152 include 'COMMON.GEO'
2153 include 'COMMON.VAR'
2154 include 'COMMON.LOCAL'
2155 include 'COMMON.CHAIN'
2156 include 'COMMON.VECTORS'
2157 include 'COMMON.SETUP'
2158 include 'COMMON.TIME1'
2159 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2160 C Compute the local reference systems. For reference system (i), the
2161 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2162 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2164 do i=ivec_start,ivec_end
2168 if (i.eq.nres-1) then
2169 C Case of the last full residue
2170 C Compute the Z-axis
2171 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2172 costh=dcos(pi-theta(nres))
2173 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2177 C Compute the derivatives of uz
2179 uzder(2,1,1)=-dc_norm(3,i-1)
2180 uzder(3,1,1)= dc_norm(2,i-1)
2181 uzder(1,2,1)= dc_norm(3,i-1)
2183 uzder(3,2,1)=-dc_norm(1,i-1)
2184 uzder(1,3,1)=-dc_norm(2,i-1)
2185 uzder(2,3,1)= dc_norm(1,i-1)
2188 uzder(2,1,2)= dc_norm(3,i)
2189 uzder(3,1,2)=-dc_norm(2,i)
2190 uzder(1,2,2)=-dc_norm(3,i)
2192 uzder(3,2,2)= dc_norm(1,i)
2193 uzder(1,3,2)= dc_norm(2,i)
2194 uzder(2,3,2)=-dc_norm(1,i)
2196 C Compute the Y-axis
2199 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2201 C Compute the derivatives of uy
2204 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2205 & -dc_norm(k,i)*dc_norm(j,i-1)
2206 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2208 uyder(j,j,1)=uyder(j,j,1)-costh
2209 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2214 uygrad(l,k,j,i)=uyder(l,k,j)
2215 uzgrad(l,k,j,i)=uzder(l,k,j)
2219 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2220 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2221 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2222 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2225 C Compute the Z-axis
2226 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2227 costh=dcos(pi-theta(i+2))
2228 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2232 C Compute the derivatives of uz
2234 uzder(2,1,1)=-dc_norm(3,i+1)
2235 uzder(3,1,1)= dc_norm(2,i+1)
2236 uzder(1,2,1)= dc_norm(3,i+1)
2238 uzder(3,2,1)=-dc_norm(1,i+1)
2239 uzder(1,3,1)=-dc_norm(2,i+1)
2240 uzder(2,3,1)= dc_norm(1,i+1)
2243 uzder(2,1,2)= dc_norm(3,i)
2244 uzder(3,1,2)=-dc_norm(2,i)
2245 uzder(1,2,2)=-dc_norm(3,i)
2247 uzder(3,2,2)= dc_norm(1,i)
2248 uzder(1,3,2)= dc_norm(2,i)
2249 uzder(2,3,2)=-dc_norm(1,i)
2251 C Compute the Y-axis
2254 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2256 C Compute the derivatives of uy
2259 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2260 & -dc_norm(k,i)*dc_norm(j,i+1)
2261 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2263 uyder(j,j,1)=uyder(j,j,1)-costh
2264 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2269 uygrad(l,k,j,i)=uyder(l,k,j)
2270 uzgrad(l,k,j,i)=uzder(l,k,j)
2274 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2275 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2276 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2277 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2281 vbld_inv_temp(1)=vbld_inv(i+1)
2282 if (i.lt.nres-1) then
2283 vbld_inv_temp(2)=vbld_inv(i+2)
2285 vbld_inv_temp(2)=vbld_inv(i)
2290 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2291 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2296 #if defined(PARVEC) && defined(MPI)
2297 if (nfgtasks1.gt.1) then
2299 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2300 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2301 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2302 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2303 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2305 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2306 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2308 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2309 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2310 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2311 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2312 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2313 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2314 time_gather=time_gather+MPI_Wtime()-time00
2316 c if (fg_rank.eq.0) then
2317 c write (iout,*) "Arrays UY and UZ"
2319 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2326 C-----------------------------------------------------------------------------
2327 subroutine check_vecgrad
2328 implicit real*8 (a-h,o-z)
2329 include 'DIMENSIONS'
2330 include 'COMMON.IOUNITS'
2331 include 'COMMON.GEO'
2332 include 'COMMON.VAR'
2333 include 'COMMON.LOCAL'
2334 include 'COMMON.CHAIN'
2335 include 'COMMON.VECTORS'
2336 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2337 dimension uyt(3,maxres),uzt(3,maxres)
2338 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2339 double precision delta /1.0d-7/
2342 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2343 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2344 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2345 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2346 cd & (dc_norm(if90,i),if90=1,3)
2347 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2348 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2349 cd write(iout,'(a)')
2355 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2356 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2369 cd write (iout,*) 'i=',i
2371 erij(k)=dc_norm(k,i)
2375 dc_norm(k,i)=erij(k)
2377 dc_norm(j,i)=dc_norm(j,i)+delta
2378 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2380 c dc_norm(k,i)=dc_norm(k,i)/fac
2382 c write (iout,*) (dc_norm(k,i),k=1,3)
2383 c write (iout,*) (erij(k),k=1,3)
2386 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2387 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2388 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2389 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2391 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2392 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2393 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2396 dc_norm(k,i)=erij(k)
2399 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2400 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2401 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2402 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2403 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2404 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2405 cd write (iout,'(a)')
2410 C--------------------------------------------------------------------------
2411 subroutine set_matrices
2412 implicit real*8 (a-h,o-z)
2413 include 'DIMENSIONS'
2416 include "COMMON.SETUP"
2418 integer status(MPI_STATUS_SIZE)
2420 include 'COMMON.IOUNITS'
2421 include 'COMMON.GEO'
2422 include 'COMMON.VAR'
2423 include 'COMMON.LOCAL'
2424 include 'COMMON.CHAIN'
2425 include 'COMMON.DERIV'
2426 include 'COMMON.INTERACT'
2427 include 'COMMON.CONTACTS'
2428 include 'COMMON.TORSION'
2429 include 'COMMON.VECTORS'
2430 include 'COMMON.FFIELD'
2431 double precision auxvec(2),auxmat(2,2)
2433 C Compute the virtual-bond-torsional-angle dependent quantities needed
2434 C to calculate the el-loc multibody terms of various order.
2436 c write(iout,*) 'nphi=',nphi,nres
2438 do i=ivec_start+2,ivec_end+2
2443 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2444 iti = itortyp(itype(i-2))
2448 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2449 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2450 iti1 = itortyp(itype(i-1))
2455 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2456 & +bnew1(2,1,iti)*dsin(theta(i-1))
2457 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2458 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2459 & +bnew1(2,1,iti)*dcos(theta(i-1))
2460 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2461 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2462 c &*(cos(theta(i)/2.0)
2463 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2464 & +bnew2(2,1,iti)*dsin(theta(i-1))
2465 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2466 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2467 c &*(cos(theta(i)/2.0)
2468 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2469 & +bnew2(2,1,iti)*dcos(theta(i-1))
2470 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2471 c if (ggb1(1,i).eq.0.0d0) then
2472 c write(iout,*) 'i=',i,ggb1(1,i),
2473 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2474 c &bnew1(2,1,iti)*cos(theta(i)),
2475 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2477 b1(2,i-2)=bnew1(1,2,iti)
2479 b2(2,i-2)=bnew2(1,2,iti)
2481 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2482 EE(1,2,i-2)=eeold(1,2,iti)
2483 EE(2,1,i-2)=eeold(2,1,iti)
2484 EE(2,2,i-2)=eeold(2,2,iti)
2485 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2490 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2491 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2492 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2493 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2494 b1tilde(1,i-2)=b1(1,i-2)
2495 b1tilde(2,i-2)=-b1(2,i-2)
2496 b2tilde(1,i-2)=b2(1,i-2)
2497 b2tilde(2,i-2)=-b2(2,i-2)
2498 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2499 c write(iout,*) 'b1=',b1(1,i-2)
2500 c write (iout,*) 'theta=', theta(i-1)
2503 do i=ivec_start+2,ivec_end+2
2508 if (i .lt. nres+1) then
2545 if (i .gt. 3 .and. i .lt. nres+1) then
2546 obrot_der(1,i-2)=-sin1
2547 obrot_der(2,i-2)= cos1
2548 Ugder(1,1,i-2)= sin1
2549 Ugder(1,2,i-2)=-cos1
2550 Ugder(2,1,i-2)=-cos1
2551 Ugder(2,2,i-2)=-sin1
2554 obrot2_der(1,i-2)=-dwasin2
2555 obrot2_der(2,i-2)= dwacos2
2556 Ug2der(1,1,i-2)= dwasin2
2557 Ug2der(1,2,i-2)=-dwacos2
2558 Ug2der(2,1,i-2)=-dwacos2
2559 Ug2der(2,2,i-2)=-dwasin2
2561 obrot_der(1,i-2)=0.0d0
2562 obrot_der(2,i-2)=0.0d0
2563 Ugder(1,1,i-2)=0.0d0
2564 Ugder(1,2,i-2)=0.0d0
2565 Ugder(2,1,i-2)=0.0d0
2566 Ugder(2,2,i-2)=0.0d0
2567 obrot2_der(1,i-2)=0.0d0
2568 obrot2_der(2,i-2)=0.0d0
2569 Ug2der(1,1,i-2)=0.0d0
2570 Ug2der(1,2,i-2)=0.0d0
2571 Ug2der(2,1,i-2)=0.0d0
2572 Ug2der(2,2,i-2)=0.0d0
2574 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2575 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2576 iti = itortyp(itype(i-2))
2580 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2581 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2582 iti1 = itortyp(itype(i-1))
2586 cd write (iout,*) '*******i',i,' iti1',iti
2587 cd write (iout,*) 'b1',b1(:,iti)
2588 cd write (iout,*) 'b2',b2(:,iti)
2589 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2590 c if (i .gt. iatel_s+2) then
2591 if (i .gt. nnt+2) then
2592 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2594 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2595 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2597 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2598 c & EE(1,2,iti),EE(2,2,iti)
2599 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2600 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2601 c write(iout,*) "Macierz EUG",
2602 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2604 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2606 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2607 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2608 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2609 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2610 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2621 DtUg2(l,k,i-2)=0.0d0
2625 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2626 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2628 muder(k,i-2)=Ub2der(k,i-2)
2630 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2631 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2632 if (itype(i-1).le.ntyp) then
2633 iti1 = itortyp(itype(i-1))
2641 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2643 c write (iout,*) 'mu ',mu(:,i-2),i-2
2644 cd write (iout,*) 'mu1',mu1(:,i-2)
2645 cd write (iout,*) 'mu2',mu2(:,i-2)
2646 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2648 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2649 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2650 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2651 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2652 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2653 C Vectors and matrices dependent on a single virtual-bond dihedral.
2654 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2655 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2656 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2657 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2658 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2659 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2660 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2661 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2662 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2665 C Matrices dependent on two consecutive virtual-bond dihedrals.
2666 C The order of matrices is from left to right.
2667 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2669 c do i=max0(ivec_start,2),ivec_end
2671 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2672 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2673 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2674 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2675 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2676 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2677 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2678 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2681 #if defined(MPI) && defined(PARMAT)
2683 c if (fg_rank.eq.0) then
2684 write (iout,*) "Arrays UG and UGDER before GATHER"
2686 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2687 & ((ug(l,k,i),l=1,2),k=1,2),
2688 & ((ugder(l,k,i),l=1,2),k=1,2)
2690 write (iout,*) "Arrays UG2 and UG2DER"
2692 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2693 & ((ug2(l,k,i),l=1,2),k=1,2),
2694 & ((ug2der(l,k,i),l=1,2),k=1,2)
2696 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2698 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2699 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2700 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2702 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2704 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2705 & costab(i),sintab(i),costab2(i),sintab2(i)
2707 write (iout,*) "Array MUDER"
2709 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2713 if (nfgtasks.gt.1) then
2715 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2716 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2717 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2719 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2720 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2722 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2723 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2725 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2726 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2728 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2729 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2731 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2732 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2734 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2735 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2737 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2738 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2739 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2740 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2741 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2742 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2743 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2744 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2745 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2746 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2747 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2748 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2749 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2751 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2752 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2754 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2755 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2757 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2758 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2760 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2761 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2763 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2764 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2766 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2767 & ivec_count(fg_rank1),
2768 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2770 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2771 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2773 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2774 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2776 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2777 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2779 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2780 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2782 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2783 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2785 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2786 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2788 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2789 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2791 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2792 & ivec_count(fg_rank1),
2793 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2795 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2796 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2798 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2799 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2801 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2802 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2804 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2805 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2807 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2808 & ivec_count(fg_rank1),
2809 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2811 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2812 & ivec_count(fg_rank1),
2813 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2815 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2816 & ivec_count(fg_rank1),
2817 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2818 & MPI_MAT2,FG_COMM1,IERR)
2819 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2820 & ivec_count(fg_rank1),
2821 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2822 & MPI_MAT2,FG_COMM1,IERR)
2825 c Passes matrix info through the ring
2828 if (irecv.lt.0) irecv=nfgtasks1-1
2831 if (inext.ge.nfgtasks1) inext=0
2833 c write (iout,*) "isend",isend," irecv",irecv
2835 lensend=lentyp(isend)
2836 lenrecv=lentyp(irecv)
2837 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2838 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2839 c & MPI_ROTAT1(lensend),inext,2200+isend,
2840 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2841 c & iprev,2200+irecv,FG_COMM,status,IERR)
2842 c write (iout,*) "Gather ROTAT1"
2844 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2845 c & MPI_ROTAT2(lensend),inext,3300+isend,
2846 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2847 c & iprev,3300+irecv,FG_COMM,status,IERR)
2848 c write (iout,*) "Gather ROTAT2"
2850 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2851 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2852 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2853 & iprev,4400+irecv,FG_COMM,status,IERR)
2854 c write (iout,*) "Gather ROTAT_OLD"
2856 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2857 & MPI_PRECOMP11(lensend),inext,5500+isend,
2858 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2859 & iprev,5500+irecv,FG_COMM,status,IERR)
2860 c write (iout,*) "Gather PRECOMP11"
2862 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2863 & MPI_PRECOMP12(lensend),inext,6600+isend,
2864 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2865 & iprev,6600+irecv,FG_COMM,status,IERR)
2866 c write (iout,*) "Gather PRECOMP12"
2868 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2870 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2871 & MPI_ROTAT2(lensend),inext,7700+isend,
2872 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2873 & iprev,7700+irecv,FG_COMM,status,IERR)
2874 c write (iout,*) "Gather PRECOMP21"
2876 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2877 & MPI_PRECOMP22(lensend),inext,8800+isend,
2878 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2879 & iprev,8800+irecv,FG_COMM,status,IERR)
2880 c write (iout,*) "Gather PRECOMP22"
2882 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2883 & MPI_PRECOMP23(lensend),inext,9900+isend,
2884 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2885 & MPI_PRECOMP23(lenrecv),
2886 & iprev,9900+irecv,FG_COMM,status,IERR)
2887 c write (iout,*) "Gather PRECOMP23"
2892 if (irecv.lt.0) irecv=nfgtasks1-1
2895 time_gather=time_gather+MPI_Wtime()-time00
2898 c if (fg_rank.eq.0) then
2899 write (iout,*) "Arrays UG and UGDER"
2901 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2902 & ((ug(l,k,i),l=1,2),k=1,2),
2903 & ((ugder(l,k,i),l=1,2),k=1,2)
2905 write (iout,*) "Arrays UG2 and UG2DER"
2907 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2908 & ((ug2(l,k,i),l=1,2),k=1,2),
2909 & ((ug2der(l,k,i),l=1,2),k=1,2)
2911 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2913 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2914 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2915 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2917 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2919 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2920 & costab(i),sintab(i),costab2(i),sintab2(i)
2922 write (iout,*) "Array MUDER"
2924 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2930 cd iti = itortyp(itype(i))
2933 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2934 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2939 C--------------------------------------------------------------------------
2940 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2942 C This subroutine calculates the average interaction energy and its gradient
2943 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2944 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2945 C The potential depends both on the distance of peptide-group centers and on
2946 C the orientation of the CA-CA virtual bonds.
2948 implicit real*8 (a-h,o-z)
2952 include 'DIMENSIONS'
2953 include 'COMMON.CONTROL'
2954 include 'COMMON.SETUP'
2955 include 'COMMON.IOUNITS'
2956 include 'COMMON.GEO'
2957 include 'COMMON.VAR'
2958 include 'COMMON.LOCAL'
2959 include 'COMMON.CHAIN'
2960 include 'COMMON.DERIV'
2961 include 'COMMON.INTERACT'
2962 include 'COMMON.CONTACTS'
2963 include 'COMMON.TORSION'
2964 include 'COMMON.VECTORS'
2965 include 'COMMON.FFIELD'
2966 include 'COMMON.TIME1'
2967 include 'COMMON.SPLITELE'
2968 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2969 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2970 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2971 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2972 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2973 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2975 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2977 double precision scal_el /1.0d0/
2979 double precision scal_el /0.5d0/
2982 C 13-go grudnia roku pamietnego...
2983 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2984 & 0.0d0,1.0d0,0.0d0,
2985 & 0.0d0,0.0d0,1.0d0/
2986 cd write(iout,*) 'In EELEC'
2988 cd write(iout,*) 'Type',i
2989 cd write(iout,*) 'B1',B1(:,i)
2990 cd write(iout,*) 'B2',B2(:,i)
2991 cd write(iout,*) 'CC',CC(:,:,i)
2992 cd write(iout,*) 'DD',DD(:,:,i)
2993 cd write(iout,*) 'EE',EE(:,:,i)
2995 cd call check_vecgrad
2997 if (icheckgrad.eq.1) then
2999 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3001 dc_norm(k,i)=dc(k,i)*fac
3003 c write (iout,*) 'i',i,' fac',fac
3006 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3007 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3008 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3009 c call vec_and_deriv
3015 time_mat=time_mat+MPI_Wtime()-time01
3019 cd write (iout,*) 'i=',i
3021 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3024 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3025 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3038 cd print '(a)','Enter EELEC'
3039 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3041 gel_loc_loc(i)=0.0d0
3046 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3048 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3050 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3051 do i=iturn3_start,iturn3_end
3052 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3053 & .or. itype(i+2).eq.ntyp1
3054 & .or. itype(i+3).eq.ntyp1
3055 & .or. itype(i-1).eq.ntyp1
3056 & .or. itype(i+4).eq.ntyp1
3061 dx_normi=dc_norm(1,i)
3062 dy_normi=dc_norm(2,i)
3063 dz_normi=dc_norm(3,i)
3064 xmedi=c(1,i)+0.5d0*dxi
3065 ymedi=c(2,i)+0.5d0*dyi
3066 zmedi=c(3,i)+0.5d0*dzi
3067 xmedi=mod(xmedi,boxxsize)
3068 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3069 ymedi=mod(ymedi,boxysize)
3070 if (ymedi.lt.0) ymedi=ymedi+boxysize
3071 zmedi=mod(zmedi,boxzsize)
3072 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3074 call eelecij(i,i+2,ees,evdw1,eel_loc)
3075 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3076 num_cont_hb(i)=num_conti
3078 do i=iturn4_start,iturn4_end
3079 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3080 & .or. itype(i+3).eq.ntyp1
3081 & .or. itype(i+4).eq.ntyp1
3082 & .or. itype(i+5).eq.ntyp1
3083 & .or. itype(i).eq.ntyp1
3084 & .or. itype(i-1).eq.ntyp1
3089 dx_normi=dc_norm(1,i)
3090 dy_normi=dc_norm(2,i)
3091 dz_normi=dc_norm(3,i)
3092 xmedi=c(1,i)+0.5d0*dxi
3093 ymedi=c(2,i)+0.5d0*dyi
3094 zmedi=c(3,i)+0.5d0*dzi
3095 C Return atom into box, boxxsize is size of box in x dimension
3097 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3098 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3099 C Condition for being inside the proper box
3100 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3101 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3105 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3106 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3107 C Condition for being inside the proper box
3108 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3109 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3113 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3114 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3115 C Condition for being inside the proper box
3116 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3117 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3120 xmedi=mod(xmedi,boxxsize)
3121 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3122 ymedi=mod(ymedi,boxysize)
3123 if (ymedi.lt.0) ymedi=ymedi+boxysize
3124 zmedi=mod(zmedi,boxzsize)
3125 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3127 num_conti=num_cont_hb(i)
3128 c write(iout,*) "JESTEM W PETLI"
3129 call eelecij(i,i+3,ees,evdw1,eel_loc)
3130 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3131 & call eturn4(i,eello_turn4)
3132 num_cont_hb(i)=num_conti
3134 C Loop over all neighbouring boxes
3139 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3141 do i=iatel_s,iatel_e
3142 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3143 & .or. itype(i+2).eq.ntyp1
3144 & .or. itype(i-1).eq.ntyp1
3149 dx_normi=dc_norm(1,i)
3150 dy_normi=dc_norm(2,i)
3151 dz_normi=dc_norm(3,i)
3152 xmedi=c(1,i)+0.5d0*dxi
3153 ymedi=c(2,i)+0.5d0*dyi
3154 zmedi=c(3,i)+0.5d0*dzi
3155 xmedi=mod(xmedi,boxxsize)
3156 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3157 ymedi=mod(ymedi,boxysize)
3158 if (ymedi.lt.0) ymedi=ymedi+boxysize
3159 zmedi=mod(zmedi,boxzsize)
3160 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3161 C xmedi=xmedi+xshift*boxxsize
3162 C ymedi=ymedi+yshift*boxysize
3163 C zmedi=zmedi+zshift*boxzsize
3165 C Return tom into box, boxxsize is size of box in x dimension
3167 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3168 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3169 C Condition for being inside the proper box
3170 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3171 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3175 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3176 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3177 C Condition for being inside the proper box
3178 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3179 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3183 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3184 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3185 cC Condition for being inside the proper box
3186 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3187 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3191 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3192 num_conti=num_cont_hb(i)
3193 do j=ielstart(i),ielend(i)
3194 c write (iout,*) i,j,itype(i),itype(j)
3195 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3196 & .or.itype(j+2).eq.ntyp1
3197 & .or.itype(j-1).eq.ntyp1
3199 call eelecij(i,j,ees,evdw1,eel_loc)
3201 num_cont_hb(i)=num_conti
3207 c write (iout,*) "Number of loop steps in EELEC:",ind
3209 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3210 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3212 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3213 ccc eel_loc=eel_loc+eello_turn3
3214 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3217 C-------------------------------------------------------------------------------
3218 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3219 implicit real*8 (a-h,o-z)
3220 include 'DIMENSIONS'
3224 include 'COMMON.CONTROL'
3225 include 'COMMON.IOUNITS'
3226 include 'COMMON.GEO'
3227 include 'COMMON.VAR'
3228 include 'COMMON.LOCAL'
3229 include 'COMMON.CHAIN'
3230 include 'COMMON.DERIV'
3231 include 'COMMON.INTERACT'
3232 include 'COMMON.CONTACTS'
3233 include 'COMMON.TORSION'
3234 include 'COMMON.VECTORS'
3235 include 'COMMON.FFIELD'
3236 include 'COMMON.TIME1'
3237 include 'COMMON.SPLITELE'
3238 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3239 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3240 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3241 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3242 & gmuij2(4),gmuji2(4)
3243 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3244 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3246 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3248 double precision scal_el /1.0d0/
3250 double precision scal_el /0.5d0/
3253 C 13-go grudnia roku pamietnego...
3254 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3255 & 0.0d0,1.0d0,0.0d0,
3256 & 0.0d0,0.0d0,1.0d0/
3257 c time00=MPI_Wtime()
3258 cd write (iout,*) "eelecij",i,j
3262 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3263 aaa=app(iteli,itelj)
3264 bbb=bpp(iteli,itelj)
3265 ael6i=ael6(iteli,itelj)
3266 ael3i=ael3(iteli,itelj)
3270 dx_normj=dc_norm(1,j)
3271 dy_normj=dc_norm(2,j)
3272 dz_normj=dc_norm(3,j)
3273 C xj=c(1,j)+0.5D0*dxj-xmedi
3274 C yj=c(2,j)+0.5D0*dyj-ymedi
3275 C zj=c(3,j)+0.5D0*dzj-zmedi
3280 if (xj.lt.0) xj=xj+boxxsize
3282 if (yj.lt.0) yj=yj+boxysize
3284 if (zj.lt.0) zj=zj+boxzsize
3285 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3286 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3294 xj=xj_safe+xshift*boxxsize
3295 yj=yj_safe+yshift*boxysize
3296 zj=zj_safe+zshift*boxzsize
3297 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3298 if(dist_temp.lt.dist_init) then
3308 if (isubchap.eq.1) then
3317 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3319 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3320 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3321 C Condition for being inside the proper box
3322 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3323 c & (xj.lt.((-0.5d0)*boxxsize))) then
3327 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3328 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3329 C Condition for being inside the proper box
3330 c if ((yj.gt.((0.5d0)*boxysize)).or.
3331 c & (yj.lt.((-0.5d0)*boxysize))) then
3335 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3336 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3337 C Condition for being inside the proper box
3338 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3339 c & (zj.lt.((-0.5d0)*boxzsize))) then
3342 C endif !endPBC condintion
3346 rij=xj*xj+yj*yj+zj*zj
3348 sss=sscale(sqrt(rij))
3349 sssgrad=sscagrad(sqrt(rij))
3350 c if (sss.gt.0.0d0) then
3356 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3357 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3358 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3359 fac=cosa-3.0D0*cosb*cosg
3361 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3362 if (j.eq.i+2) ev1=scal_el*ev1
3367 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3371 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3372 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3374 evdw1=evdw1+evdwij*sss
3375 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3376 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3377 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3378 cd & xmedi,ymedi,zmedi,xj,yj,zj
3380 if (energy_dec) then
3381 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3383 &,iteli,itelj,aaa,evdw1
3384 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3388 C Calculate contributions to the Cartesian gradient.
3391 facvdw=-6*rrmij*(ev1+evdwij)*sss
3392 facel=-3*rrmij*(el1+eesij)
3398 * Radial derivatives. First process both termini of the fragment (i,j)
3404 c ghalf=0.5D0*ggg(k)
3405 c gelc(k,i)=gelc(k,i)+ghalf
3406 c gelc(k,j)=gelc(k,j)+ghalf
3408 c 9/28/08 AL Gradient compotents will be summed only at the end
3410 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3411 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3414 * Loop over residues i+1 thru j-1.
3418 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3421 if (sss.gt.0.0) then
3422 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3423 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3424 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3431 c ghalf=0.5D0*ggg(k)
3432 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3433 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3435 c 9/28/08 AL Gradient compotents will be summed only at the end
3437 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3438 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3441 * Loop over residues i+1 thru j-1.
3445 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3450 facvdw=(ev1+evdwij)*sss
3453 fac=-3*rrmij*(facvdw+facvdw+facel)
3458 * Radial derivatives. First process both termini of the fragment (i,j)
3464 c ghalf=0.5D0*ggg(k)
3465 c gelc(k,i)=gelc(k,i)+ghalf
3466 c gelc(k,j)=gelc(k,j)+ghalf
3468 c 9/28/08 AL Gradient compotents will be summed only at the end
3470 gelc_long(k,j)=gelc(k,j)+ggg(k)
3471 gelc_long(k,i)=gelc(k,i)-ggg(k)
3474 * Loop over residues i+1 thru j-1.
3478 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3481 c 9/28/08 AL Gradient compotents will be summed only at the end
3482 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3483 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3484 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3486 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3487 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3493 ecosa=2.0D0*fac3*fac1+fac4
3496 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3497 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3499 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3500 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3502 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3503 cd & (dcosg(k),k=1,3)
3505 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3508 c ghalf=0.5D0*ggg(k)
3509 c gelc(k,i)=gelc(k,i)+ghalf
3510 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3511 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3512 c gelc(k,j)=gelc(k,j)+ghalf
3513 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3514 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3518 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3523 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3524 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3526 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3527 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3528 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3529 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3533 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3534 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3535 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3537 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3538 C energy of a peptide unit is assumed in the form of a second-order
3539 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3540 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3541 C are computed for EVERY pair of non-contiguous peptide groups.
3544 if (j.lt.nres-1) then
3556 muij(kkk)=mu(k,i)*mu(l,j)
3557 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3559 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3560 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3561 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3562 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3563 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3564 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3568 cd write (iout,*) 'EELEC: i',i,' j',j
3569 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3570 cd write(iout,*) 'muij',muij
3571 ury=scalar(uy(1,i),erij)
3572 urz=scalar(uz(1,i),erij)
3573 vry=scalar(uy(1,j),erij)
3574 vrz=scalar(uz(1,j),erij)
3575 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3576 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3577 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3578 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3579 fac=dsqrt(-ael6i)*r3ij
3584 cd write (iout,'(4i5,4f10.5)')
3585 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3586 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3587 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3588 cd & uy(:,j),uz(:,j)
3589 cd write (iout,'(4f10.5)')
3590 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3591 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3592 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3593 cd write (iout,'(9f10.5/)')
3594 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3595 C Derivatives of the elements of A in virtual-bond vectors
3596 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3598 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3599 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3600 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3601 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3602 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3603 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3604 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3605 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3606 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3607 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3608 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3609 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3611 C Compute radial contributions to the gradient
3629 C Add the contributions coming from er
3632 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3633 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3634 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3635 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3638 C Derivatives in DC(i)
3639 cgrad ghalf1=0.5d0*agg(k,1)
3640 cgrad ghalf2=0.5d0*agg(k,2)
3641 cgrad ghalf3=0.5d0*agg(k,3)
3642 cgrad ghalf4=0.5d0*agg(k,4)
3643 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3644 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3645 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3646 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3647 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3648 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3649 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3650 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3651 C Derivatives in DC(i+1)
3652 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3653 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3654 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3655 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3656 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3657 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3658 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3659 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3660 C Derivatives in DC(j)
3661 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3662 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3663 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3664 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3665 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3666 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3667 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3668 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3669 C Derivatives in DC(j+1) or DC(nres-1)
3670 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3671 & -3.0d0*vryg(k,3)*ury)
3672 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3673 & -3.0d0*vrzg(k,3)*ury)
3674 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3675 & -3.0d0*vryg(k,3)*urz)
3676 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3677 & -3.0d0*vrzg(k,3)*urz)
3678 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3680 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3693 aggi(k,l)=-aggi(k,l)
3694 aggi1(k,l)=-aggi1(k,l)
3695 aggj(k,l)=-aggj(k,l)
3696 aggj1(k,l)=-aggj1(k,l)
3699 if (j.lt.nres-1) then
3705 aggi(k,l)=-aggi(k,l)
3706 aggi1(k,l)=-aggi1(k,l)
3707 aggj(k,l)=-aggj(k,l)
3708 aggj1(k,l)=-aggj1(k,l)
3719 aggi(k,l)=-aggi(k,l)
3720 aggi1(k,l)=-aggi1(k,l)
3721 aggj(k,l)=-aggj(k,l)
3722 aggj1(k,l)=-aggj1(k,l)
3727 IF (wel_loc.gt.0.0d0) THEN
3728 C Contribution to the local-electrostatic energy coming from the i-j pair
3729 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3731 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3732 c & ' eel_loc_ij',eel_loc_ij
3733 c write(iout,*) 'muije=',muij(1),muij(2),muij(3),muij(4)
3734 C Calculate patrial derivative for theta angle
3736 geel_loc_ij=a22*gmuij1(1)
3740 c write(iout,*) "derivative over thatai"
3741 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3743 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3744 & geel_loc_ij*wel_loc
3745 c write(iout,*) "derivative over thatai-1"
3746 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3753 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3754 & geel_loc_ij*wel_loc
3755 c Derivative over j residue
3756 geel_loc_ji=a22*gmuji1(1)
3760 c write(iout,*) "derivative over thataj"
3761 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3764 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3765 & geel_loc_ji*wel_loc
3771 c write(iout,*) "derivative over thataj-1"
3772 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3774 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3775 & geel_loc_ji*wel_loc
3777 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3779 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3780 & 'eelloc',i,j,eel_loc_ij
3781 c if (eel_loc_ij.ne.0)
3782 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3783 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3785 eel_loc=eel_loc+eel_loc_ij
3786 C Partial derivatives in virtual-bond dihedral angles gamma
3788 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3789 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3790 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3791 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3792 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3793 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3794 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3796 ggg(l)=agg(l,1)*muij(1)+
3797 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3798 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3799 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3800 cgrad ghalf=0.5d0*ggg(l)
3801 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3802 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3806 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3809 C Remaining derivatives of eello
3811 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3812 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3813 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3814 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3815 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3816 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3817 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3818 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3821 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3822 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3823 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3824 & .and. num_conti.le.maxconts) then
3825 c write (iout,*) i,j," entered corr"
3827 C Calculate the contact function. The ith column of the array JCONT will
3828 C contain the numbers of atoms that make contacts with the atom I (of numbers
3829 C greater than I). The arrays FACONT and GACONT will contain the values of
3830 C the contact function and its derivative.
3831 c r0ij=1.02D0*rpp(iteli,itelj)
3832 c r0ij=1.11D0*rpp(iteli,itelj)
3833 r0ij=2.20D0*rpp(iteli,itelj)
3834 c r0ij=1.55D0*rpp(iteli,itelj)
3835 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3836 if (fcont.gt.0.0D0) then
3837 num_conti=num_conti+1
3838 if (num_conti.gt.maxconts) then
3839 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3840 & ' will skip next contacts for this conf.'
3842 jcont_hb(num_conti,i)=j
3843 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3844 cd & " jcont_hb",jcont_hb(num_conti,i)
3845 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3846 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3847 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3849 d_cont(num_conti,i)=rij
3850 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3851 C --- Electrostatic-interaction matrix ---
3852 a_chuj(1,1,num_conti,i)=a22
3853 a_chuj(1,2,num_conti,i)=a23
3854 a_chuj(2,1,num_conti,i)=a32
3855 a_chuj(2,2,num_conti,i)=a33
3856 C --- Gradient of rij
3858 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3865 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3866 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3867 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3868 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3869 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3874 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3875 C Calculate contact energies
3877 wij=cosa-3.0D0*cosb*cosg
3880 c fac3=dsqrt(-ael6i)/r0ij**3
3881 fac3=dsqrt(-ael6i)*r3ij
3882 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3883 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3884 if (ees0tmp.gt.0) then
3885 ees0pij=dsqrt(ees0tmp)
3889 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3890 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3891 if (ees0tmp.gt.0) then
3892 ees0mij=dsqrt(ees0tmp)
3897 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3898 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3899 C Diagnostics. Comment out or remove after debugging!
3900 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3901 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3902 c ees0m(num_conti,i)=0.0D0
3904 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3905 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3906 C Angular derivatives of the contact function
3907 ees0pij1=fac3/ees0pij
3908 ees0mij1=fac3/ees0mij
3909 fac3p=-3.0D0*fac3*rrmij
3910 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3911 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3913 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3914 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3915 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3916 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3917 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3918 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3919 ecosap=ecosa1+ecosa2
3920 ecosbp=ecosb1+ecosb2
3921 ecosgp=ecosg1+ecosg2
3922 ecosam=ecosa1-ecosa2
3923 ecosbm=ecosb1-ecosb2
3924 ecosgm=ecosg1-ecosg2
3933 facont_hb(num_conti,i)=fcont
3934 fprimcont=fprimcont/rij
3935 cd facont_hb(num_conti,i)=1.0D0
3936 C Following line is for diagnostics.
3939 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3940 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3943 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3944 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3946 gggp(1)=gggp(1)+ees0pijp*xj
3947 gggp(2)=gggp(2)+ees0pijp*yj
3948 gggp(3)=gggp(3)+ees0pijp*zj
3949 gggm(1)=gggm(1)+ees0mijp*xj
3950 gggm(2)=gggm(2)+ees0mijp*yj
3951 gggm(3)=gggm(3)+ees0mijp*zj
3952 C Derivatives due to the contact function
3953 gacont_hbr(1,num_conti,i)=fprimcont*xj
3954 gacont_hbr(2,num_conti,i)=fprimcont*yj
3955 gacont_hbr(3,num_conti,i)=fprimcont*zj
3958 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3959 c following the change of gradient-summation algorithm.
3961 cgrad ghalfp=0.5D0*gggp(k)
3962 cgrad ghalfm=0.5D0*gggm(k)
3963 gacontp_hb1(k,num_conti,i)=!ghalfp
3964 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3965 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3966 gacontp_hb2(k,num_conti,i)=!ghalfp
3967 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3968 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3969 gacontp_hb3(k,num_conti,i)=gggp(k)
3970 gacontm_hb1(k,num_conti,i)=!ghalfm
3971 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3972 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3973 gacontm_hb2(k,num_conti,i)=!ghalfm
3974 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3975 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3976 gacontm_hb3(k,num_conti,i)=gggm(k)
3978 C Diagnostics. Comment out or remove after debugging!
3980 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3981 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3982 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3983 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3984 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3985 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3988 endif ! num_conti.le.maxconts
3991 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3994 ghalf=0.5d0*agg(l,k)
3995 aggi(l,k)=aggi(l,k)+ghalf
3996 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3997 aggj(l,k)=aggj(l,k)+ghalf
4000 if (j.eq.nres-1 .and. i.lt.j-2) then
4003 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4008 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4011 C-----------------------------------------------------------------------------
4012 subroutine eturn3(i,eello_turn3)
4013 C Third- and fourth-order contributions from turns
4014 implicit real*8 (a-h,o-z)
4015 include 'DIMENSIONS'
4016 include 'COMMON.IOUNITS'
4017 include 'COMMON.GEO'
4018 include 'COMMON.VAR'
4019 include 'COMMON.LOCAL'
4020 include 'COMMON.CHAIN'
4021 include 'COMMON.DERIV'
4022 include 'COMMON.INTERACT'
4023 include 'COMMON.CONTACTS'
4024 include 'COMMON.TORSION'
4025 include 'COMMON.VECTORS'
4026 include 'COMMON.FFIELD'
4027 include 'COMMON.CONTROL'
4029 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4030 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4031 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4032 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4033 & auxgmat2(2,2),auxgmatt2(2,2)
4034 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4035 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4036 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4037 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4040 c write (iout,*) "eturn3",i,j,j1,j2
4045 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4047 C Third-order contributions
4054 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4055 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4056 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4057 c auxalary matices for theta gradient
4058 c auxalary matrix for i+1 and constant i+2
4059 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4060 c auxalary matrix for i+2 and constant i+1
4061 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4062 call transpose2(auxmat(1,1),auxmat1(1,1))
4063 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4064 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4065 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4066 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4067 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4068 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4069 C Derivatives in theta
4070 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4071 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4072 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4073 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4075 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4076 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4077 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4078 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4079 cd & ' eello_turn3_num',4*eello_turn3_num
4080 C Derivatives in gamma(i)
4081 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4082 call transpose2(auxmat2(1,1),auxmat3(1,1))
4083 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4084 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4085 C Derivatives in gamma(i+1)
4086 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4087 call transpose2(auxmat2(1,1),auxmat3(1,1))
4088 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4089 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4090 & +0.5d0*(pizda(1,1)+pizda(2,2))
4091 C Cartesian derivatives
4093 c ghalf1=0.5d0*agg(l,1)
4094 c ghalf2=0.5d0*agg(l,2)
4095 c ghalf3=0.5d0*agg(l,3)
4096 c ghalf4=0.5d0*agg(l,4)
4097 a_temp(1,1)=aggi(l,1)!+ghalf1
4098 a_temp(1,2)=aggi(l,2)!+ghalf2
4099 a_temp(2,1)=aggi(l,3)!+ghalf3
4100 a_temp(2,2)=aggi(l,4)!+ghalf4
4101 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4102 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4103 & +0.5d0*(pizda(1,1)+pizda(2,2))
4104 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4105 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4106 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4107 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4108 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4109 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4110 & +0.5d0*(pizda(1,1)+pizda(2,2))
4111 a_temp(1,1)=aggj(l,1)!+ghalf1
4112 a_temp(1,2)=aggj(l,2)!+ghalf2
4113 a_temp(2,1)=aggj(l,3)!+ghalf3
4114 a_temp(2,2)=aggj(l,4)!+ghalf4
4115 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4116 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4117 & +0.5d0*(pizda(1,1)+pizda(2,2))
4118 a_temp(1,1)=aggj1(l,1)
4119 a_temp(1,2)=aggj1(l,2)
4120 a_temp(2,1)=aggj1(l,3)
4121 a_temp(2,2)=aggj1(l,4)
4122 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4123 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4124 & +0.5d0*(pizda(1,1)+pizda(2,2))
4128 C-------------------------------------------------------------------------------
4129 subroutine eturn4(i,eello_turn4)
4130 C Third- and fourth-order contributions from turns
4131 implicit real*8 (a-h,o-z)
4132 include 'DIMENSIONS'
4133 include 'COMMON.IOUNITS'
4134 include 'COMMON.GEO'
4135 include 'COMMON.VAR'
4136 include 'COMMON.LOCAL'
4137 include 'COMMON.CHAIN'
4138 include 'COMMON.DERIV'
4139 include 'COMMON.INTERACT'
4140 include 'COMMON.CONTACTS'
4141 include 'COMMON.TORSION'
4142 include 'COMMON.VECTORS'
4143 include 'COMMON.FFIELD'
4144 include 'COMMON.CONTROL'
4146 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4147 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4148 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4149 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4150 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4151 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4152 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4153 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4154 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4155 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4156 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4159 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4161 C Fourth-order contributions
4169 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4170 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4171 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4172 c write(iout,*)"WCHODZE W PROGRAM"
4177 iti1=itortyp(itype(i+1))
4178 iti2=itortyp(itype(i+2))
4179 iti3=itortyp(itype(i+3))
4180 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4181 call transpose2(EUg(1,1,i+1),e1t(1,1))
4182 call transpose2(Eug(1,1,i+2),e2t(1,1))
4183 call transpose2(Eug(1,1,i+3),e3t(1,1))
4184 C Ematrix derivative in theta
4185 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4186 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4187 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4188 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4189 c eta1 in derivative theta
4190 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4191 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4192 c auxgvec is derivative of Ub2 so i+3 theta
4193 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4194 c auxalary matrix of E i+1
4195 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4198 s1=scalar2(b1(1,i+2),auxvec(1))
4199 c derivative of theta i+2 with constant i+3
4200 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4201 c derivative of theta i+2 with constant i+2
4202 gs32=scalar2(b1(1,i+2),auxgvec(1))
4203 c derivative of E matix in theta of i+1
4204 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4206 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4207 c ea31 in derivative theta
4208 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4209 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4210 c auxilary matrix auxgvec of Ub2 with constant E matirx
4211 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4212 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4213 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4217 s2=scalar2(b1(1,i+1),auxvec(1))
4218 c derivative of theta i+1 with constant i+3
4219 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4220 c derivative of theta i+2 with constant i+1
4221 gs21=scalar2(b1(1,i+1),auxgvec(1))
4222 c derivative of theta i+3 with constant i+1
4223 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4224 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4226 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4227 c two derivatives over diffetent matrices
4228 c gtae3e2 is derivative over i+3
4229 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4230 c ae3gte2 is derivative over i+2
4231 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4232 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4233 c three possible derivative over theta E matices
4235 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4237 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4239 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4240 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4242 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4243 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4244 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4246 eello_turn4=eello_turn4-(s1+s2+s3)
4247 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4248 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4249 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4250 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4251 cd & ' eello_turn4_num',8*eello_turn4_num
4253 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4254 & -(gs13+gsE13+gsEE1)*wturn4
4255 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4256 & -(gs23+gs21+gsEE2)*wturn4
4257 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4258 & -(gs32+gsE31+gsEE3)*wturn4
4259 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4262 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4263 & 'eturn4',i,j,-(s1+s2+s3)
4264 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4265 c & ' eello_turn4_num',8*eello_turn4_num
4266 C Derivatives in gamma(i)
4267 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4268 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4269 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4270 s1=scalar2(b1(1,i+2),auxvec(1))
4271 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4272 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4273 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4274 C Derivatives in gamma(i+1)
4275 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4276 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4277 s2=scalar2(b1(1,i+1),auxvec(1))
4278 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4279 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4280 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4281 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4282 C Derivatives in gamma(i+2)
4283 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4284 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4285 s1=scalar2(b1(1,i+2),auxvec(1))
4286 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4287 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4288 s2=scalar2(b1(1,i+1),auxvec(1))
4289 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4290 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4291 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4292 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4293 C Cartesian derivatives
4294 C Derivatives of this turn contributions in DC(i+2)
4295 if (j.lt.nres-1) then
4297 a_temp(1,1)=agg(l,1)
4298 a_temp(1,2)=agg(l,2)
4299 a_temp(2,1)=agg(l,3)
4300 a_temp(2,2)=agg(l,4)
4301 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4302 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4303 s1=scalar2(b1(1,i+2),auxvec(1))
4304 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4305 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4306 s2=scalar2(b1(1,i+1),auxvec(1))
4307 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4308 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4309 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4311 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4314 C Remaining derivatives of this turn contribution
4316 a_temp(1,1)=aggi(l,1)
4317 a_temp(1,2)=aggi(l,2)
4318 a_temp(2,1)=aggi(l,3)
4319 a_temp(2,2)=aggi(l,4)
4320 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4321 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4322 s1=scalar2(b1(1,i+2),auxvec(1))
4323 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4324 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4325 s2=scalar2(b1(1,i+1),auxvec(1))
4326 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4327 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4328 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4329 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4330 a_temp(1,1)=aggi1(l,1)
4331 a_temp(1,2)=aggi1(l,2)
4332 a_temp(2,1)=aggi1(l,3)
4333 a_temp(2,2)=aggi1(l,4)
4334 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4335 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4336 s1=scalar2(b1(1,i+2),auxvec(1))
4337 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4338 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4339 s2=scalar2(b1(1,i+1),auxvec(1))
4340 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4341 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4342 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4343 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4344 a_temp(1,1)=aggj(l,1)
4345 a_temp(1,2)=aggj(l,2)
4346 a_temp(2,1)=aggj(l,3)
4347 a_temp(2,2)=aggj(l,4)
4348 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4349 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4350 s1=scalar2(b1(1,i+2),auxvec(1))
4351 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4352 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4353 s2=scalar2(b1(1,i+1),auxvec(1))
4354 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4355 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4356 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4357 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4358 a_temp(1,1)=aggj1(l,1)
4359 a_temp(1,2)=aggj1(l,2)
4360 a_temp(2,1)=aggj1(l,3)
4361 a_temp(2,2)=aggj1(l,4)
4362 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4363 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4364 s1=scalar2(b1(1,i+2),auxvec(1))
4365 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4366 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4367 s2=scalar2(b1(1,i+1),auxvec(1))
4368 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4369 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4370 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4371 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4372 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4376 C-----------------------------------------------------------------------------
4377 subroutine vecpr(u,v,w)
4378 implicit real*8(a-h,o-z)
4379 dimension u(3),v(3),w(3)
4380 w(1)=u(2)*v(3)-u(3)*v(2)
4381 w(2)=-u(1)*v(3)+u(3)*v(1)
4382 w(3)=u(1)*v(2)-u(2)*v(1)
4385 C-----------------------------------------------------------------------------
4386 subroutine unormderiv(u,ugrad,unorm,ungrad)
4387 C This subroutine computes the derivatives of a normalized vector u, given
4388 C the derivatives computed without normalization conditions, ugrad. Returns
4391 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4392 double precision vec(3)
4393 double precision scalar
4395 c write (2,*) 'ugrad',ugrad
4398 vec(i)=scalar(ugrad(1,i),u(1))
4400 c write (2,*) 'vec',vec
4403 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4406 c write (2,*) 'ungrad',ungrad
4409 C-----------------------------------------------------------------------------
4410 subroutine escp_soft_sphere(evdw2,evdw2_14)
4412 C This subroutine calculates the excluded-volume interaction energy between
4413 C peptide-group centers and side chains and its gradient in virtual-bond and
4414 C side-chain vectors.
4416 implicit real*8 (a-h,o-z)
4417 include 'DIMENSIONS'
4418 include 'COMMON.GEO'
4419 include 'COMMON.VAR'
4420 include 'COMMON.LOCAL'
4421 include 'COMMON.CHAIN'
4422 include 'COMMON.DERIV'
4423 include 'COMMON.INTERACT'
4424 include 'COMMON.FFIELD'
4425 include 'COMMON.IOUNITS'
4426 include 'COMMON.CONTROL'
4431 cd print '(a)','Enter ESCP'
4432 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4436 do i=iatscp_s,iatscp_e
4437 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4439 xi=0.5D0*(c(1,i)+c(1,i+1))
4440 yi=0.5D0*(c(2,i)+c(2,i+1))
4441 zi=0.5D0*(c(3,i)+c(3,i+1))
4442 C Return atom into box, boxxsize is size of box in x dimension
4444 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4445 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4446 C Condition for being inside the proper box
4447 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4448 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4452 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4453 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4454 C Condition for being inside the proper box
4455 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4456 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4460 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4461 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4462 cC Condition for being inside the proper box
4463 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4464 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4468 if (xi.lt.0) xi=xi+boxxsize
4470 if (yi.lt.0) yi=yi+boxysize
4472 if (zi.lt.0) zi=zi+boxzsize
4473 C xi=xi+xshift*boxxsize
4474 C yi=yi+yshift*boxysize
4475 C zi=zi+zshift*boxzsize
4476 do iint=1,nscp_gr(i)
4478 do j=iscpstart(i,iint),iscpend(i,iint)
4479 if (itype(j).eq.ntyp1) cycle
4480 itypj=iabs(itype(j))
4481 C Uncomment following three lines for SC-p interactions
4485 C Uncomment following three lines for Ca-p interactions
4490 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4491 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4492 C Condition for being inside the proper box
4493 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4494 c & (xj.lt.((-0.5d0)*boxxsize))) then
4498 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4499 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4500 cC Condition for being inside the proper box
4501 c if ((yj.gt.((0.5d0)*boxysize)).or.
4502 c & (yj.lt.((-0.5d0)*boxysize))) then
4506 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4507 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4508 C Condition for being inside the proper box
4509 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4510 c & (zj.lt.((-0.5d0)*boxzsize))) then
4513 if (xj.lt.0) xj=xj+boxxsize
4515 if (yj.lt.0) yj=yj+boxysize
4517 if (zj.lt.0) zj=zj+boxzsize
4518 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4526 xj=xj_safe+xshift*boxxsize
4527 yj=yj_safe+yshift*boxysize
4528 zj=zj_safe+zshift*boxzsize
4529 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4530 if(dist_temp.lt.dist_init) then
4540 if (subchap.eq.1) then
4553 rij=xj*xj+yj*yj+zj*zj
4557 if (rij.lt.r0ijsq) then
4558 evdwij=0.25d0*(rij-r0ijsq)**2
4566 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4571 cgrad if (j.lt.i) then
4572 cd write (iout,*) 'j<i'
4573 C Uncomment following three lines for SC-p interactions
4575 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4578 cd write (iout,*) 'j>i'
4580 cgrad ggg(k)=-ggg(k)
4581 C Uncomment following line for SC-p interactions
4582 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4586 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4588 cgrad kstart=min0(i+1,j)
4589 cgrad kend=max0(i-1,j-1)
4590 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4591 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4592 cgrad do k=kstart,kend
4594 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4598 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4599 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4610 C-----------------------------------------------------------------------------
4611 subroutine escp(evdw2,evdw2_14)
4613 C This subroutine calculates the excluded-volume interaction energy between
4614 C peptide-group centers and side chains and its gradient in virtual-bond and
4615 C side-chain vectors.
4617 implicit real*8 (a-h,o-z)
4618 include 'DIMENSIONS'
4619 include 'COMMON.GEO'
4620 include 'COMMON.VAR'
4621 include 'COMMON.LOCAL'
4622 include 'COMMON.CHAIN'
4623 include 'COMMON.DERIV'
4624 include 'COMMON.INTERACT'
4625 include 'COMMON.FFIELD'
4626 include 'COMMON.IOUNITS'
4627 include 'COMMON.CONTROL'
4628 include 'COMMON.SPLITELE'
4632 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4633 cd print '(a)','Enter ESCP'
4634 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4638 do i=iatscp_s,iatscp_e
4639 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4641 xi=0.5D0*(c(1,i)+c(1,i+1))
4642 yi=0.5D0*(c(2,i)+c(2,i+1))
4643 zi=0.5D0*(c(3,i)+c(3,i+1))
4645 if (xi.lt.0) xi=xi+boxxsize
4647 if (yi.lt.0) yi=yi+boxysize
4649 if (zi.lt.0) zi=zi+boxzsize
4650 c xi=xi+xshift*boxxsize
4651 c yi=yi+yshift*boxysize
4652 c zi=zi+zshift*boxzsize
4653 c print *,xi,yi,zi,'polozenie i'
4654 C Return atom into box, boxxsize is size of box in x dimension
4656 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4657 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4658 C Condition for being inside the proper box
4659 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4660 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4664 c print *,xi,boxxsize,"pierwszy"
4666 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4667 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4668 C Condition for being inside the proper box
4669 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4670 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4674 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4675 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4676 C Condition for being inside the proper box
4677 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4678 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4681 do iint=1,nscp_gr(i)
4683 do j=iscpstart(i,iint),iscpend(i,iint)
4684 itypj=iabs(itype(j))
4685 if (itypj.eq.ntyp1) cycle
4686 C Uncomment following three lines for SC-p interactions
4690 C Uncomment following three lines for Ca-p interactions
4695 if (xj.lt.0) xj=xj+boxxsize
4697 if (yj.lt.0) yj=yj+boxysize
4699 if (zj.lt.0) zj=zj+boxzsize
4701 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4702 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4703 C Condition for being inside the proper box
4704 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4705 c & (xj.lt.((-0.5d0)*boxxsize))) then
4709 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4710 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4711 cC Condition for being inside the proper box
4712 c if ((yj.gt.((0.5d0)*boxysize)).or.
4713 c & (yj.lt.((-0.5d0)*boxysize))) then
4717 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4718 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4719 C Condition for being inside the proper box
4720 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4721 c & (zj.lt.((-0.5d0)*boxzsize))) then
4724 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
4725 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4733 xj=xj_safe+xshift*boxxsize
4734 yj=yj_safe+yshift*boxysize
4735 zj=zj_safe+zshift*boxzsize
4736 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4737 if(dist_temp.lt.dist_init) then
4747 if (subchap.eq.1) then
4756 c print *,xj,yj,zj,'polozenie j'
4757 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4759 sss=sscale(1.0d0/(dsqrt(rrij)))
4760 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
4761 c if (sss.eq.0) print *,'czasem jest OK'
4762 if (sss.le.0.0d0) cycle
4763 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4765 e1=fac*fac*aad(itypj,iteli)
4766 e2=fac*bad(itypj,iteli)
4767 if (iabs(j-i) .le. 2) then
4770 evdw2_14=evdw2_14+(e1+e2)*sss
4773 evdw2=evdw2+evdwij*sss
4774 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4775 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4778 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4780 fac=-(evdwij+e1)*rrij*sss
4781 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4785 cgrad if (j.lt.i) then
4786 cd write (iout,*) 'j<i'
4787 C Uncomment following three lines for SC-p interactions
4789 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4792 cd write (iout,*) 'j>i'
4794 cgrad ggg(k)=-ggg(k)
4795 C Uncomment following line for SC-p interactions
4796 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4797 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4801 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4803 cgrad kstart=min0(i+1,j)
4804 cgrad kend=max0(i-1,j-1)
4805 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4806 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4807 cgrad do k=kstart,kend
4809 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4813 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4814 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4816 c endif !endif for sscale cutoff
4826 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4827 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4828 gradx_scp(j,i)=expon*gradx_scp(j,i)
4831 C******************************************************************************
4835 C To save time the factor EXPON has been extracted from ALL components
4836 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4839 C******************************************************************************
4842 C--------------------------------------------------------------------------
4843 subroutine edis(ehpb)
4845 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4847 implicit real*8 (a-h,o-z)
4848 include 'DIMENSIONS'
4849 include 'COMMON.SBRIDGE'
4850 include 'COMMON.CHAIN'
4851 include 'COMMON.DERIV'
4852 include 'COMMON.VAR'
4853 include 'COMMON.INTERACT'
4854 include 'COMMON.IOUNITS'
4857 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4858 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4859 if (link_end.eq.0) return
4860 do i=link_start,link_end
4861 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4862 C CA-CA distance used in regularization of structure.
4865 C iii and jjj point to the residues for which the distance is assigned.
4866 if (ii.gt.nres) then
4873 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4874 c & dhpb(i),dhpb1(i),forcon(i)
4875 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4876 C distance and angle dependent SS bond potential.
4877 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4878 & iabs(itype(jjj)).eq.1) then
4879 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4880 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4881 if (.not.dyn_ss .and. i.le.nss) then
4882 C 15/02/13 CC dynamic SSbond - additional check
4884 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4885 call ssbond_ene(iii,jjj,eij)
4888 cd write (iout,*) "eij",eij
4890 C Calculate the distance between the two points and its difference from the
4894 C Get the force constant corresponding to this distance.
4896 C Calculate the contribution to energy.
4897 ehpb=ehpb+waga*rdis*rdis
4899 C Evaluate gradient.
4902 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4903 cd & ' waga=',waga,' fac=',fac
4905 ggg(j)=fac*(c(j,jj)-c(j,ii))
4907 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4908 C If this is a SC-SC distance, we need to calculate the contributions to the
4909 C Cartesian gradient in the SC vectors (ghpbx).
4912 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4913 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4916 cgrad do j=iii,jjj-1
4918 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4922 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4923 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4931 C--------------------------------------------------------------------------
4932 subroutine ssbond_ene(i,j,eij)
4934 C Calculate the distance and angle dependent SS-bond potential energy
4935 C using a free-energy function derived based on RHF/6-31G** ab initio
4936 C calculations of diethyl disulfide.
4938 C A. Liwo and U. Kozlowska, 11/24/03
4940 implicit real*8 (a-h,o-z)
4941 include 'DIMENSIONS'
4942 include 'COMMON.SBRIDGE'
4943 include 'COMMON.CHAIN'
4944 include 'COMMON.DERIV'
4945 include 'COMMON.LOCAL'
4946 include 'COMMON.INTERACT'
4947 include 'COMMON.VAR'
4948 include 'COMMON.IOUNITS'
4949 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4950 itypi=iabs(itype(i))
4954 dxi=dc_norm(1,nres+i)
4955 dyi=dc_norm(2,nres+i)
4956 dzi=dc_norm(3,nres+i)
4957 c dsci_inv=dsc_inv(itypi)
4958 dsci_inv=vbld_inv(nres+i)
4959 itypj=iabs(itype(j))
4960 c dscj_inv=dsc_inv(itypj)
4961 dscj_inv=vbld_inv(nres+j)
4965 dxj=dc_norm(1,nres+j)
4966 dyj=dc_norm(2,nres+j)
4967 dzj=dc_norm(3,nres+j)
4968 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4973 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4974 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4975 om12=dxi*dxj+dyi*dyj+dzi*dzj
4977 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4978 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4984 deltat12=om2-om1+2.0d0
4986 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4987 & +akct*deltad*deltat12
4988 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4989 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4990 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4991 c & " deltat12",deltat12," eij",eij
4992 ed=2*akcm*deltad+akct*deltat12
4994 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4995 eom1=-2*akth*deltat1-pom1-om2*pom2
4996 eom2= 2*akth*deltat2+pom1-om1*pom2
4999 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5000 ghpbx(k,i)=ghpbx(k,i)-ggk
5001 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5002 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5003 ghpbx(k,j)=ghpbx(k,j)+ggk
5004 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5005 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5006 ghpbc(k,i)=ghpbc(k,i)-ggk
5007 ghpbc(k,j)=ghpbc(k,j)+ggk
5010 C Calculate the components of the gradient in DC and X
5014 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5019 C--------------------------------------------------------------------------
5020 subroutine ebond(estr)
5022 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5024 implicit real*8 (a-h,o-z)
5025 include 'DIMENSIONS'
5026 include 'COMMON.LOCAL'
5027 include 'COMMON.GEO'
5028 include 'COMMON.INTERACT'
5029 include 'COMMON.DERIV'
5030 include 'COMMON.VAR'
5031 include 'COMMON.CHAIN'
5032 include 'COMMON.IOUNITS'
5033 include 'COMMON.NAMES'
5034 include 'COMMON.FFIELD'
5035 include 'COMMON.CONTROL'
5036 include 'COMMON.SETUP'
5037 double precision u(3),ud(3)
5040 do i=ibondp_start,ibondp_end
5041 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5042 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5044 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5045 c & *dc(j,i-1)/vbld(i)
5047 c if (energy_dec) write(iout,*)
5048 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5050 C Checking if it involves dummy (NH3+ or COO-) group
5051 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5052 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5053 diff = vbld(i)-vbldpDUM
5055 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5056 diff = vbld(i)-vbldp0
5058 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5059 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5062 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5064 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5067 estr=0.5d0*AKP*estr+estr1
5069 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5071 do i=ibond_start,ibond_end
5073 if (iti.ne.10 .and. iti.ne.ntyp1) then
5076 diff=vbld(i+nres)-vbldsc0(1,iti)
5077 if (energy_dec) write (iout,*)
5078 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5079 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5080 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5082 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5086 diff=vbld(i+nres)-vbldsc0(j,iti)
5087 ud(j)=aksc(j,iti)*diff
5088 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5102 uprod2=uprod2*u(k)*u(k)
5106 usumsqder=usumsqder+ud(j)*uprod2
5108 estr=estr+uprod/usum
5110 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5118 C--------------------------------------------------------------------------
5119 subroutine ebend(etheta)
5121 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5122 C angles gamma and its derivatives in consecutive thetas and gammas.
5124 implicit real*8 (a-h,o-z)
5125 include 'DIMENSIONS'
5126 include 'COMMON.LOCAL'
5127 include 'COMMON.GEO'
5128 include 'COMMON.INTERACT'
5129 include 'COMMON.DERIV'
5130 include 'COMMON.VAR'
5131 include 'COMMON.CHAIN'
5132 include 'COMMON.IOUNITS'
5133 include 'COMMON.NAMES'
5134 include 'COMMON.FFIELD'
5135 include 'COMMON.CONTROL'
5136 common /calcthet/ term1,term2,termm,diffak,ratak,
5137 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5138 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5139 double precision y(2),z(2)
5141 c time11=dexp(-2*time)
5144 c write (*,'(a,i2)') 'EBEND ICG=',icg
5145 do i=ithet_start,ithet_end
5146 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5147 & .or.itype(i).eq.ntyp1) cycle
5148 C Zero the energy function and its derivative at 0 or pi.
5149 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5151 ichir1=isign(1,itype(i-2))
5152 ichir2=isign(1,itype(i))
5153 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5154 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5155 if (itype(i-1).eq.10) then
5156 itype1=isign(10,itype(i-2))
5157 ichir11=isign(1,itype(i-2))
5158 ichir12=isign(1,itype(i-2))
5159 itype2=isign(10,itype(i))
5160 ichir21=isign(1,itype(i))
5161 ichir22=isign(1,itype(i))
5164 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5167 if (phii.ne.phii) phii=150.0
5177 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5180 if (phii1.ne.phii1) phii1=150.0
5192 C Calculate the "mean" value of theta from the part of the distribution
5193 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5194 C In following comments this theta will be referred to as t_c.
5195 thet_pred_mean=0.0d0
5197 athetk=athet(k,it,ichir1,ichir2)
5198 bthetk=bthet(k,it,ichir1,ichir2)
5200 athetk=athet(k,itype1,ichir11,ichir12)
5201 bthetk=bthet(k,itype2,ichir21,ichir22)
5203 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5204 c write(iout,*) 'chuj tu', y(k),z(k)
5206 dthett=thet_pred_mean*ssd
5207 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5208 C Derivatives of the "mean" values in gamma1 and gamma2.
5209 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5210 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5211 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5212 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5214 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5215 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5216 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5217 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5219 if (theta(i).gt.pi-delta) then
5220 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5222 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5223 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5224 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5226 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5228 else if (theta(i).lt.delta) then
5229 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5230 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5231 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5233 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5234 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5237 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5240 etheta=etheta+ethetai
5241 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5242 & 'ebend',i,ethetai,theta(i),itype(i)
5243 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5244 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5245 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5247 C Ufff.... We've done all this!!!
5250 C---------------------------------------------------------------------------
5251 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5253 implicit real*8 (a-h,o-z)
5254 include 'DIMENSIONS'
5255 include 'COMMON.LOCAL'
5256 include 'COMMON.IOUNITS'
5257 common /calcthet/ term1,term2,termm,diffak,ratak,
5258 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5259 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5260 C Calculate the contributions to both Gaussian lobes.
5261 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5262 C The "polynomial part" of the "standard deviation" of this part of
5263 C the distributioni.
5264 ccc write (iout,*) thetai,thet_pred_mean
5267 sig=sig*thet_pred_mean+polthet(j,it)
5269 C Derivative of the "interior part" of the "standard deviation of the"
5270 C gamma-dependent Gaussian lobe in t_c.
5271 sigtc=3*polthet(3,it)
5273 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5276 C Set the parameters of both Gaussian lobes of the distribution.
5277 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5278 fac=sig*sig+sigc0(it)
5281 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5282 sigsqtc=-4.0D0*sigcsq*sigtc
5283 c print *,i,sig,sigtc,sigsqtc
5284 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5285 sigtc=-sigtc/(fac*fac)
5286 C Following variable is sigma(t_c)**(-2)
5287 sigcsq=sigcsq*sigcsq
5289 sig0inv=1.0D0/sig0i**2
5290 delthec=thetai-thet_pred_mean
5291 delthe0=thetai-theta0i
5292 term1=-0.5D0*sigcsq*delthec*delthec
5293 term2=-0.5D0*sig0inv*delthe0*delthe0
5294 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5295 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5296 C NaNs in taking the logarithm. We extract the largest exponent which is added
5297 C to the energy (this being the log of the distribution) at the end of energy
5298 C term evaluation for this virtual-bond angle.
5299 if (term1.gt.term2) then
5301 term2=dexp(term2-termm)
5305 term1=dexp(term1-termm)
5308 C The ratio between the gamma-independent and gamma-dependent lobes of
5309 C the distribution is a Gaussian function of thet_pred_mean too.
5310 diffak=gthet(2,it)-thet_pred_mean
5311 ratak=diffak/gthet(3,it)**2
5312 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5313 C Let's differentiate it in thet_pred_mean NOW.
5315 C Now put together the distribution terms to make complete distribution.
5316 termexp=term1+ak*term2
5317 termpre=sigc+ak*sig0i
5318 C Contribution of the bending energy from this theta is just the -log of
5319 C the sum of the contributions from the two lobes and the pre-exponential
5320 C factor. Simple enough, isn't it?
5321 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5322 C write (iout,*) 'termexp',termexp,termm,termpre,i
5323 C NOW the derivatives!!!
5324 C 6/6/97 Take into account the deformation.
5325 E_theta=(delthec*sigcsq*term1
5326 & +ak*delthe0*sig0inv*term2)/termexp
5327 E_tc=((sigtc+aktc*sig0i)/termpre
5328 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5329 & aktc*term2)/termexp)
5332 c-----------------------------------------------------------------------------
5333 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5334 implicit real*8 (a-h,o-z)
5335 include 'DIMENSIONS'
5336 include 'COMMON.LOCAL'
5337 include 'COMMON.IOUNITS'
5338 common /calcthet/ term1,term2,termm,diffak,ratak,
5339 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5340 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5341 delthec=thetai-thet_pred_mean
5342 delthe0=thetai-theta0i
5343 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5344 t3 = thetai-thet_pred_mean
5348 t14 = t12+t6*sigsqtc
5350 t21 = thetai-theta0i
5356 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5357 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5358 & *(-t12*t9-ak*sig0inv*t27)
5362 C--------------------------------------------------------------------------
5363 subroutine ebend(etheta)
5365 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5366 C angles gamma and its derivatives in consecutive thetas and gammas.
5367 C ab initio-derived potentials from
5368 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5370 implicit real*8 (a-h,o-z)
5371 include 'DIMENSIONS'
5372 include 'COMMON.LOCAL'
5373 include 'COMMON.GEO'
5374 include 'COMMON.INTERACT'
5375 include 'COMMON.DERIV'
5376 include 'COMMON.VAR'
5377 include 'COMMON.CHAIN'
5378 include 'COMMON.IOUNITS'
5379 include 'COMMON.NAMES'
5380 include 'COMMON.FFIELD'
5381 include 'COMMON.CONTROL'
5382 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5383 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5384 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5385 & sinph1ph2(maxdouble,maxdouble)
5386 logical lprn /.false./, lprn1 /.false./
5388 do i=ithet_start,ithet_end
5389 c print *,i,itype(i-1),itype(i),itype(i-2)
5390 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5391 & .or.itype(i).eq.ntyp1) cycle
5392 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5394 if (iabs(itype(i+1)).eq.20) iblock=2
5395 if (iabs(itype(i+1)).ne.20) iblock=1
5399 theti2=0.5d0*theta(i)
5400 ityp2=ithetyp((itype(i-1)))
5402 coskt(k)=dcos(k*theti2)
5403 sinkt(k)=dsin(k*theti2)
5405 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5408 if (phii.ne.phii) phii=150.0
5412 ityp1=ithetyp((itype(i-2)))
5413 C propagation of chirality for glycine type
5415 cosph1(k)=dcos(k*phii)
5416 sinph1(k)=dsin(k*phii)
5426 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5429 if (phii1.ne.phii1) phii1=150.0
5434 ityp3=ithetyp((itype(i)))
5436 cosph2(k)=dcos(k*phii1)
5437 sinph2(k)=dsin(k*phii1)
5447 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5450 ccl=cosph1(l)*cosph2(k-l)
5451 ssl=sinph1(l)*sinph2(k-l)
5452 scl=sinph1(l)*cosph2(k-l)
5453 csl=cosph1(l)*sinph2(k-l)
5454 cosph1ph2(l,k)=ccl-ssl
5455 cosph1ph2(k,l)=ccl+ssl
5456 sinph1ph2(l,k)=scl+csl
5457 sinph1ph2(k,l)=scl-csl
5461 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5462 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5463 write (iout,*) "coskt and sinkt"
5465 write (iout,*) k,coskt(k),sinkt(k)
5469 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5470 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5473 & write (iout,*) "k",k,"
5474 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5475 & " ethetai",ethetai
5478 write (iout,*) "cosph and sinph"
5480 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5482 write (iout,*) "cosph1ph2 and sinph2ph2"
5485 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5486 & sinph1ph2(l,k),sinph1ph2(k,l)
5489 write(iout,*) "ethetai",ethetai
5493 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5494 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5495 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5496 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5497 ethetai=ethetai+sinkt(m)*aux
5498 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5499 dephii=dephii+k*sinkt(m)*(
5500 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5501 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5502 dephii1=dephii1+k*sinkt(m)*(
5503 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5504 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5506 & write (iout,*) "m",m," k",k," bbthet",
5507 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5508 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5509 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5510 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5514 & write(iout,*) "ethetai",ethetai
5518 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5519 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5520 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5521 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5522 ethetai=ethetai+sinkt(m)*aux
5523 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5524 dephii=dephii+l*sinkt(m)*(
5525 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5526 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5527 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5528 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5529 dephii1=dephii1+(k-l)*sinkt(m)*(
5530 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5531 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5532 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5533 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5535 write (iout,*) "m",m," k",k," l",l," ffthet",
5536 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5537 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5538 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5539 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5540 & " ethetai",ethetai
5541 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5542 & cosph1ph2(k,l)*sinkt(m),
5543 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5551 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5552 & i,theta(i)*rad2deg,phii*rad2deg,
5553 & phii1*rad2deg,ethetai
5555 etheta=etheta+ethetai
5556 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5557 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5558 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
5564 c-----------------------------------------------------------------------------
5565 subroutine esc(escloc)
5566 C Calculate the local energy of a side chain and its derivatives in the
5567 C corresponding virtual-bond valence angles THETA and the spherical angles
5569 implicit real*8 (a-h,o-z)
5570 include 'DIMENSIONS'
5571 include 'COMMON.GEO'
5572 include 'COMMON.LOCAL'
5573 include 'COMMON.VAR'
5574 include 'COMMON.INTERACT'
5575 include 'COMMON.DERIV'
5576 include 'COMMON.CHAIN'
5577 include 'COMMON.IOUNITS'
5578 include 'COMMON.NAMES'
5579 include 'COMMON.FFIELD'
5580 include 'COMMON.CONTROL'
5581 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5582 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5583 common /sccalc/ time11,time12,time112,theti,it,nlobit
5586 c write (iout,'(a)') 'ESC'
5587 do i=loc_start,loc_end
5589 if (it.eq.ntyp1) cycle
5590 if (it.eq.10) goto 1
5591 nlobit=nlob(iabs(it))
5592 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5593 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5594 theti=theta(i+1)-pipol
5599 if (x(2).gt.pi-delta) then
5603 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5605 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5606 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5608 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5609 & ddersc0(1),dersc(1))
5610 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5611 & ddersc0(3),dersc(3))
5613 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5615 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5616 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5617 & dersc0(2),esclocbi,dersc02)
5618 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5620 call splinthet(x(2),0.5d0*delta,ss,ssd)
5625 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5627 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5628 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5630 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5632 c write (iout,*) escloci
5633 else if (x(2).lt.delta) then
5637 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5639 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5640 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5642 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5643 & ddersc0(1),dersc(1))
5644 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5645 & ddersc0(3),dersc(3))
5647 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5649 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5650 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5651 & dersc0(2),esclocbi,dersc02)
5652 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5657 call splinthet(x(2),0.5d0*delta,ss,ssd)
5659 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5661 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5662 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5664 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5665 c write (iout,*) escloci
5667 call enesc(x,escloci,dersc,ddummy,.false.)
5670 escloc=escloc+escloci
5671 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5672 & 'escloc',i,escloci
5673 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5675 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5677 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5678 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5683 C---------------------------------------------------------------------------
5684 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5685 implicit real*8 (a-h,o-z)
5686 include 'DIMENSIONS'
5687 include 'COMMON.GEO'
5688 include 'COMMON.LOCAL'
5689 include 'COMMON.IOUNITS'
5690 common /sccalc/ time11,time12,time112,theti,it,nlobit
5691 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5692 double precision contr(maxlob,-1:1)
5694 c write (iout,*) 'it=',it,' nlobit=',nlobit
5698 if (mixed) ddersc(j)=0.0d0
5702 C Because of periodicity of the dependence of the SC energy in omega we have
5703 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5704 C To avoid underflows, first compute & store the exponents.
5712 z(k)=x(k)-censc(k,j,it)
5717 Axk=Axk+gaussc(l,k,j,it)*z(l)
5723 expfac=expfac+Ax(k,j,iii)*z(k)
5731 C As in the case of ebend, we want to avoid underflows in exponentiation and
5732 C subsequent NaNs and INFs in energy calculation.
5733 C Find the largest exponent
5737 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5741 cd print *,'it=',it,' emin=',emin
5743 C Compute the contribution to SC energy and derivatives
5748 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5749 if(adexp.ne.adexp) adexp=1.0
5752 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5754 cd print *,'j=',j,' expfac=',expfac
5755 escloc_i=escloc_i+expfac
5757 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5761 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5762 & +gaussc(k,2,j,it))*expfac
5769 dersc(1)=dersc(1)/cos(theti)**2
5770 ddersc(1)=ddersc(1)/cos(theti)**2
5773 escloci=-(dlog(escloc_i)-emin)
5775 dersc(j)=dersc(j)/escloc_i
5779 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5784 C------------------------------------------------------------------------------
5785 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5786 implicit real*8 (a-h,o-z)
5787 include 'DIMENSIONS'
5788 include 'COMMON.GEO'
5789 include 'COMMON.LOCAL'
5790 include 'COMMON.IOUNITS'
5791 common /sccalc/ time11,time12,time112,theti,it,nlobit
5792 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5793 double precision contr(maxlob)
5804 z(k)=x(k)-censc(k,j,it)
5810 Axk=Axk+gaussc(l,k,j,it)*z(l)
5816 expfac=expfac+Ax(k,j)*z(k)
5821 C As in the case of ebend, we want to avoid underflows in exponentiation and
5822 C subsequent NaNs and INFs in energy calculation.
5823 C Find the largest exponent
5826 if (emin.gt.contr(j)) emin=contr(j)
5830 C Compute the contribution to SC energy and derivatives
5834 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5835 escloc_i=escloc_i+expfac
5837 dersc(k)=dersc(k)+Ax(k,j)*expfac
5839 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5840 & +gaussc(1,2,j,it))*expfac
5844 dersc(1)=dersc(1)/cos(theti)**2
5845 dersc12=dersc12/cos(theti)**2
5846 escloci=-(dlog(escloc_i)-emin)
5848 dersc(j)=dersc(j)/escloc_i
5850 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5854 c----------------------------------------------------------------------------------
5855 subroutine esc(escloc)
5856 C Calculate the local energy of a side chain and its derivatives in the
5857 C corresponding virtual-bond valence angles THETA and the spherical angles
5858 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5859 C added by Urszula Kozlowska. 07/11/2007
5861 implicit real*8 (a-h,o-z)
5862 include 'DIMENSIONS'
5863 include 'COMMON.GEO'
5864 include 'COMMON.LOCAL'
5865 include 'COMMON.VAR'
5866 include 'COMMON.SCROT'
5867 include 'COMMON.INTERACT'
5868 include 'COMMON.DERIV'
5869 include 'COMMON.CHAIN'
5870 include 'COMMON.IOUNITS'
5871 include 'COMMON.NAMES'
5872 include 'COMMON.FFIELD'
5873 include 'COMMON.CONTROL'
5874 include 'COMMON.VECTORS'
5875 double precision x_prime(3),y_prime(3),z_prime(3)
5876 & , sumene,dsc_i,dp2_i,x(65),
5877 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5878 & de_dxx,de_dyy,de_dzz,de_dt
5879 double precision s1_t,s1_6_t,s2_t,s2_6_t
5881 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5882 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5883 & dt_dCi(3),dt_dCi1(3)
5884 common /sccalc/ time11,time12,time112,theti,it,nlobit
5887 do i=loc_start,loc_end
5888 if (itype(i).eq.ntyp1) cycle
5889 costtab(i+1) =dcos(theta(i+1))
5890 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5891 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5892 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5893 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5894 cosfac=dsqrt(cosfac2)
5895 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5896 sinfac=dsqrt(sinfac2)
5898 if (it.eq.10) goto 1
5900 C Compute the axes of tghe local cartesian coordinates system; store in
5901 c x_prime, y_prime and z_prime
5908 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5909 C & dc_norm(3,i+nres)
5911 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5912 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5915 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5918 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5919 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5920 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5921 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5922 c & " xy",scalar(x_prime(1),y_prime(1)),
5923 c & " xz",scalar(x_prime(1),z_prime(1)),
5924 c & " yy",scalar(y_prime(1),y_prime(1)),
5925 c & " yz",scalar(y_prime(1),z_prime(1)),
5926 c & " zz",scalar(z_prime(1),z_prime(1))
5928 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5929 C to local coordinate system. Store in xx, yy, zz.
5935 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5936 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5937 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5944 C Compute the energy of the ith side cbain
5946 c write (2,*) "xx",xx," yy",yy," zz",zz
5949 x(j) = sc_parmin(j,it)
5952 Cc diagnostics - remove later
5954 yy1 = dsin(alph(2))*dcos(omeg(2))
5955 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5956 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5957 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5959 C," --- ", xx_w,yy_w,zz_w
5962 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5963 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5965 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5966 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5968 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5969 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5970 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5971 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5972 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5974 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5975 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5976 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5977 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5978 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5980 dsc_i = 0.743d0+x(61)
5982 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5983 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5984 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5985 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5986 s1=(1+x(63))/(0.1d0 + dscp1)
5987 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5988 s2=(1+x(65))/(0.1d0 + dscp2)
5989 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5990 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5991 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5992 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5994 c & dscp1,dscp2,sumene
5995 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5996 escloc = escloc + sumene
5997 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6002 C This section to check the numerical derivatives of the energy of ith side
6003 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6004 C #define DEBUG in the code to turn it on.
6006 write (2,*) "sumene =",sumene
6010 write (2,*) xx,yy,zz
6011 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6012 de_dxx_num=(sumenep-sumene)/aincr
6014 write (2,*) "xx+ sumene from enesc=",sumenep
6017 write (2,*) xx,yy,zz
6018 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6019 de_dyy_num=(sumenep-sumene)/aincr
6021 write (2,*) "yy+ sumene from enesc=",sumenep
6024 write (2,*) xx,yy,zz
6025 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6026 de_dzz_num=(sumenep-sumene)/aincr
6028 write (2,*) "zz+ sumene from enesc=",sumenep
6029 costsave=cost2tab(i+1)
6030 sintsave=sint2tab(i+1)
6031 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6032 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6033 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6034 de_dt_num=(sumenep-sumene)/aincr
6035 write (2,*) " t+ sumene from enesc=",sumenep
6036 cost2tab(i+1)=costsave
6037 sint2tab(i+1)=sintsave
6038 C End of diagnostics section.
6041 C Compute the gradient of esc
6043 c zz=zz*dsign(1.0,dfloat(itype(i)))
6044 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6045 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6046 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6047 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6048 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6049 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6050 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6051 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6052 pom1=(sumene3*sint2tab(i+1)+sumene1)
6053 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6054 pom2=(sumene4*cost2tab(i+1)+sumene2)
6055 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6056 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6057 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6058 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6060 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6061 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6062 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6064 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6065 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6066 & +(pom1+pom2)*pom_dx
6068 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6071 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6072 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6073 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6075 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6076 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6077 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6078 & +x(59)*zz**2 +x(60)*xx*zz
6079 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6080 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6081 & +(pom1-pom2)*pom_dy
6083 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6086 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6087 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6088 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6089 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6090 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6091 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6092 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6093 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6095 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6098 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6099 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6100 & +pom1*pom_dt1+pom2*pom_dt2
6102 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6107 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6108 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6109 cosfac2xx=cosfac2*xx
6110 sinfac2yy=sinfac2*yy
6112 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6114 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6116 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6117 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6118 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6119 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6120 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6121 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6122 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6123 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6124 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6125 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6129 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6130 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6131 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6132 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6135 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6136 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6137 dZZ_XYZ(k)=vbld_inv(i+nres)*
6138 & (z_prime(k)-zz*dC_norm(k,i+nres))
6140 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6141 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6145 dXX_Ctab(k,i)=dXX_Ci(k)
6146 dXX_C1tab(k,i)=dXX_Ci1(k)
6147 dYY_Ctab(k,i)=dYY_Ci(k)
6148 dYY_C1tab(k,i)=dYY_Ci1(k)
6149 dZZ_Ctab(k,i)=dZZ_Ci(k)
6150 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6151 dXX_XYZtab(k,i)=dXX_XYZ(k)
6152 dYY_XYZtab(k,i)=dYY_XYZ(k)
6153 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6157 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6158 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6159 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6160 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6161 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6163 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6164 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6165 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6166 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6167 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6168 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6169 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6170 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6172 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6173 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6175 C to check gradient call subroutine check_grad
6181 c------------------------------------------------------------------------------
6182 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6184 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6185 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6186 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6187 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6189 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6190 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6192 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6193 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6194 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6195 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6196 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6198 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6199 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6200 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6201 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6202 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6204 dsc_i = 0.743d0+x(61)
6206 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6207 & *(xx*cost2+yy*sint2))
6208 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6209 & *(xx*cost2-yy*sint2))
6210 s1=(1+x(63))/(0.1d0 + dscp1)
6211 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6212 s2=(1+x(65))/(0.1d0 + dscp2)
6213 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6214 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6215 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6220 c------------------------------------------------------------------------------
6221 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6223 C This procedure calculates two-body contact function g(rij) and its derivative:
6226 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6229 C where x=(rij-r0ij)/delta
6231 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6234 double precision rij,r0ij,eps0ij,fcont,fprimcont
6235 double precision x,x2,x4,delta
6239 if (x.lt.-1.0D0) then
6242 else if (x.le.1.0D0) then
6245 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6246 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6253 c------------------------------------------------------------------------------
6254 subroutine splinthet(theti,delta,ss,ssder)
6255 implicit real*8 (a-h,o-z)
6256 include 'DIMENSIONS'
6257 include 'COMMON.VAR'
6258 include 'COMMON.GEO'
6261 if (theti.gt.pipol) then
6262 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6264 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6269 c------------------------------------------------------------------------------
6270 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6272 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6273 double precision ksi,ksi2,ksi3,a1,a2,a3
6274 a1=fprim0*delta/(f1-f0)
6280 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6281 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6284 c------------------------------------------------------------------------------
6285 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6287 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6288 double precision ksi,ksi2,ksi3,a1,a2,a3
6293 a2=3*(f1x-f0x)-2*fprim0x*delta
6294 a3=fprim0x*delta-2*(f1x-f0x)
6295 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6298 C-----------------------------------------------------------------------------
6300 C-----------------------------------------------------------------------------
6301 subroutine etor(etors,edihcnstr)
6302 implicit real*8 (a-h,o-z)
6303 include 'DIMENSIONS'
6304 include 'COMMON.VAR'
6305 include 'COMMON.GEO'
6306 include 'COMMON.LOCAL'
6307 include 'COMMON.TORSION'
6308 include 'COMMON.INTERACT'
6309 include 'COMMON.DERIV'
6310 include 'COMMON.CHAIN'
6311 include 'COMMON.NAMES'
6312 include 'COMMON.IOUNITS'
6313 include 'COMMON.FFIELD'
6314 include 'COMMON.TORCNSTR'
6315 include 'COMMON.CONTROL'
6317 C Set lprn=.true. for debugging
6321 do i=iphi_start,iphi_end
6323 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6324 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6325 itori=itortyp(itype(i-2))
6326 itori1=itortyp(itype(i-1))
6329 C Proline-Proline pair is a special case...
6330 if (itori.eq.3 .and. itori1.eq.3) then
6331 if (phii.gt.-dwapi3) then
6333 fac=1.0D0/(1.0D0-cosphi)
6334 etorsi=v1(1,3,3)*fac
6335 etorsi=etorsi+etorsi
6336 etors=etors+etorsi-v1(1,3,3)
6337 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6338 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6341 v1ij=v1(j+1,itori,itori1)
6342 v2ij=v2(j+1,itori,itori1)
6345 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6346 if (energy_dec) etors_ii=etors_ii+
6347 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6348 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6352 v1ij=v1(j,itori,itori1)
6353 v2ij=v2(j,itori,itori1)
6356 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6357 if (energy_dec) etors_ii=etors_ii+
6358 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6359 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6362 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6365 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6366 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6367 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6368 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6369 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6371 ! 6/20/98 - dihedral angle constraints
6374 itori=idih_constr(i)
6377 if (difi.gt.drange(i)) then
6379 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6380 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6381 else if (difi.lt.-drange(i)) then
6383 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6384 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6386 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6387 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6389 ! write (iout,*) 'edihcnstr',edihcnstr
6392 c------------------------------------------------------------------------------
6393 subroutine etor_d(etors_d)
6397 c----------------------------------------------------------------------------
6399 subroutine etor(etors,edihcnstr)
6400 implicit real*8 (a-h,o-z)
6401 include 'DIMENSIONS'
6402 include 'COMMON.VAR'
6403 include 'COMMON.GEO'
6404 include 'COMMON.LOCAL'
6405 include 'COMMON.TORSION'
6406 include 'COMMON.INTERACT'
6407 include 'COMMON.DERIV'
6408 include 'COMMON.CHAIN'
6409 include 'COMMON.NAMES'
6410 include 'COMMON.IOUNITS'
6411 include 'COMMON.FFIELD'
6412 include 'COMMON.TORCNSTR'
6413 include 'COMMON.CONTROL'
6415 C Set lprn=.true. for debugging
6419 do i=iphi_start,iphi_end
6420 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6421 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6422 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6423 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6424 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6425 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6426 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6427 C For introducing the NH3+ and COO- group please check the etor_d for reference
6430 if (iabs(itype(i)).eq.20) then
6435 itori=itortyp(itype(i-2))
6436 itori1=itortyp(itype(i-1))
6439 C Regular cosine and sine terms
6440 do j=1,nterm(itori,itori1,iblock)
6441 v1ij=v1(j,itori,itori1,iblock)
6442 v2ij=v2(j,itori,itori1,iblock)
6445 etors=etors+v1ij*cosphi+v2ij*sinphi
6446 if (energy_dec) etors_ii=etors_ii+
6447 & v1ij*cosphi+v2ij*sinphi
6448 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6452 C E = SUM ----------------------------------- - v1
6453 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6455 cosphi=dcos(0.5d0*phii)
6456 sinphi=dsin(0.5d0*phii)
6457 do j=1,nlor(itori,itori1,iblock)
6458 vl1ij=vlor1(j,itori,itori1)
6459 vl2ij=vlor2(j,itori,itori1)
6460 vl3ij=vlor3(j,itori,itori1)
6461 pom=vl2ij*cosphi+vl3ij*sinphi
6462 pom1=1.0d0/(pom*pom+1.0d0)
6463 etors=etors+vl1ij*pom1
6464 if (energy_dec) etors_ii=etors_ii+
6467 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6469 C Subtract the constant term
6470 etors=etors-v0(itori,itori1,iblock)
6471 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6472 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6474 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6475 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6476 & (v1(j,itori,itori1,iblock),j=1,6),
6477 & (v2(j,itori,itori1,iblock),j=1,6)
6478 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6479 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6481 ! 6/20/98 - dihedral angle constraints
6483 c do i=1,ndih_constr
6484 do i=idihconstr_start,idihconstr_end
6485 itori=idih_constr(i)
6487 difi=pinorm(phii-phi0(i))
6488 if (difi.gt.drange(i)) then
6490 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6491 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6492 else if (difi.lt.-drange(i)) then
6494 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6495 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6499 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6500 cd & rad2deg*phi0(i), rad2deg*drange(i),
6501 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6503 cd write (iout,*) 'edihcnstr',edihcnstr
6506 c----------------------------------------------------------------------------
6507 subroutine etor_d(etors_d)
6508 C 6/23/01 Compute double torsional energy
6509 implicit real*8 (a-h,o-z)
6510 include 'DIMENSIONS'
6511 include 'COMMON.VAR'
6512 include 'COMMON.GEO'
6513 include 'COMMON.LOCAL'
6514 include 'COMMON.TORSION'
6515 include 'COMMON.INTERACT'
6516 include 'COMMON.DERIV'
6517 include 'COMMON.CHAIN'
6518 include 'COMMON.NAMES'
6519 include 'COMMON.IOUNITS'
6520 include 'COMMON.FFIELD'
6521 include 'COMMON.TORCNSTR'
6523 C Set lprn=.true. for debugging
6527 c write(iout,*) "a tu??"
6528 do i=iphid_start,iphid_end
6529 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6530 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6531 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6532 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6533 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6534 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6535 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6536 & (itype(i+1).eq.ntyp1)) cycle
6537 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6538 itori=itortyp(itype(i-2))
6539 itori1=itortyp(itype(i-1))
6540 itori2=itortyp(itype(i))
6546 if (iabs(itype(i+1)).eq.20) iblock=2
6547 C Iblock=2 Proline type
6548 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6549 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6550 C if (itype(i+1).eq.ntyp1) iblock=3
6551 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6552 C IS or IS NOT need for this
6553 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6554 C is (itype(i-3).eq.ntyp1) ntblock=2
6555 C ntblock is N-terminal blocking group
6557 C Regular cosine and sine terms
6558 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6559 C Example of changes for NH3+ blocking group
6560 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6561 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6562 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6563 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6564 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6565 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6566 cosphi1=dcos(j*phii)
6567 sinphi1=dsin(j*phii)
6568 cosphi2=dcos(j*phii1)
6569 sinphi2=dsin(j*phii1)
6570 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6571 & v2cij*cosphi2+v2sij*sinphi2
6572 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6573 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6575 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6577 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6578 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6579 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6580 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6581 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6582 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6583 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6584 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6585 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6586 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6587 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6588 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6589 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6590 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6593 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6594 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6599 c------------------------------------------------------------------------------
6600 subroutine eback_sc_corr(esccor)
6601 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6602 c conformational states; temporarily implemented as differences
6603 c between UNRES torsional potentials (dependent on three types of
6604 c residues) and the torsional potentials dependent on all 20 types
6605 c of residues computed from AM1 energy surfaces of terminally-blocked
6606 c amino-acid residues.
6607 implicit real*8 (a-h,o-z)
6608 include 'DIMENSIONS'
6609 include 'COMMON.VAR'
6610 include 'COMMON.GEO'
6611 include 'COMMON.LOCAL'
6612 include 'COMMON.TORSION'
6613 include 'COMMON.SCCOR'
6614 include 'COMMON.INTERACT'
6615 include 'COMMON.DERIV'
6616 include 'COMMON.CHAIN'
6617 include 'COMMON.NAMES'
6618 include 'COMMON.IOUNITS'
6619 include 'COMMON.FFIELD'
6620 include 'COMMON.CONTROL'
6622 C Set lprn=.true. for debugging
6625 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6627 do i=itau_start,itau_end
6628 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6630 isccori=isccortyp(itype(i-2))
6631 isccori1=isccortyp(itype(i-1))
6632 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6634 do intertyp=1,3 !intertyp
6635 cc Added 09 May 2012 (Adasko)
6636 cc Intertyp means interaction type of backbone mainchain correlation:
6637 c 1 = SC...Ca...Ca...Ca
6638 c 2 = Ca...Ca...Ca...SC
6639 c 3 = SC...Ca...Ca...SCi
6641 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6642 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6643 & (itype(i-1).eq.ntyp1)))
6644 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6645 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6646 & .or.(itype(i).eq.ntyp1)))
6647 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6648 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6649 & (itype(i-3).eq.ntyp1)))) cycle
6650 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6651 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6653 do j=1,nterm_sccor(isccori,isccori1)
6654 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6655 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6656 cosphi=dcos(j*tauangle(intertyp,i))
6657 sinphi=dsin(j*tauangle(intertyp,i))
6658 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6659 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6661 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6662 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6664 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6665 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6666 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6667 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6668 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6674 c----------------------------------------------------------------------------
6675 subroutine multibody(ecorr)
6676 C This subroutine calculates multi-body contributions to energy following
6677 C the idea of Skolnick et al. If side chains I and J make a contact and
6678 C at the same time side chains I+1 and J+1 make a contact, an extra
6679 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6680 implicit real*8 (a-h,o-z)
6681 include 'DIMENSIONS'
6682 include 'COMMON.IOUNITS'
6683 include 'COMMON.DERIV'
6684 include 'COMMON.INTERACT'
6685 include 'COMMON.CONTACTS'
6686 double precision gx(3),gx1(3)
6689 C Set lprn=.true. for debugging
6693 write (iout,'(a)') 'Contact function values:'
6695 write (iout,'(i2,20(1x,i2,f10.5))')
6696 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6711 num_conti=num_cont(i)
6712 num_conti1=num_cont(i1)
6717 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6718 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6719 cd & ' ishift=',ishift
6720 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6721 C The system gains extra energy.
6722 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6723 endif ! j1==j+-ishift
6732 c------------------------------------------------------------------------------
6733 double precision function esccorr(i,j,k,l,jj,kk)
6734 implicit real*8 (a-h,o-z)
6735 include 'DIMENSIONS'
6736 include 'COMMON.IOUNITS'
6737 include 'COMMON.DERIV'
6738 include 'COMMON.INTERACT'
6739 include 'COMMON.CONTACTS'
6740 double precision gx(3),gx1(3)
6745 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6746 C Calculate the multi-body contribution to energy.
6747 C Calculate multi-body contributions to the gradient.
6748 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6749 cd & k,l,(gacont(m,kk,k),m=1,3)
6751 gx(m) =ekl*gacont(m,jj,i)
6752 gx1(m)=eij*gacont(m,kk,k)
6753 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6754 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6755 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6756 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6760 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6765 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6771 c------------------------------------------------------------------------------
6772 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6773 C This subroutine calculates multi-body contributions to hydrogen-bonding
6774 implicit real*8 (a-h,o-z)
6775 include 'DIMENSIONS'
6776 include 'COMMON.IOUNITS'
6779 parameter (max_cont=maxconts)
6780 parameter (max_dim=26)
6781 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6782 double precision zapas(max_dim,maxconts,max_fg_procs),
6783 & zapas_recv(max_dim,maxconts,max_fg_procs)
6784 common /przechowalnia/ zapas
6785 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6786 & status_array(MPI_STATUS_SIZE,maxconts*2)
6788 include 'COMMON.SETUP'
6789 include 'COMMON.FFIELD'
6790 include 'COMMON.DERIV'
6791 include 'COMMON.INTERACT'
6792 include 'COMMON.CONTACTS'
6793 include 'COMMON.CONTROL'
6794 include 'COMMON.LOCAL'
6795 double precision gx(3),gx1(3),time00
6798 C Set lprn=.true. for debugging
6803 if (nfgtasks.le.1) goto 30
6805 write (iout,'(a)') 'Contact function values before RECEIVE:'
6807 write (iout,'(2i3,50(1x,i2,f5.2))')
6808 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6809 & j=1,num_cont_hb(i))
6813 do i=1,ntask_cont_from
6816 do i=1,ntask_cont_to
6819 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6821 C Make the list of contacts to send to send to other procesors
6822 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6824 do i=iturn3_start,iturn3_end
6825 c write (iout,*) "make contact list turn3",i," num_cont",
6827 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6829 do i=iturn4_start,iturn4_end
6830 c write (iout,*) "make contact list turn4",i," num_cont",
6832 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6836 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6838 do j=1,num_cont_hb(i)
6841 iproc=iint_sent_local(k,jjc,ii)
6842 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6843 if (iproc.gt.0) then
6844 ncont_sent(iproc)=ncont_sent(iproc)+1
6845 nn=ncont_sent(iproc)
6847 zapas(2,nn,iproc)=jjc
6848 zapas(3,nn,iproc)=facont_hb(j,i)
6849 zapas(4,nn,iproc)=ees0p(j,i)
6850 zapas(5,nn,iproc)=ees0m(j,i)
6851 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6852 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6853 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6854 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6855 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6856 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6857 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6858 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6859 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6860 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6861 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6862 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6863 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6864 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6865 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6866 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6867 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6868 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6869 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6870 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6871 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6878 & "Numbers of contacts to be sent to other processors",
6879 & (ncont_sent(i),i=1,ntask_cont_to)
6880 write (iout,*) "Contacts sent"
6881 do ii=1,ntask_cont_to
6883 iproc=itask_cont_to(ii)
6884 write (iout,*) nn," contacts to processor",iproc,
6885 & " of CONT_TO_COMM group"
6887 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6895 CorrelID1=nfgtasks+fg_rank+1
6897 C Receive the numbers of needed contacts from other processors
6898 do ii=1,ntask_cont_from
6899 iproc=itask_cont_from(ii)
6901 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6902 & FG_COMM,req(ireq),IERR)
6904 c write (iout,*) "IRECV ended"
6906 C Send the number of contacts needed by other processors
6907 do ii=1,ntask_cont_to
6908 iproc=itask_cont_to(ii)
6910 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6911 & FG_COMM,req(ireq),IERR)
6913 c write (iout,*) "ISEND ended"
6914 c write (iout,*) "number of requests (nn)",ireq
6917 & call MPI_Waitall(ireq,req,status_array,ierr)
6919 c & "Numbers of contacts to be received from other processors",
6920 c & (ncont_recv(i),i=1,ntask_cont_from)
6924 do ii=1,ntask_cont_from
6925 iproc=itask_cont_from(ii)
6927 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6928 c & " of CONT_TO_COMM group"
6932 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6933 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6934 c write (iout,*) "ireq,req",ireq,req(ireq)
6937 C Send the contacts to processors that need them
6938 do ii=1,ntask_cont_to
6939 iproc=itask_cont_to(ii)
6941 c write (iout,*) nn," contacts to processor",iproc,
6942 c & " of CONT_TO_COMM group"
6945 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6946 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6947 c write (iout,*) "ireq,req",ireq,req(ireq)
6949 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6953 c write (iout,*) "number of requests (contacts)",ireq
6954 c write (iout,*) "req",(req(i),i=1,4)
6957 & call MPI_Waitall(ireq,req,status_array,ierr)
6958 do iii=1,ntask_cont_from
6959 iproc=itask_cont_from(iii)
6962 write (iout,*) "Received",nn," contacts from processor",iproc,
6963 & " of CONT_FROM_COMM group"
6966 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6971 ii=zapas_recv(1,i,iii)
6972 c Flag the received contacts to prevent double-counting
6973 jj=-zapas_recv(2,i,iii)
6974 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6976 nnn=num_cont_hb(ii)+1
6979 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6980 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6981 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6982 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6983 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6984 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6985 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6986 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6987 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6988 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6989 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6990 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6991 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6992 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6993 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6994 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6995 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6996 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6997 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6998 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6999 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7000 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7001 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7002 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7007 write (iout,'(a)') 'Contact function values after receive:'
7009 write (iout,'(2i3,50(1x,i3,f5.2))')
7010 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7011 & j=1,num_cont_hb(i))
7018 write (iout,'(a)') 'Contact function values:'
7020 write (iout,'(2i3,50(1x,i3,f5.2))')
7021 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7022 & j=1,num_cont_hb(i))
7026 C Remove the loop below after debugging !!!
7033 C Calculate the local-electrostatic correlation terms
7034 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7036 num_conti=num_cont_hb(i)
7037 num_conti1=num_cont_hb(i+1)
7044 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7045 c & ' jj=',jj,' kk=',kk
7046 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7047 & .or. j.lt.0 .and. j1.gt.0) .and.
7048 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7049 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7050 C The system gains extra energy.
7051 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7052 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7053 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7055 else if (j1.eq.j) then
7056 C Contacts I-J and I-(J+1) occur simultaneously.
7057 C The system loses extra energy.
7058 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7063 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7064 c & ' jj=',jj,' kk=',kk
7066 C Contacts I-J and (I+1)-J occur simultaneously.
7067 C The system loses extra energy.
7068 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7075 c------------------------------------------------------------------------------
7076 subroutine add_hb_contact(ii,jj,itask)
7077 implicit real*8 (a-h,o-z)
7078 include "DIMENSIONS"
7079 include "COMMON.IOUNITS"
7082 parameter (max_cont=maxconts)
7083 parameter (max_dim=26)
7084 include "COMMON.CONTACTS"
7085 double precision zapas(max_dim,maxconts,max_fg_procs),
7086 & zapas_recv(max_dim,maxconts,max_fg_procs)
7087 common /przechowalnia/ zapas
7088 integer i,j,ii,jj,iproc,itask(4),nn
7089 c write (iout,*) "itask",itask
7092 if (iproc.gt.0) then
7093 do j=1,num_cont_hb(ii)
7095 c write (iout,*) "i",ii," j",jj," jjc",jjc
7097 ncont_sent(iproc)=ncont_sent(iproc)+1
7098 nn=ncont_sent(iproc)
7099 zapas(1,nn,iproc)=ii
7100 zapas(2,nn,iproc)=jjc
7101 zapas(3,nn,iproc)=facont_hb(j,ii)
7102 zapas(4,nn,iproc)=ees0p(j,ii)
7103 zapas(5,nn,iproc)=ees0m(j,ii)
7104 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7105 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7106 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7107 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7108 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7109 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7110 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7111 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7112 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7113 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7114 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7115 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7116 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7117 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7118 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7119 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7120 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7121 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7122 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7123 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7124 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7132 c------------------------------------------------------------------------------
7133 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7135 C This subroutine calculates multi-body contributions to hydrogen-bonding
7136 implicit real*8 (a-h,o-z)
7137 include 'DIMENSIONS'
7138 include 'COMMON.IOUNITS'
7141 parameter (max_cont=maxconts)
7142 parameter (max_dim=70)
7143 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7144 double precision zapas(max_dim,maxconts,max_fg_procs),
7145 & zapas_recv(max_dim,maxconts,max_fg_procs)
7146 common /przechowalnia/ zapas
7147 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7148 & status_array(MPI_STATUS_SIZE,maxconts*2)
7150 include 'COMMON.SETUP'
7151 include 'COMMON.FFIELD'
7152 include 'COMMON.DERIV'
7153 include 'COMMON.LOCAL'
7154 include 'COMMON.INTERACT'
7155 include 'COMMON.CONTACTS'
7156 include 'COMMON.CHAIN'
7157 include 'COMMON.CONTROL'
7158 double precision gx(3),gx1(3)
7159 integer num_cont_hb_old(maxres)
7161 double precision eello4,eello5,eelo6,eello_turn6
7162 external eello4,eello5,eello6,eello_turn6
7163 C Set lprn=.true. for debugging
7168 num_cont_hb_old(i)=num_cont_hb(i)
7172 if (nfgtasks.le.1) goto 30
7174 write (iout,'(a)') 'Contact function values before RECEIVE:'
7176 write (iout,'(2i3,50(1x,i2,f5.2))')
7177 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7178 & j=1,num_cont_hb(i))
7182 do i=1,ntask_cont_from
7185 do i=1,ntask_cont_to
7188 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7190 C Make the list of contacts to send to send to other procesors
7191 do i=iturn3_start,iturn3_end
7192 c write (iout,*) "make contact list turn3",i," num_cont",
7194 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7196 do i=iturn4_start,iturn4_end
7197 c write (iout,*) "make contact list turn4",i," num_cont",
7199 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7203 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7205 do j=1,num_cont_hb(i)
7208 iproc=iint_sent_local(k,jjc,ii)
7209 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7210 if (iproc.ne.0) then
7211 ncont_sent(iproc)=ncont_sent(iproc)+1
7212 nn=ncont_sent(iproc)
7214 zapas(2,nn,iproc)=jjc
7215 zapas(3,nn,iproc)=d_cont(j,i)
7219 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7224 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7232 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7243 & "Numbers of contacts to be sent to other processors",
7244 & (ncont_sent(i),i=1,ntask_cont_to)
7245 write (iout,*) "Contacts sent"
7246 do ii=1,ntask_cont_to
7248 iproc=itask_cont_to(ii)
7249 write (iout,*) nn," contacts to processor",iproc,
7250 & " of CONT_TO_COMM group"
7252 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7260 CorrelID1=nfgtasks+fg_rank+1
7262 C Receive the numbers of needed contacts from other processors
7263 do ii=1,ntask_cont_from
7264 iproc=itask_cont_from(ii)
7266 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7267 & FG_COMM,req(ireq),IERR)
7269 c write (iout,*) "IRECV ended"
7271 C Send the number of contacts needed by other processors
7272 do ii=1,ntask_cont_to
7273 iproc=itask_cont_to(ii)
7275 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7276 & FG_COMM,req(ireq),IERR)
7278 c write (iout,*) "ISEND ended"
7279 c write (iout,*) "number of requests (nn)",ireq
7282 & call MPI_Waitall(ireq,req,status_array,ierr)
7284 c & "Numbers of contacts to be received from other processors",
7285 c & (ncont_recv(i),i=1,ntask_cont_from)
7289 do ii=1,ntask_cont_from
7290 iproc=itask_cont_from(ii)
7292 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7293 c & " of CONT_TO_COMM group"
7297 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7298 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7299 c write (iout,*) "ireq,req",ireq,req(ireq)
7302 C Send the contacts to processors that need them
7303 do ii=1,ntask_cont_to
7304 iproc=itask_cont_to(ii)
7306 c write (iout,*) nn," contacts to processor",iproc,
7307 c & " of CONT_TO_COMM group"
7310 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7311 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7312 c write (iout,*) "ireq,req",ireq,req(ireq)
7314 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7318 c write (iout,*) "number of requests (contacts)",ireq
7319 c write (iout,*) "req",(req(i),i=1,4)
7322 & call MPI_Waitall(ireq,req,status_array,ierr)
7323 do iii=1,ntask_cont_from
7324 iproc=itask_cont_from(iii)
7327 write (iout,*) "Received",nn," contacts from processor",iproc,
7328 & " of CONT_FROM_COMM group"
7331 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7336 ii=zapas_recv(1,i,iii)
7337 c Flag the received contacts to prevent double-counting
7338 jj=-zapas_recv(2,i,iii)
7339 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7341 nnn=num_cont_hb(ii)+1
7344 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7348 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7353 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7361 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7370 write (iout,'(a)') 'Contact function values after receive:'
7372 write (iout,'(2i3,50(1x,i3,5f6.3))')
7373 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7374 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7381 write (iout,'(a)') 'Contact function values:'
7383 write (iout,'(2i3,50(1x,i2,5f6.3))')
7384 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7385 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7391 C Remove the loop below after debugging !!!
7398 C Calculate the dipole-dipole interaction energies
7399 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7400 do i=iatel_s,iatel_e+1
7401 num_conti=num_cont_hb(i)
7410 C Calculate the local-electrostatic correlation terms
7411 c write (iout,*) "gradcorr5 in eello5 before loop"
7413 c write (iout,'(i5,3f10.5)')
7414 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7416 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7417 c write (iout,*) "corr loop i",i
7419 num_conti=num_cont_hb(i)
7420 num_conti1=num_cont_hb(i+1)
7427 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7428 c & ' jj=',jj,' kk=',kk
7429 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7430 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7431 & .or. j.lt.0 .and. j1.gt.0) .and.
7432 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7433 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7434 C The system gains extra energy.
7436 sqd1=dsqrt(d_cont(jj,i))
7437 sqd2=dsqrt(d_cont(kk,i1))
7438 sred_geom = sqd1*sqd2
7439 IF (sred_geom.lt.cutoff_corr) THEN
7440 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7442 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7443 cd & ' jj=',jj,' kk=',kk
7444 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7445 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7447 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7448 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7451 cd write (iout,*) 'sred_geom=',sred_geom,
7452 cd & ' ekont=',ekont,' fprim=',fprimcont,
7453 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7454 cd write (iout,*) "g_contij",g_contij
7455 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7456 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7457 call calc_eello(i,jp,i+1,jp1,jj,kk)
7458 if (wcorr4.gt.0.0d0)
7459 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7460 if (energy_dec.and.wcorr4.gt.0.0d0)
7461 1 write (iout,'(a6,4i5,0pf7.3)')
7462 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7463 c write (iout,*) "gradcorr5 before eello5"
7465 c write (iout,'(i5,3f10.5)')
7466 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7468 if (wcorr5.gt.0.0d0)
7469 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7470 c write (iout,*) "gradcorr5 after eello5"
7472 c write (iout,'(i5,3f10.5)')
7473 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7475 if (energy_dec.and.wcorr5.gt.0.0d0)
7476 1 write (iout,'(a6,4i5,0pf7.3)')
7477 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7478 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7479 cd write(2,*)'ijkl',i,jp,i+1,jp1
7480 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7481 & .or. wturn6.eq.0.0d0))then
7482 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7483 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7484 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7485 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7486 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7487 cd & 'ecorr6=',ecorr6
7488 cd write (iout,'(4e15.5)') sred_geom,
7489 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7490 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7491 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7492 else if (wturn6.gt.0.0d0
7493 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7494 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7495 eturn6=eturn6+eello_turn6(i,jj,kk)
7496 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7497 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7498 cd write (2,*) 'multibody_eello:eturn6',eturn6
7507 num_cont_hb(i)=num_cont_hb_old(i)
7509 c write (iout,*) "gradcorr5 in eello5"
7511 c write (iout,'(i5,3f10.5)')
7512 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7516 c------------------------------------------------------------------------------
7517 subroutine add_hb_contact_eello(ii,jj,itask)
7518 implicit real*8 (a-h,o-z)
7519 include "DIMENSIONS"
7520 include "COMMON.IOUNITS"
7523 parameter (max_cont=maxconts)
7524 parameter (max_dim=70)
7525 include "COMMON.CONTACTS"
7526 double precision zapas(max_dim,maxconts,max_fg_procs),
7527 & zapas_recv(max_dim,maxconts,max_fg_procs)
7528 common /przechowalnia/ zapas
7529 integer i,j,ii,jj,iproc,itask(4),nn
7530 c write (iout,*) "itask",itask
7533 if (iproc.gt.0) then
7534 do j=1,num_cont_hb(ii)
7536 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7538 ncont_sent(iproc)=ncont_sent(iproc)+1
7539 nn=ncont_sent(iproc)
7540 zapas(1,nn,iproc)=ii
7541 zapas(2,nn,iproc)=jjc
7542 zapas(3,nn,iproc)=d_cont(j,ii)
7546 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7551 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7559 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7571 c------------------------------------------------------------------------------
7572 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7573 implicit real*8 (a-h,o-z)
7574 include 'DIMENSIONS'
7575 include 'COMMON.IOUNITS'
7576 include 'COMMON.DERIV'
7577 include 'COMMON.INTERACT'
7578 include 'COMMON.CONTACTS'
7579 double precision gx(3),gx1(3)
7589 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7590 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7591 C Following 4 lines for diagnostics.
7596 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7597 c & 'Contacts ',i,j,
7598 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7599 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7601 C Calculate the multi-body contribution to energy.
7602 c ecorr=ecorr+ekont*ees
7603 C Calculate multi-body contributions to the gradient.
7604 coeffpees0pij=coeffp*ees0pij
7605 coeffmees0mij=coeffm*ees0mij
7606 coeffpees0pkl=coeffp*ees0pkl
7607 coeffmees0mkl=coeffm*ees0mkl
7609 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7610 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7611 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7612 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7613 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7614 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7615 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7616 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7617 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7618 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7619 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7620 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7621 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7622 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7623 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7624 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7625 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7626 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7627 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7628 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7629 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7630 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7631 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7632 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7633 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7638 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7639 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7640 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7641 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7646 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7647 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7648 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7649 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7652 c write (iout,*) "ehbcorr",ekont*ees
7657 C---------------------------------------------------------------------------
7658 subroutine dipole(i,j,jj)
7659 implicit real*8 (a-h,o-z)
7660 include 'DIMENSIONS'
7661 include 'COMMON.IOUNITS'
7662 include 'COMMON.CHAIN'
7663 include 'COMMON.FFIELD'
7664 include 'COMMON.DERIV'
7665 include 'COMMON.INTERACT'
7666 include 'COMMON.CONTACTS'
7667 include 'COMMON.TORSION'
7668 include 'COMMON.VAR'
7669 include 'COMMON.GEO'
7670 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7672 iti1 = itortyp(itype(i+1))
7673 if (j.lt.nres-1) then
7674 itj1 = itortyp(itype(j+1))
7679 dipi(iii,1)=Ub2(iii,i)
7680 dipderi(iii)=Ub2der(iii,i)
7681 dipi(iii,2)=b1(iii,i+1)
7682 dipj(iii,1)=Ub2(iii,j)
7683 dipderj(iii)=Ub2der(iii,j)
7684 dipj(iii,2)=b1(iii,j+1)
7688 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7691 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7698 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7702 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7707 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7708 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7710 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7712 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7714 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7719 C---------------------------------------------------------------------------
7720 subroutine calc_eello(i,j,k,l,jj,kk)
7722 C This subroutine computes matrices and vectors needed to calculate
7723 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7725 implicit real*8 (a-h,o-z)
7726 include 'DIMENSIONS'
7727 include 'COMMON.IOUNITS'
7728 include 'COMMON.CHAIN'
7729 include 'COMMON.DERIV'
7730 include 'COMMON.INTERACT'
7731 include 'COMMON.CONTACTS'
7732 include 'COMMON.TORSION'
7733 include 'COMMON.VAR'
7734 include 'COMMON.GEO'
7735 include 'COMMON.FFIELD'
7736 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7737 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7740 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7741 cd & ' jj=',jj,' kk=',kk
7742 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7743 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7744 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7747 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7748 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7751 call transpose2(aa1(1,1),aa1t(1,1))
7752 call transpose2(aa2(1,1),aa2t(1,1))
7755 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7756 & aa1tder(1,1,lll,kkk))
7757 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7758 & aa2tder(1,1,lll,kkk))
7762 C parallel orientation of the two CA-CA-CA frames.
7764 iti=itortyp(itype(i))
7768 itk1=itortyp(itype(k+1))
7769 itj=itortyp(itype(j))
7770 if (l.lt.nres-1) then
7771 itl1=itortyp(itype(l+1))
7775 C A1 kernel(j+1) A2T
7777 cd write (iout,'(3f10.5,5x,3f10.5)')
7778 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7780 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7781 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7782 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7783 C Following matrices are needed only for 6-th order cumulants
7784 IF (wcorr6.gt.0.0d0) THEN
7785 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7786 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7787 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7788 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7789 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7790 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7791 & ADtEAderx(1,1,1,1,1,1))
7793 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7794 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7795 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7796 & ADtEA1derx(1,1,1,1,1,1))
7798 C End 6-th order cumulants
7801 cd write (2,*) 'In calc_eello6'
7803 cd write (2,*) 'iii=',iii
7805 cd write (2,*) 'kkk=',kkk
7807 cd write (2,'(3(2f10.5),5x)')
7808 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7813 call transpose2(EUgder(1,1,k),auxmat(1,1))
7814 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7815 call transpose2(EUg(1,1,k),auxmat(1,1))
7816 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7817 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7821 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7822 & EAEAderx(1,1,lll,kkk,iii,1))
7826 C A1T kernel(i+1) A2
7827 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7828 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7829 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7830 C Following matrices are needed only for 6-th order cumulants
7831 IF (wcorr6.gt.0.0d0) THEN
7832 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7833 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7834 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7835 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7836 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7837 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7838 & ADtEAderx(1,1,1,1,1,2))
7839 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7840 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7841 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7842 & ADtEA1derx(1,1,1,1,1,2))
7844 C End 6-th order cumulants
7845 call transpose2(EUgder(1,1,l),auxmat(1,1))
7846 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7847 call transpose2(EUg(1,1,l),auxmat(1,1))
7848 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7849 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7853 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7854 & EAEAderx(1,1,lll,kkk,iii,2))
7859 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7860 C They are needed only when the fifth- or the sixth-order cumulants are
7862 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7863 call transpose2(AEA(1,1,1),auxmat(1,1))
7864 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7865 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7866 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7867 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7868 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7869 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7870 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7871 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7872 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7873 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7874 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7875 call transpose2(AEA(1,1,2),auxmat(1,1))
7876 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7877 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7878 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7879 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7880 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7881 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7882 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7883 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7884 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7885 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7886 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7887 C Calculate the Cartesian derivatives of the vectors.
7891 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7892 call matvec2(auxmat(1,1),b1(1,i),
7893 & AEAb1derx(1,lll,kkk,iii,1,1))
7894 call matvec2(auxmat(1,1),Ub2(1,i),
7895 & AEAb2derx(1,lll,kkk,iii,1,1))
7896 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7897 & AEAb1derx(1,lll,kkk,iii,2,1))
7898 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7899 & AEAb2derx(1,lll,kkk,iii,2,1))
7900 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7901 call matvec2(auxmat(1,1),b1(1,j),
7902 & AEAb1derx(1,lll,kkk,iii,1,2))
7903 call matvec2(auxmat(1,1),Ub2(1,j),
7904 & AEAb2derx(1,lll,kkk,iii,1,2))
7905 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7906 & AEAb1derx(1,lll,kkk,iii,2,2))
7907 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7908 & AEAb2derx(1,lll,kkk,iii,2,2))
7915 C Antiparallel orientation of the two CA-CA-CA frames.
7917 iti=itortyp(itype(i))
7921 itk1=itortyp(itype(k+1))
7922 itl=itortyp(itype(l))
7923 itj=itortyp(itype(j))
7924 if (j.lt.nres-1) then
7925 itj1=itortyp(itype(j+1))
7929 C A2 kernel(j-1)T A1T
7930 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7931 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7932 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7933 C Following matrices are needed only for 6-th order cumulants
7934 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7935 & j.eq.i+4 .and. l.eq.i+3)) THEN
7936 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7937 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7938 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7939 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7940 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7941 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7942 & ADtEAderx(1,1,1,1,1,1))
7943 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7944 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7945 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7946 & ADtEA1derx(1,1,1,1,1,1))
7948 C End 6-th order cumulants
7949 call transpose2(EUgder(1,1,k),auxmat(1,1))
7950 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7951 call transpose2(EUg(1,1,k),auxmat(1,1))
7952 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7953 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7957 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7958 & EAEAderx(1,1,lll,kkk,iii,1))
7962 C A2T kernel(i+1)T A1
7963 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7964 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7965 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7966 C Following matrices are needed only for 6-th order cumulants
7967 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7968 & j.eq.i+4 .and. l.eq.i+3)) THEN
7969 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7970 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7971 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7972 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7973 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7974 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7975 & ADtEAderx(1,1,1,1,1,2))
7976 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7977 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7978 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7979 & ADtEA1derx(1,1,1,1,1,2))
7981 C End 6-th order cumulants
7982 call transpose2(EUgder(1,1,j),auxmat(1,1))
7983 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7984 call transpose2(EUg(1,1,j),auxmat(1,1))
7985 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7986 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7990 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7991 & EAEAderx(1,1,lll,kkk,iii,2))
7996 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7997 C They are needed only when the fifth- or the sixth-order cumulants are
7999 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8000 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8001 call transpose2(AEA(1,1,1),auxmat(1,1))
8002 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8003 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8004 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8005 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8006 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8007 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8008 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8009 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8010 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8011 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8012 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8013 call transpose2(AEA(1,1,2),auxmat(1,1))
8014 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8015 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8016 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8017 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8018 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8019 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8020 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8021 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8022 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8023 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8024 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8025 C Calculate the Cartesian derivatives of the vectors.
8029 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8030 call matvec2(auxmat(1,1),b1(1,i),
8031 & AEAb1derx(1,lll,kkk,iii,1,1))
8032 call matvec2(auxmat(1,1),Ub2(1,i),
8033 & AEAb2derx(1,lll,kkk,iii,1,1))
8034 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8035 & AEAb1derx(1,lll,kkk,iii,2,1))
8036 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8037 & AEAb2derx(1,lll,kkk,iii,2,1))
8038 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8039 call matvec2(auxmat(1,1),b1(1,l),
8040 & AEAb1derx(1,lll,kkk,iii,1,2))
8041 call matvec2(auxmat(1,1),Ub2(1,l),
8042 & AEAb2derx(1,lll,kkk,iii,1,2))
8043 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8044 & AEAb1derx(1,lll,kkk,iii,2,2))
8045 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8046 & AEAb2derx(1,lll,kkk,iii,2,2))
8055 C---------------------------------------------------------------------------
8056 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8057 & KK,KKderg,AKA,AKAderg,AKAderx)
8061 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8062 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8063 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8068 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8070 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8073 cd if (lprn) write (2,*) 'In kernel'
8075 cd if (lprn) write (2,*) 'kkk=',kkk
8077 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8078 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8080 cd write (2,*) 'lll=',lll
8081 cd write (2,*) 'iii=1'
8083 cd write (2,'(3(2f10.5),5x)')
8084 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8087 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8088 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8090 cd write (2,*) 'lll=',lll
8091 cd write (2,*) 'iii=2'
8093 cd write (2,'(3(2f10.5),5x)')
8094 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8101 C---------------------------------------------------------------------------
8102 double precision function eello4(i,j,k,l,jj,kk)
8103 implicit real*8 (a-h,o-z)
8104 include 'DIMENSIONS'
8105 include 'COMMON.IOUNITS'
8106 include 'COMMON.CHAIN'
8107 include 'COMMON.DERIV'
8108 include 'COMMON.INTERACT'
8109 include 'COMMON.CONTACTS'
8110 include 'COMMON.TORSION'
8111 include 'COMMON.VAR'
8112 include 'COMMON.GEO'
8113 double precision pizda(2,2),ggg1(3),ggg2(3)
8114 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8118 cd print *,'eello4:',i,j,k,l,jj,kk
8119 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8120 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8121 cold eij=facont_hb(jj,i)
8122 cold ekl=facont_hb(kk,k)
8124 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8125 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8126 gcorr_loc(k-1)=gcorr_loc(k-1)
8127 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8129 gcorr_loc(l-1)=gcorr_loc(l-1)
8130 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8132 gcorr_loc(j-1)=gcorr_loc(j-1)
8133 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8138 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8139 & -EAEAderx(2,2,lll,kkk,iii,1)
8140 cd derx(lll,kkk,iii)=0.0d0
8144 cd gcorr_loc(l-1)=0.0d0
8145 cd gcorr_loc(j-1)=0.0d0
8146 cd gcorr_loc(k-1)=0.0d0
8148 cd write (iout,*)'Contacts have occurred for peptide groups',
8149 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8150 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8151 if (j.lt.nres-1) then
8158 if (l.lt.nres-1) then
8166 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8167 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8168 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8169 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8170 cgrad ghalf=0.5d0*ggg1(ll)
8171 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8172 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8173 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8174 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8175 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8176 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8177 cgrad ghalf=0.5d0*ggg2(ll)
8178 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8179 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8180 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8181 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8182 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8183 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8187 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8192 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8197 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8202 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8206 cd write (2,*) iii,gcorr_loc(iii)
8209 cd write (2,*) 'ekont',ekont
8210 cd write (iout,*) 'eello4',ekont*eel4
8213 C---------------------------------------------------------------------------
8214 double precision function eello5(i,j,k,l,jj,kk)
8215 implicit real*8 (a-h,o-z)
8216 include 'DIMENSIONS'
8217 include 'COMMON.IOUNITS'
8218 include 'COMMON.CHAIN'
8219 include 'COMMON.DERIV'
8220 include 'COMMON.INTERACT'
8221 include 'COMMON.CONTACTS'
8222 include 'COMMON.TORSION'
8223 include 'COMMON.VAR'
8224 include 'COMMON.GEO'
8225 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8226 double precision ggg1(3),ggg2(3)
8227 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8232 C /l\ / \ \ / \ / \ / C
8233 C / \ / \ \ / \ / \ / C
8234 C j| o |l1 | o | o| o | | o |o C
8235 C \ |/k\| |/ \| / |/ \| |/ \| C
8236 C \i/ \ / \ / / \ / \ C
8238 C (I) (II) (III) (IV) C
8240 C eello5_1 eello5_2 eello5_3 eello5_4 C
8242 C Antiparallel chains C
8245 C /j\ / \ \ / \ / \ / C
8246 C / \ / \ \ / \ / \ / C
8247 C j1| o |l | o | o| o | | o |o C
8248 C \ |/k\| |/ \| / |/ \| |/ \| C
8249 C \i/ \ / \ / / \ / \ C
8251 C (I) (II) (III) (IV) C
8253 C eello5_1 eello5_2 eello5_3 eello5_4 C
8255 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8257 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8258 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8263 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8265 itk=itortyp(itype(k))
8266 itl=itortyp(itype(l))
8267 itj=itortyp(itype(j))
8272 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8273 cd & eel5_3_num,eel5_4_num)
8277 derx(lll,kkk,iii)=0.0d0
8281 cd eij=facont_hb(jj,i)
8282 cd ekl=facont_hb(kk,k)
8284 cd write (iout,*)'Contacts have occurred for peptide groups',
8285 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8287 C Contribution from the graph I.
8288 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8289 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8290 call transpose2(EUg(1,1,k),auxmat(1,1))
8291 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8292 vv(1)=pizda(1,1)-pizda(2,2)
8293 vv(2)=pizda(1,2)+pizda(2,1)
8294 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8295 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8296 C Explicit gradient in virtual-dihedral angles.
8297 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8298 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8299 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8300 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8301 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8302 vv(1)=pizda(1,1)-pizda(2,2)
8303 vv(2)=pizda(1,2)+pizda(2,1)
8304 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8305 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8306 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8307 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8308 vv(1)=pizda(1,1)-pizda(2,2)
8309 vv(2)=pizda(1,2)+pizda(2,1)
8311 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8312 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8313 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8315 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8316 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8317 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8319 C Cartesian gradient
8323 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8325 vv(1)=pizda(1,1)-pizda(2,2)
8326 vv(2)=pizda(1,2)+pizda(2,1)
8327 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8328 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8329 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8335 C Contribution from graph II
8336 call transpose2(EE(1,1,itk),auxmat(1,1))
8337 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8338 vv(1)=pizda(1,1)+pizda(2,2)
8339 vv(2)=pizda(2,1)-pizda(1,2)
8340 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8341 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8342 C Explicit gradient in virtual-dihedral angles.
8343 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8344 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8345 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8346 vv(1)=pizda(1,1)+pizda(2,2)
8347 vv(2)=pizda(2,1)-pizda(1,2)
8349 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8350 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8351 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8353 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8354 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8355 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8357 C Cartesian gradient
8361 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8363 vv(1)=pizda(1,1)+pizda(2,2)
8364 vv(2)=pizda(2,1)-pizda(1,2)
8365 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8366 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8367 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8375 C Parallel orientation
8376 C Contribution from graph III
8377 call transpose2(EUg(1,1,l),auxmat(1,1))
8378 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8379 vv(1)=pizda(1,1)-pizda(2,2)
8380 vv(2)=pizda(1,2)+pizda(2,1)
8381 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8382 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8383 C Explicit gradient in virtual-dihedral angles.
8384 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8385 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8386 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8387 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8388 vv(1)=pizda(1,1)-pizda(2,2)
8389 vv(2)=pizda(1,2)+pizda(2,1)
8390 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8391 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8392 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8393 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8394 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8395 vv(1)=pizda(1,1)-pizda(2,2)
8396 vv(2)=pizda(1,2)+pizda(2,1)
8397 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8398 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8399 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8400 C Cartesian gradient
8404 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8406 vv(1)=pizda(1,1)-pizda(2,2)
8407 vv(2)=pizda(1,2)+pizda(2,1)
8408 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8409 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8410 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8415 C Contribution from graph IV
8417 call transpose2(EE(1,1,itl),auxmat(1,1))
8418 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8419 vv(1)=pizda(1,1)+pizda(2,2)
8420 vv(2)=pizda(2,1)-pizda(1,2)
8421 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8422 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8423 C Explicit gradient in virtual-dihedral angles.
8424 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8425 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8426 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8427 vv(1)=pizda(1,1)+pizda(2,2)
8428 vv(2)=pizda(2,1)-pizda(1,2)
8429 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8430 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8431 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8432 C Cartesian gradient
8436 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8438 vv(1)=pizda(1,1)+pizda(2,2)
8439 vv(2)=pizda(2,1)-pizda(1,2)
8440 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8441 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8442 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8447 C Antiparallel orientation
8448 C Contribution from graph III
8450 call transpose2(EUg(1,1,j),auxmat(1,1))
8451 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8452 vv(1)=pizda(1,1)-pizda(2,2)
8453 vv(2)=pizda(1,2)+pizda(2,1)
8454 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8455 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8456 C Explicit gradient in virtual-dihedral angles.
8457 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8458 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8459 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8460 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8461 vv(1)=pizda(1,1)-pizda(2,2)
8462 vv(2)=pizda(1,2)+pizda(2,1)
8463 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8464 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8465 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8466 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8467 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8468 vv(1)=pizda(1,1)-pizda(2,2)
8469 vv(2)=pizda(1,2)+pizda(2,1)
8470 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8471 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8472 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8473 C Cartesian gradient
8477 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8479 vv(1)=pizda(1,1)-pizda(2,2)
8480 vv(2)=pizda(1,2)+pizda(2,1)
8481 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8482 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8483 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8488 C Contribution from graph IV
8490 call transpose2(EE(1,1,itj),auxmat(1,1))
8491 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8492 vv(1)=pizda(1,1)+pizda(2,2)
8493 vv(2)=pizda(2,1)-pizda(1,2)
8494 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8495 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8496 C Explicit gradient in virtual-dihedral angles.
8497 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8498 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8499 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8500 vv(1)=pizda(1,1)+pizda(2,2)
8501 vv(2)=pizda(2,1)-pizda(1,2)
8502 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8503 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8504 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8505 C Cartesian gradient
8509 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8511 vv(1)=pizda(1,1)+pizda(2,2)
8512 vv(2)=pizda(2,1)-pizda(1,2)
8513 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8514 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8515 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8521 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8522 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8523 cd write (2,*) 'ijkl',i,j,k,l
8524 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8525 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8527 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8528 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8529 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8530 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8531 if (j.lt.nres-1) then
8538 if (l.lt.nres-1) then
8548 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8549 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8550 C summed up outside the subrouine as for the other subroutines
8551 C handling long-range interactions. The old code is commented out
8552 C with "cgrad" to keep track of changes.
8554 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8555 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8556 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8557 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8558 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8559 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8560 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8561 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8562 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8563 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8565 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8566 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8567 cgrad ghalf=0.5d0*ggg1(ll)
8569 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8570 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8571 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8572 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8573 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8574 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8575 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8576 cgrad ghalf=0.5d0*ggg2(ll)
8578 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8579 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8580 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8581 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8582 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8583 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8588 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8589 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8594 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8595 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8601 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8606 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8610 cd write (2,*) iii,g_corr5_loc(iii)
8613 cd write (2,*) 'ekont',ekont
8614 cd write (iout,*) 'eello5',ekont*eel5
8617 c--------------------------------------------------------------------------
8618 double precision function eello6(i,j,k,l,jj,kk)
8619 implicit real*8 (a-h,o-z)
8620 include 'DIMENSIONS'
8621 include 'COMMON.IOUNITS'
8622 include 'COMMON.CHAIN'
8623 include 'COMMON.DERIV'
8624 include 'COMMON.INTERACT'
8625 include 'COMMON.CONTACTS'
8626 include 'COMMON.TORSION'
8627 include 'COMMON.VAR'
8628 include 'COMMON.GEO'
8629 include 'COMMON.FFIELD'
8630 double precision ggg1(3),ggg2(3)
8631 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8636 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8644 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8645 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8649 derx(lll,kkk,iii)=0.0d0
8653 cd eij=facont_hb(jj,i)
8654 cd ekl=facont_hb(kk,k)
8660 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8661 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8662 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8663 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8664 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8665 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8667 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8668 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8669 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8670 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8671 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8672 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8676 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8678 C If turn contributions are considered, they will be handled separately.
8679 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8680 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8681 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8682 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8683 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8684 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8685 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8687 if (j.lt.nres-1) then
8694 if (l.lt.nres-1) then
8702 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8703 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8704 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8705 cgrad ghalf=0.5d0*ggg1(ll)
8707 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8708 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8709 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8710 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8711 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8712 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8713 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8714 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8715 cgrad ghalf=0.5d0*ggg2(ll)
8716 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8718 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8719 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8720 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8721 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8722 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8723 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8728 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8729 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8734 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8735 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8741 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8746 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8750 cd write (2,*) iii,g_corr6_loc(iii)
8753 cd write (2,*) 'ekont',ekont
8754 cd write (iout,*) 'eello6',ekont*eel6
8757 c--------------------------------------------------------------------------
8758 double precision function eello6_graph1(i,j,k,l,imat,swap)
8759 implicit real*8 (a-h,o-z)
8760 include 'DIMENSIONS'
8761 include 'COMMON.IOUNITS'
8762 include 'COMMON.CHAIN'
8763 include 'COMMON.DERIV'
8764 include 'COMMON.INTERACT'
8765 include 'COMMON.CONTACTS'
8766 include 'COMMON.TORSION'
8767 include 'COMMON.VAR'
8768 include 'COMMON.GEO'
8769 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8773 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8775 C Parallel Antiparallel C
8781 C \ j|/k\| / \ |/k\|l / C
8786 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8787 itk=itortyp(itype(k))
8788 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8789 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8790 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8791 call transpose2(EUgC(1,1,k),auxmat(1,1))
8792 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8793 vv1(1)=pizda1(1,1)-pizda1(2,2)
8794 vv1(2)=pizda1(1,2)+pizda1(2,1)
8795 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8796 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8797 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8798 s5=scalar2(vv(1),Dtobr2(1,i))
8799 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8800 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8801 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8802 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8803 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8804 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8805 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8806 & +scalar2(vv(1),Dtobr2der(1,i)))
8807 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8808 vv1(1)=pizda1(1,1)-pizda1(2,2)
8809 vv1(2)=pizda1(1,2)+pizda1(2,1)
8810 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8811 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8813 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8814 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8815 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8816 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8817 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8819 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8820 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8821 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8822 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8823 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8825 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8826 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8827 vv1(1)=pizda1(1,1)-pizda1(2,2)
8828 vv1(2)=pizda1(1,2)+pizda1(2,1)
8829 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8830 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8831 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8832 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8841 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8842 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8843 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8844 call transpose2(EUgC(1,1,k),auxmat(1,1))
8845 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8847 vv1(1)=pizda1(1,1)-pizda1(2,2)
8848 vv1(2)=pizda1(1,2)+pizda1(2,1)
8849 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8850 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8851 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8852 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8853 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8854 s5=scalar2(vv(1),Dtobr2(1,i))
8855 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8861 c----------------------------------------------------------------------------
8862 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8863 implicit real*8 (a-h,o-z)
8864 include 'DIMENSIONS'
8865 include 'COMMON.IOUNITS'
8866 include 'COMMON.CHAIN'
8867 include 'COMMON.DERIV'
8868 include 'COMMON.INTERACT'
8869 include 'COMMON.CONTACTS'
8870 include 'COMMON.TORSION'
8871 include 'COMMON.VAR'
8872 include 'COMMON.GEO'
8874 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8875 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8878 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8880 C Parallel Antiparallel C
8886 C \ j|/k\| \ |/k\|l C
8891 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8892 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8893 C AL 7/4/01 s1 would occur in the sixth-order moment,
8894 C but not in a cluster cumulant
8896 s1=dip(1,jj,i)*dip(1,kk,k)
8898 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8899 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8900 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8901 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8902 call transpose2(EUg(1,1,k),auxmat(1,1))
8903 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8904 vv(1)=pizda(1,1)-pizda(2,2)
8905 vv(2)=pizda(1,2)+pizda(2,1)
8906 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8907 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8909 eello6_graph2=-(s1+s2+s3+s4)
8911 eello6_graph2=-(s2+s3+s4)
8914 C Derivatives in gamma(i-1)
8917 s1=dipderg(1,jj,i)*dip(1,kk,k)
8919 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8920 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8921 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8922 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8924 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8926 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8928 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8930 C Derivatives in gamma(k-1)
8932 s1=dip(1,jj,i)*dipderg(1,kk,k)
8934 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8935 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8936 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8937 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8938 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8939 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8940 vv(1)=pizda(1,1)-pizda(2,2)
8941 vv(2)=pizda(1,2)+pizda(2,1)
8942 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8944 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8946 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8948 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8949 C Derivatives in gamma(j-1) or gamma(l-1)
8952 s1=dipderg(3,jj,i)*dip(1,kk,k)
8954 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8955 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8956 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8957 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8958 vv(1)=pizda(1,1)-pizda(2,2)
8959 vv(2)=pizda(1,2)+pizda(2,1)
8960 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8963 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8965 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8968 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8969 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8971 C Derivatives in gamma(l-1) or gamma(j-1)
8974 s1=dip(1,jj,i)*dipderg(3,kk,k)
8976 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8977 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8978 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8979 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8980 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8981 vv(1)=pizda(1,1)-pizda(2,2)
8982 vv(2)=pizda(1,2)+pizda(2,1)
8983 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8986 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8988 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8991 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8992 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8994 C Cartesian derivatives.
8996 write (2,*) 'In eello6_graph2'
8998 write (2,*) 'iii=',iii
9000 write (2,*) 'kkk=',kkk
9002 write (2,'(3(2f10.5),5x)')
9003 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9013 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9015 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9018 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9020 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9021 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9023 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9024 call transpose2(EUg(1,1,k),auxmat(1,1))
9025 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9027 vv(1)=pizda(1,1)-pizda(2,2)
9028 vv(2)=pizda(1,2)+pizda(2,1)
9029 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9030 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9032 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9034 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9037 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9039 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9046 c----------------------------------------------------------------------------
9047 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9048 implicit real*8 (a-h,o-z)
9049 include 'DIMENSIONS'
9050 include 'COMMON.IOUNITS'
9051 include 'COMMON.CHAIN'
9052 include 'COMMON.DERIV'
9053 include 'COMMON.INTERACT'
9054 include 'COMMON.CONTACTS'
9055 include 'COMMON.TORSION'
9056 include 'COMMON.VAR'
9057 include 'COMMON.GEO'
9058 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9060 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9062 C Parallel Antiparallel C
9068 C j|/k\| / |/k\|l / C
9073 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9075 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9076 C energy moment and not to the cluster cumulant.
9077 iti=itortyp(itype(i))
9078 if (j.lt.nres-1) then
9079 itj1=itortyp(itype(j+1))
9083 itk=itortyp(itype(k))
9084 itk1=itortyp(itype(k+1))
9085 if (l.lt.nres-1) then
9086 itl1=itortyp(itype(l+1))
9091 s1=dip(4,jj,i)*dip(4,kk,k)
9093 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9094 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9095 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9096 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9097 call transpose2(EE(1,1,itk),auxmat(1,1))
9098 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9099 vv(1)=pizda(1,1)+pizda(2,2)
9100 vv(2)=pizda(2,1)-pizda(1,2)
9101 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9102 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9103 cd & "sum",-(s2+s3+s4)
9105 eello6_graph3=-(s1+s2+s3+s4)
9107 eello6_graph3=-(s2+s3+s4)
9110 C Derivatives in gamma(k-1)
9111 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9112 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9113 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9114 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9115 C Derivatives in gamma(l-1)
9116 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9117 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9118 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9119 vv(1)=pizda(1,1)+pizda(2,2)
9120 vv(2)=pizda(2,1)-pizda(1,2)
9121 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9122 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9123 C Cartesian derivatives.
9129 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9131 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9134 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9136 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9137 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9139 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9140 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9142 vv(1)=pizda(1,1)+pizda(2,2)
9143 vv(2)=pizda(2,1)-pizda(1,2)
9144 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9146 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9148 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9151 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9153 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9155 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9161 c----------------------------------------------------------------------------
9162 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9163 implicit real*8 (a-h,o-z)
9164 include 'DIMENSIONS'
9165 include 'COMMON.IOUNITS'
9166 include 'COMMON.CHAIN'
9167 include 'COMMON.DERIV'
9168 include 'COMMON.INTERACT'
9169 include 'COMMON.CONTACTS'
9170 include 'COMMON.TORSION'
9171 include 'COMMON.VAR'
9172 include 'COMMON.GEO'
9173 include 'COMMON.FFIELD'
9174 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9175 & auxvec1(2),auxmat1(2,2)
9177 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9179 C Parallel Antiparallel C
9185 C \ j|/k\| \ |/k\|l C
9190 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9192 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9193 C energy moment and not to the cluster cumulant.
9194 cd write (2,*) 'eello_graph4: wturn6',wturn6
9195 iti=itortyp(itype(i))
9196 itj=itortyp(itype(j))
9197 if (j.lt.nres-1) then
9198 itj1=itortyp(itype(j+1))
9202 itk=itortyp(itype(k))
9203 if (k.lt.nres-1) then
9204 itk1=itortyp(itype(k+1))
9208 itl=itortyp(itype(l))
9209 if (l.lt.nres-1) then
9210 itl1=itortyp(itype(l+1))
9214 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9215 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9216 cd & ' itl',itl,' itl1',itl1
9219 s1=dip(3,jj,i)*dip(3,kk,k)
9221 s1=dip(2,jj,j)*dip(2,kk,l)
9224 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9225 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9227 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9228 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9230 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9231 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9233 call transpose2(EUg(1,1,k),auxmat(1,1))
9234 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9235 vv(1)=pizda(1,1)-pizda(2,2)
9236 vv(2)=pizda(2,1)+pizda(1,2)
9237 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9238 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9240 eello6_graph4=-(s1+s2+s3+s4)
9242 eello6_graph4=-(s2+s3+s4)
9244 C Derivatives in gamma(i-1)
9248 s1=dipderg(2,jj,i)*dip(3,kk,k)
9250 s1=dipderg(4,jj,j)*dip(2,kk,l)
9253 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9255 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9256 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9258 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9259 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9261 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9262 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9263 cd write (2,*) 'turn6 derivatives'
9265 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9267 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9271 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9273 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9277 C Derivatives in gamma(k-1)
9280 s1=dip(3,jj,i)*dipderg(2,kk,k)
9282 s1=dip(2,jj,j)*dipderg(4,kk,l)
9285 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9286 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9288 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9289 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9291 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9292 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9294 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9295 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9296 vv(1)=pizda(1,1)-pizda(2,2)
9297 vv(2)=pizda(2,1)+pizda(1,2)
9298 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9299 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9301 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9303 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9307 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9309 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9312 C Derivatives in gamma(j-1) or gamma(l-1)
9313 if (l.eq.j+1 .and. l.gt.1) then
9314 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9315 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9316 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9317 vv(1)=pizda(1,1)-pizda(2,2)
9318 vv(2)=pizda(2,1)+pizda(1,2)
9319 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9320 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9321 else if (j.gt.1) then
9322 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9323 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9324 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9325 vv(1)=pizda(1,1)-pizda(2,2)
9326 vv(2)=pizda(2,1)+pizda(1,2)
9327 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9328 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9329 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9331 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9334 C Cartesian derivatives.
9341 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9343 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9347 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9349 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9353 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9355 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9357 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9358 & b1(1,j+1),auxvec(1))
9359 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9361 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9362 & b1(1,l+1),auxvec(1))
9363 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9365 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9367 vv(1)=pizda(1,1)-pizda(2,2)
9368 vv(2)=pizda(2,1)+pizda(1,2)
9369 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9371 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9373 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9376 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9379 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9382 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9384 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9386 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9390 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9392 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9395 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9397 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9405 c----------------------------------------------------------------------------
9406 double precision function eello_turn6(i,jj,kk)
9407 implicit real*8 (a-h,o-z)
9408 include 'DIMENSIONS'
9409 include 'COMMON.IOUNITS'
9410 include 'COMMON.CHAIN'
9411 include 'COMMON.DERIV'
9412 include 'COMMON.INTERACT'
9413 include 'COMMON.CONTACTS'
9414 include 'COMMON.TORSION'
9415 include 'COMMON.VAR'
9416 include 'COMMON.GEO'
9417 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9418 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9420 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9421 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9422 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9423 C the respective energy moment and not to the cluster cumulant.
9432 iti=itortyp(itype(i))
9433 itk=itortyp(itype(k))
9434 itk1=itortyp(itype(k+1))
9435 itl=itortyp(itype(l))
9436 itj=itortyp(itype(j))
9437 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9438 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9439 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9444 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9446 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9450 derx_turn(lll,kkk,iii)=0.0d0
9457 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9459 cd write (2,*) 'eello6_5',eello6_5
9461 call transpose2(AEA(1,1,1),auxmat(1,1))
9462 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9463 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9464 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9466 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9467 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9468 s2 = scalar2(b1(1,k),vtemp1(1))
9470 call transpose2(AEA(1,1,2),atemp(1,1))
9471 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9472 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9473 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9475 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9476 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9477 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9479 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9480 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9481 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9482 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9483 ss13 = scalar2(b1(1,k),vtemp4(1))
9484 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9486 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9492 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9493 C Derivatives in gamma(i+2)
9497 call transpose2(AEA(1,1,1),auxmatd(1,1))
9498 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9499 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9500 call transpose2(AEAderg(1,1,2),atempd(1,1))
9501 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9502 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9504 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9505 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9506 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9512 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9513 C Derivatives in gamma(i+3)
9515 call transpose2(AEA(1,1,1),auxmatd(1,1))
9516 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9517 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9518 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9520 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9521 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9522 s2d = scalar2(b1(1,k),vtemp1d(1))
9524 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9525 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9527 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9529 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9530 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9531 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9539 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9540 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9542 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9543 & -0.5d0*ekont*(s2d+s12d)
9545 C Derivatives in gamma(i+4)
9546 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9547 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9548 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9550 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9551 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9552 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9560 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9562 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9564 C Derivatives in gamma(i+5)
9566 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9567 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9568 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9570 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9571 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9572 s2d = scalar2(b1(1,k),vtemp1d(1))
9574 call transpose2(AEA(1,1,2),atempd(1,1))
9575 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9576 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9578 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9579 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9581 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9582 ss13d = scalar2(b1(1,k),vtemp4d(1))
9583 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9591 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9592 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9594 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9595 & -0.5d0*ekont*(s2d+s12d)
9597 C Cartesian derivatives
9602 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9603 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9604 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9606 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9607 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9609 s2d = scalar2(b1(1,k),vtemp1d(1))
9611 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9612 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9613 s8d = -(atempd(1,1)+atempd(2,2))*
9614 & scalar2(cc(1,1,itl),vtemp2(1))
9616 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9618 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9619 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9626 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9629 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9633 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9634 & - 0.5d0*(s8d+s12d)
9636 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9645 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9647 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9648 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9649 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9650 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9651 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9653 ss13d = scalar2(b1(1,k),vtemp4d(1))
9654 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9655 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9659 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9660 cd & 16*eel_turn6_num
9662 if (j.lt.nres-1) then
9669 if (l.lt.nres-1) then
9677 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9678 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9679 cgrad ghalf=0.5d0*ggg1(ll)
9681 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9682 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9683 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9684 & +ekont*derx_turn(ll,2,1)
9685 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9686 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9687 & +ekont*derx_turn(ll,4,1)
9688 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9689 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9690 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9691 cgrad ghalf=0.5d0*ggg2(ll)
9693 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9694 & +ekont*derx_turn(ll,2,2)
9695 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9696 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9697 & +ekont*derx_turn(ll,4,2)
9698 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9699 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9700 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9705 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9710 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9716 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9721 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9725 cd write (2,*) iii,g_corr6_loc(iii)
9727 eello_turn6=ekont*eel_turn6
9728 cd write (2,*) 'ekont',ekont
9729 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9733 C-----------------------------------------------------------------------------
9734 double precision function scalar(u,v)
9735 !DIR$ INLINEALWAYS scalar
9737 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9740 double precision u(3),v(3)
9741 cd double precision sc
9749 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9752 crc-------------------------------------------------
9753 SUBROUTINE MATVEC2(A1,V1,V2)
9754 !DIR$ INLINEALWAYS MATVEC2
9756 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9758 implicit real*8 (a-h,o-z)
9759 include 'DIMENSIONS'
9760 DIMENSION A1(2,2),V1(2),V2(2)
9764 c 3 VI=VI+A1(I,K)*V1(K)
9768 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9769 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9774 C---------------------------------------
9775 SUBROUTINE MATMAT2(A1,A2,A3)
9777 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9779 implicit real*8 (a-h,o-z)
9780 include 'DIMENSIONS'
9781 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9782 c DIMENSION AI3(2,2)
9786 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9792 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9793 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9794 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9795 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9803 c-------------------------------------------------------------------------
9804 double precision function scalar2(u,v)
9805 !DIR$ INLINEALWAYS scalar2
9807 double precision u(2),v(2)
9810 scalar2=u(1)*v(1)+u(2)*v(2)
9814 C-----------------------------------------------------------------------------
9816 subroutine transpose2(a,at)
9817 !DIR$ INLINEALWAYS transpose2
9819 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9822 double precision a(2,2),at(2,2)
9829 c--------------------------------------------------------------------------
9830 subroutine transpose(n,a,at)
9833 double precision a(n,n),at(n,n)
9841 C---------------------------------------------------------------------------
9842 subroutine prodmat3(a1,a2,kk,transp,prod)
9843 !DIR$ INLINEALWAYS prodmat3
9845 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9849 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9851 crc double precision auxmat(2,2),prod_(2,2)
9854 crc call transpose2(kk(1,1),auxmat(1,1))
9855 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9856 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9858 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9859 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9860 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9861 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9862 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9863 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9864 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9865 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9868 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9869 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9871 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9872 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9873 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9874 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9875 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9876 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9877 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9878 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9881 c call transpose2(a2(1,1),a2t(1,1))
9884 crc print *,((prod_(i,j),i=1,2),j=1,2)
9885 crc print *,((prod(i,j),i=1,2),j=1,2)