1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
27 include 'COMMON.SPLITELE'
29 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
30 c & " nfgtasks",nfgtasks
31 if (nfgtasks.gt.1) then
33 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
34 if (fg_rank.eq.0) then
35 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
36 c print *,"Processor",myrank," BROADCAST iorder"
37 C FG master sets up the WEIGHTS_ array which will be broadcast to the
38 C FG slaves as WEIGHTS array.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
85 time_Bcast=time_Bcast+MPI_Wtime()-time00
86 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
87 c call chainbuild_cart
89 c print *,'Processor',myrank,' calling etotal ipot=',ipot
90 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
92 c if (modecalc.eq.12.or.modecalc.eq.14) then
93 c call int_from_cart1(.false.)
100 C Compute the side-chain and electrostatic interaction energy
102 goto (101,102,103,104,105,106) ipot
103 C Lennard-Jones potential.
105 cd print '(a)','Exit ELJ'
107 C Lennard-Jones-Kihara potential (shifted).
110 C Berne-Pechukas potential (dilated LJ, angular dependence).
113 C Gay-Berne potential (shifted LJ, angular dependence).
116 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
119 C Soft-sphere potential
120 106 call e_softsphere(evdw)
122 C Calculate electrostatic (H-bonding) energy of the main chain.
126 cmc Sep-06: egb takes care of dynamic ss bonds too
128 c if (dyn_ss) call dyn_set_nss
130 c print *,"Processor",myrank," computed USCSC"
136 time_vec=time_vec+MPI_Wtime()-time01
138 c print *,"Processor",myrank," left VEC_AND_DERIV"
141 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
142 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
143 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
144 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
146 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
147 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
148 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
149 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
151 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
160 write (iout,*) "Soft-spheer ELEC potential"
161 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
164 c print *,"Processor",myrank," computed UELEC"
166 C Calculate excluded-volume interaction energy between peptide groups
171 call escp(evdw2,evdw2_14)
177 c write (iout,*) "Soft-sphere SCP potential"
178 call escp_soft_sphere(evdw2,evdw2_14)
181 c Calculate the bond-stretching energy
185 C Calculate the disulfide-bridge and other energy and the contributions
186 C from other distance constraints.
187 cd print *,'Calling EHPB'
189 cd print *,'EHPB exitted succesfully.'
191 C Calculate the virtual-bond-angle energy.
193 if (wang.gt.0d0) then
198 c print *,"Processor",myrank," computed UB"
200 C Calculate the SC local energy.
203 c print *,"Processor",myrank," computed USC"
205 C Calculate the virtual-bond torsional energy.
207 cd print *,'nterm=',nterm
209 call etor(etors,edihcnstr)
214 c print *,"Processor",myrank," computed Utor"
216 C 6/23/01 Calculate double-torsional energy
218 if (wtor_d.gt.0) then
223 c print *,"Processor",myrank," computed Utord"
225 C 21/5/07 Calculate local sicdechain correlation energy
227 if (wsccor.gt.0.0d0) then
228 call eback_sc_corr(esccor)
232 c print *,"Processor",myrank," computed Usccorr"
234 C 12/1/95 Multi-body terms
238 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
239 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
240 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
241 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
242 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
249 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
250 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
251 cd write (iout,*) "multibody_hb ecorr",ecorr
253 c print *,"Processor",myrank," computed Ucorr"
255 C If performing constraint dynamics, call the constraint energy
256 C after the equilibration time
257 if(usampl.and.totT.gt.eq_time) then
265 time_enecalc=time_enecalc+MPI_Wtime()-time00
267 c print *,"Processor",myrank," computed Uconstr"
276 energia(2)=evdw2-evdw2_14
293 energia(8)=eello_turn3
294 energia(9)=eello_turn4
301 energia(19)=edihcnstr
303 energia(20)=Uconst+Uconst_back
305 c Here are the energies showed per procesor if the are more processors
306 c per molecule then we sum it up in sum_energy subroutine
307 c print *," Processor",myrank," calls SUM_ENERGY"
308 call sum_energy(energia,.true.)
309 if (dyn_ss) call dyn_set_nss
310 c print *," Processor",myrank," left SUM_ENERGY"
312 time_sumene=time_sumene+MPI_Wtime()-time00
316 c-------------------------------------------------------------------------------
317 subroutine sum_energy(energia,reduce)
318 implicit real*8 (a-h,o-z)
323 cMS$ATTRIBUTES C :: proc_proc
329 include 'COMMON.SETUP'
330 include 'COMMON.IOUNITS'
331 double precision energia(0:n_ene),enebuff(0:n_ene+1)
332 include 'COMMON.FFIELD'
333 include 'COMMON.DERIV'
334 include 'COMMON.INTERACT'
335 include 'COMMON.SBRIDGE'
336 include 'COMMON.CHAIN'
338 include 'COMMON.CONTROL'
339 include 'COMMON.TIME1'
342 if (nfgtasks.gt.1 .and. reduce) then
344 write (iout,*) "energies before REDUCE"
345 call enerprint(energia)
349 enebuff(i)=energia(i)
352 call MPI_Barrier(FG_COMM,IERR)
353 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
355 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
356 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
358 write (iout,*) "energies after REDUCE"
359 call enerprint(energia)
362 time_Reduce=time_Reduce+MPI_Wtime()-time00
364 if (fg_rank.eq.0) then
368 evdw2=energia(2)+energia(18)
384 eello_turn3=energia(8)
385 eello_turn4=energia(9)
392 edihcnstr=energia(19)
397 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
398 & +wang*ebe+wtor*etors+wscloc*escloc
399 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
400 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
401 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
402 & +wbond*estr+Uconst+wsccor*esccor
404 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
405 & +wang*ebe+wtor*etors+wscloc*escloc
406 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
407 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
408 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
409 & +wbond*estr+Uconst+wsccor*esccor
415 if (isnan(etot).ne.0) energia(0)=1.0d+99
417 if (isnan(etot)) energia(0)=1.0d+99
422 idumm=proc_proc(etot,i)
424 call proc_proc(etot,i)
426 if(i.eq.1)energia(0)=1.0d+99
433 c-------------------------------------------------------------------------------
434 subroutine sum_gradient
435 implicit real*8 (a-h,o-z)
440 cMS$ATTRIBUTES C :: proc_proc
446 double precision gradbufc(3,maxres),gradbufx(3,maxres),
447 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
448 include 'COMMON.SETUP'
449 include 'COMMON.IOUNITS'
450 include 'COMMON.FFIELD'
451 include 'COMMON.DERIV'
452 include 'COMMON.INTERACT'
453 include 'COMMON.SBRIDGE'
454 include 'COMMON.CHAIN'
456 include 'COMMON.CONTROL'
457 include 'COMMON.TIME1'
458 include 'COMMON.MAXGRAD'
459 include 'COMMON.SCCOR'
464 write (iout,*) "sum_gradient gvdwc, gvdwx"
466 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
467 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
472 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
473 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
474 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
477 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
478 C in virtual-bond-vector coordinates
481 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
483 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
484 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
486 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
488 c write (iout,'(i5,3f10.5,2x,f10.5)')
489 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
491 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
493 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
494 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
502 gradbufc(j,i)=wsc*gvdwc(j,i)+
503 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
504 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
505 & wel_loc*gel_loc_long(j,i)+
506 & wcorr*gradcorr_long(j,i)+
507 & wcorr5*gradcorr5_long(j,i)+
508 & wcorr6*gradcorr6_long(j,i)+
509 & wturn6*gcorr6_turn_long(j,i)+
516 gradbufc(j,i)=wsc*gvdwc(j,i)+
517 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
518 & welec*gelc_long(j,i)+
520 & wel_loc*gel_loc_long(j,i)+
521 & wcorr*gradcorr_long(j,i)+
522 & wcorr5*gradcorr5_long(j,i)+
523 & wcorr6*gradcorr6_long(j,i)+
524 & wturn6*gcorr6_turn_long(j,i)+
530 if (nfgtasks.gt.1) then
533 write (iout,*) "gradbufc before allreduce"
535 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
541 gradbufc_sum(j,i)=gradbufc(j,i)
544 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
545 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
546 c time_reduce=time_reduce+MPI_Wtime()-time00
548 c write (iout,*) "gradbufc_sum after allreduce"
550 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
555 c time_allreduce=time_allreduce+MPI_Wtime()-time00
563 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
564 write (iout,*) (i," jgrad_start",jgrad_start(i),
565 & " jgrad_end ",jgrad_end(i),
566 & i=igrad_start,igrad_end)
569 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
570 c do not parallelize this part.
572 c do i=igrad_start,igrad_end
573 c do j=jgrad_start(i),jgrad_end(i)
575 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
580 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
584 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
588 write (iout,*) "gradbufc after summing"
590 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
597 write (iout,*) "gradbufc"
599 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
605 gradbufc_sum(j,i)=gradbufc(j,i)
610 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
614 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
619 c gradbufc(k,i)=0.0d0
623 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
628 write (iout,*) "gradbufc after summing"
630 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
638 gradbufc(k,nres)=0.0d0
643 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
644 & wel_loc*gel_loc(j,i)+
645 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
646 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
647 & wel_loc*gel_loc_long(j,i)+
648 & wcorr*gradcorr_long(j,i)+
649 & wcorr5*gradcorr5_long(j,i)+
650 & wcorr6*gradcorr6_long(j,i)+
651 & wturn6*gcorr6_turn_long(j,i))+
653 & wcorr*gradcorr(j,i)+
654 & wturn3*gcorr3_turn(j,i)+
655 & wturn4*gcorr4_turn(j,i)+
656 & wcorr5*gradcorr5(j,i)+
657 & wcorr6*gradcorr6(j,i)+
658 & wturn6*gcorr6_turn(j,i)+
659 & wsccor*gsccorc(j,i)
660 & +wscloc*gscloc(j,i)
662 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
663 & wel_loc*gel_loc(j,i)+
664 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
665 & welec*gelc_long(j,i)
666 & wel_loc*gel_loc_long(j,i)+
667 & wcorr*gcorr_long(j,i)+
668 & wcorr5*gradcorr5_long(j,i)+
669 & wcorr6*gradcorr6_long(j,i)+
670 & wturn6*gcorr6_turn_long(j,i))+
672 & wcorr*gradcorr(j,i)+
673 & wturn3*gcorr3_turn(j,i)+
674 & wturn4*gcorr4_turn(j,i)+
675 & wcorr5*gradcorr5(j,i)+
676 & wcorr6*gradcorr6(j,i)+
677 & wturn6*gcorr6_turn(j,i)+
678 & wsccor*gsccorc(j,i)
679 & +wscloc*gscloc(j,i)
681 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
683 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
684 & wsccor*gsccorx(j,i)
685 & +wscloc*gsclocx(j,i)
689 write (iout,*) "gloc before adding corr"
691 write (iout,*) i,gloc(i,icg)
695 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
696 & +wcorr5*g_corr5_loc(i)
697 & +wcorr6*g_corr6_loc(i)
698 & +wturn4*gel_loc_turn4(i)
699 & +wturn3*gel_loc_turn3(i)
700 & +wturn6*gel_loc_turn6(i)
701 & +wel_loc*gel_loc_loc(i)
704 write (iout,*) "gloc after adding corr"
706 write (iout,*) i,gloc(i,icg)
710 if (nfgtasks.gt.1) then
713 gradbufc(j,i)=gradc(j,i,icg)
714 gradbufx(j,i)=gradx(j,i,icg)
718 glocbuf(i)=gloc(i,icg)
722 write (iout,*) "gloc_sc before reduce"
725 write (iout,*) i,j,gloc_sc(j,i,icg)
732 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
736 call MPI_Barrier(FG_COMM,IERR)
737 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
739 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
740 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
741 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
742 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
743 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
744 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
745 time_reduce=time_reduce+MPI_Wtime()-time00
746 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
747 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
748 time_reduce=time_reduce+MPI_Wtime()-time00
751 write (iout,*) "gloc_sc after reduce"
754 write (iout,*) i,j,gloc_sc(j,i,icg)
760 write (iout,*) "gloc after reduce"
762 write (iout,*) i,gloc(i,icg)
767 if (gnorm_check) then
769 c Compute the maximum elements of the gradient
779 gcorr3_turn_max=0.0d0
780 gcorr4_turn_max=0.0d0
783 gcorr6_turn_max=0.0d0
793 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
794 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
795 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
796 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
797 & gvdwc_scp_max=gvdwc_scp_norm
798 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
799 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
800 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
801 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
802 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
803 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
804 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
805 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
806 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
807 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
808 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
809 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
810 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
812 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
813 & gcorr3_turn_max=gcorr3_turn_norm
814 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
816 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
817 & gcorr4_turn_max=gcorr4_turn_norm
818 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
819 if (gradcorr5_norm.gt.gradcorr5_max)
820 & gradcorr5_max=gradcorr5_norm
821 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
822 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
823 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
825 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
826 & gcorr6_turn_max=gcorr6_turn_norm
827 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
828 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
829 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
830 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
831 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
832 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
833 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
834 if (gradx_scp_norm.gt.gradx_scp_max)
835 & gradx_scp_max=gradx_scp_norm
836 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
837 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
838 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
839 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
840 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
841 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
842 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
843 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
847 open(istat,file=statname,position="append")
849 open(istat,file=statname,access="append")
851 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
852 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
853 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
854 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
855 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
856 & gsccorx_max,gsclocx_max
858 if (gvdwc_max.gt.1.0d4) then
859 write (iout,*) "gvdwc gvdwx gradb gradbx"
861 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
862 & gradb(j,i),gradbx(j,i),j=1,3)
864 call pdbout(0.0d0,'cipiszcze',iout)
870 write (iout,*) "gradc gradx gloc"
872 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
873 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
877 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
881 c-------------------------------------------------------------------------------
882 subroutine rescale_weights(t_bath)
883 implicit real*8 (a-h,o-z)
885 include 'COMMON.IOUNITS'
886 include 'COMMON.FFIELD'
887 include 'COMMON.SBRIDGE'
888 double precision kfac /2.4d0/
889 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
891 c facT=2*temp0/(t_bath+temp0)
892 if (rescale_mode.eq.0) then
898 else if (rescale_mode.eq.1) then
899 facT=kfac/(kfac-1.0d0+t_bath/temp0)
900 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
901 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
902 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
903 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
904 else if (rescale_mode.eq.2) then
910 facT=licznik/dlog(dexp(x)+dexp(-x))
911 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
912 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
913 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
914 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
916 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
917 write (*,*) "Wrong RESCALE_MODE",rescale_mode
919 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
923 welec=weights(3)*fact
924 wcorr=weights(4)*fact3
925 wcorr5=weights(5)*fact4
926 wcorr6=weights(6)*fact5
927 wel_loc=weights(7)*fact2
928 wturn3=weights(8)*fact2
929 wturn4=weights(9)*fact3
930 wturn6=weights(10)*fact5
931 wtor=weights(13)*fact
932 wtor_d=weights(14)*fact2
933 wsccor=weights(21)*fact
937 C------------------------------------------------------------------------
938 subroutine enerprint(energia)
939 implicit real*8 (a-h,o-z)
941 include 'COMMON.IOUNITS'
942 include 'COMMON.FFIELD'
943 include 'COMMON.SBRIDGE'
945 double precision energia(0:n_ene)
950 evdw2=energia(2)+energia(18)
962 eello_turn3=energia(8)
963 eello_turn4=energia(9)
964 eello_turn6=energia(10)
970 edihcnstr=energia(19)
975 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
976 & estr,wbond,ebe,wang,
977 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
979 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
980 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
983 10 format (/'Virtual-chain energies:'//
984 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
985 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
986 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
987 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
988 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
989 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
990 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
991 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
992 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
993 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
994 & ' (SS bridges & dist. cnstr.)'/
995 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
996 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
997 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
998 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
999 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1000 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1001 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1002 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1003 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1004 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1005 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1006 & 'ETOT= ',1pE16.6,' (total)')
1008 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1009 & estr,wbond,ebe,wang,
1010 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1012 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1013 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1014 & ebr*nss,Uconst,etot
1015 10 format (/'Virtual-chain energies:'//
1016 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1017 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1018 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1019 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1020 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1021 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1022 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1023 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1024 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1025 & ' (SS bridges & dist. cnstr.)'/
1026 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1027 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1028 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1029 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1030 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1031 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1032 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1033 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1034 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1035 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1036 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1037 & 'ETOT= ',1pE16.6,' (total)')
1041 C-----------------------------------------------------------------------
1042 subroutine elj(evdw)
1044 C This subroutine calculates the interaction energy of nonbonded side chains
1045 C assuming the LJ potential of interaction.
1047 implicit real*8 (a-h,o-z)
1048 include 'DIMENSIONS'
1049 parameter (accur=1.0d-10)
1050 include 'COMMON.GEO'
1051 include 'COMMON.VAR'
1052 include 'COMMON.LOCAL'
1053 include 'COMMON.CHAIN'
1054 include 'COMMON.DERIV'
1055 include 'COMMON.INTERACT'
1056 include 'COMMON.TORSION'
1057 include 'COMMON.SBRIDGE'
1058 include 'COMMON.NAMES'
1059 include 'COMMON.IOUNITS'
1060 include 'COMMON.CONTACTS'
1062 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1064 do i=iatsc_s,iatsc_e
1065 itypi=iabs(itype(i))
1066 if (itypi.eq.ntyp1) cycle
1067 itypi1=iabs(itype(i+1))
1074 C Calculate SC interaction energy.
1076 do iint=1,nint_gr(i)
1077 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1078 cd & 'iend=',iend(i,iint)
1079 do j=istart(i,iint),iend(i,iint)
1080 itypj=iabs(itype(j))
1081 if (itypj.eq.ntyp1) cycle
1085 C Change 12/1/95 to calculate four-body interactions
1086 rij=xj*xj+yj*yj+zj*zj
1088 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1089 eps0ij=eps(itypi,itypj)
1091 e1=fac*fac*aa(itypi,itypj)
1092 e2=fac*bb(itypi,itypj)
1094 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1095 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1096 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1097 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1098 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1099 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1102 C Calculate the components of the gradient in DC and X
1104 fac=-rrij*(e1+evdwij)
1109 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1110 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1111 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1112 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1116 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1120 C 12/1/95, revised on 5/20/97
1122 C Calculate the contact function. The ith column of the array JCONT will
1123 C contain the numbers of atoms that make contacts with the atom I (of numbers
1124 C greater than I). The arrays FACONT and GACONT will contain the values of
1125 C the contact function and its derivative.
1127 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1128 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1129 C Uncomment next line, if the correlation interactions are contact function only
1130 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1132 sigij=sigma(itypi,itypj)
1133 r0ij=rs0(itypi,itypj)
1135 C Check whether the SC's are not too far to make a contact.
1138 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1139 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1141 if (fcont.gt.0.0D0) then
1142 C If the SC-SC distance if close to sigma, apply spline.
1143 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1144 cAdam & fcont1,fprimcont1)
1145 cAdam fcont1=1.0d0-fcont1
1146 cAdam if (fcont1.gt.0.0d0) then
1147 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1148 cAdam fcont=fcont*fcont1
1150 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1151 cga eps0ij=1.0d0/dsqrt(eps0ij)
1153 cga gg(k)=gg(k)*eps0ij
1155 cga eps0ij=-evdwij*eps0ij
1156 C Uncomment for AL's type of SC correlation interactions.
1157 cadam eps0ij=-evdwij
1158 num_conti=num_conti+1
1159 jcont(num_conti,i)=j
1160 facont(num_conti,i)=fcont*eps0ij
1161 fprimcont=eps0ij*fprimcont/rij
1163 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1164 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1165 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1166 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1167 gacont(1,num_conti,i)=-fprimcont*xj
1168 gacont(2,num_conti,i)=-fprimcont*yj
1169 gacont(3,num_conti,i)=-fprimcont*zj
1170 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1171 cd write (iout,'(2i3,3f10.5)')
1172 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1178 num_cont(i)=num_conti
1182 gvdwc(j,i)=expon*gvdwc(j,i)
1183 gvdwx(j,i)=expon*gvdwx(j,i)
1186 C******************************************************************************
1190 C To save time, the factor of EXPON has been extracted from ALL components
1191 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1194 C******************************************************************************
1197 C-----------------------------------------------------------------------------
1198 subroutine eljk(evdw)
1200 C This subroutine calculates the interaction energy of nonbonded side chains
1201 C assuming the LJK potential of interaction.
1203 implicit real*8 (a-h,o-z)
1204 include 'DIMENSIONS'
1205 include 'COMMON.GEO'
1206 include 'COMMON.VAR'
1207 include 'COMMON.LOCAL'
1208 include 'COMMON.CHAIN'
1209 include 'COMMON.DERIV'
1210 include 'COMMON.INTERACT'
1211 include 'COMMON.IOUNITS'
1212 include 'COMMON.NAMES'
1215 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1217 do i=iatsc_s,iatsc_e
1218 itypi=iabs(itype(i))
1219 if (itypi.eq.ntyp1) cycle
1220 itypi1=iabs(itype(i+1))
1225 C Calculate SC interaction energy.
1227 do iint=1,nint_gr(i)
1228 do j=istart(i,iint),iend(i,iint)
1229 itypj=iabs(itype(j))
1230 if (itypj.eq.ntyp1) cycle
1234 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1235 fac_augm=rrij**expon
1236 e_augm=augm(itypi,itypj)*fac_augm
1237 r_inv_ij=dsqrt(rrij)
1239 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1240 fac=r_shift_inv**expon
1241 e1=fac*fac*aa(itypi,itypj)
1242 e2=fac*bb(itypi,itypj)
1244 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1245 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1246 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1247 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1248 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1249 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1250 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1253 C Calculate the components of the gradient in DC and X
1255 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1260 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1261 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1262 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1263 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1267 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1275 gvdwc(j,i)=expon*gvdwc(j,i)
1276 gvdwx(j,i)=expon*gvdwx(j,i)
1281 C-----------------------------------------------------------------------------
1282 subroutine ebp(evdw)
1284 C This subroutine calculates the interaction energy of nonbonded side chains
1285 C assuming the Berne-Pechukas potential of interaction.
1287 implicit real*8 (a-h,o-z)
1288 include 'DIMENSIONS'
1289 include 'COMMON.GEO'
1290 include 'COMMON.VAR'
1291 include 'COMMON.LOCAL'
1292 include 'COMMON.CHAIN'
1293 include 'COMMON.DERIV'
1294 include 'COMMON.NAMES'
1295 include 'COMMON.INTERACT'
1296 include 'COMMON.IOUNITS'
1297 include 'COMMON.CALC'
1298 common /srutu/ icall
1299 c double precision rrsave(maxdim)
1302 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1304 c if (icall.eq.0) then
1310 do i=iatsc_s,iatsc_e
1311 itypi=iabs(itype(i))
1312 if (itypi.eq.ntyp1) cycle
1313 itypi1=iabs(itype(i+1))
1317 dxi=dc_norm(1,nres+i)
1318 dyi=dc_norm(2,nres+i)
1319 dzi=dc_norm(3,nres+i)
1320 c dsci_inv=dsc_inv(itypi)
1321 dsci_inv=vbld_inv(i+nres)
1323 C Calculate SC interaction energy.
1325 do iint=1,nint_gr(i)
1326 do j=istart(i,iint),iend(i,iint)
1328 itypj=iabs(itype(j))
1329 if (itypj.eq.ntyp1) cycle
1330 c dscj_inv=dsc_inv(itypj)
1331 dscj_inv=vbld_inv(j+nres)
1332 chi1=chi(itypi,itypj)
1333 chi2=chi(itypj,itypi)
1340 alf12=0.5D0*(alf1+alf2)
1341 C For diagnostics only!!!
1354 dxj=dc_norm(1,nres+j)
1355 dyj=dc_norm(2,nres+j)
1356 dzj=dc_norm(3,nres+j)
1357 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1358 cd if (icall.eq.0) then
1364 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1366 C Calculate whole angle-dependent part of epsilon and contributions
1367 C to its derivatives
1368 fac=(rrij*sigsq)**expon2
1369 e1=fac*fac*aa(itypi,itypj)
1370 e2=fac*bb(itypi,itypj)
1371 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1372 eps2der=evdwij*eps3rt
1373 eps3der=evdwij*eps2rt
1374 evdwij=evdwij*eps2rt*eps3rt
1377 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1378 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1379 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1380 cd & restyp(itypi),i,restyp(itypj),j,
1381 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1382 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1383 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1386 C Calculate gradient components.
1387 e1=e1*eps1*eps2rt**2*eps3rt**2
1388 fac=-expon*(e1+evdwij)
1391 C Calculate radial part of the gradient
1395 C Calculate the angular part of the gradient and sum add the contributions
1396 C to the appropriate components of the Cartesian gradient.
1404 C-----------------------------------------------------------------------------
1405 subroutine egb(evdw)
1407 C This subroutine calculates the interaction energy of nonbonded side chains
1408 C assuming the Gay-Berne potential of interaction.
1410 implicit real*8 (a-h,o-z)
1411 include 'DIMENSIONS'
1412 include 'COMMON.GEO'
1413 include 'COMMON.VAR'
1414 include 'COMMON.LOCAL'
1415 include 'COMMON.CHAIN'
1416 include 'COMMON.DERIV'
1417 include 'COMMON.NAMES'
1418 include 'COMMON.INTERACT'
1419 include 'COMMON.IOUNITS'
1420 include 'COMMON.CALC'
1421 include 'COMMON.CONTROL'
1422 include 'COMMON.SPLITELE'
1423 include 'COMMON.SBRIDGE'
1425 integer xshift,yshift,zshift
1427 ccccc energy_dec=.false.
1428 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1431 c if (icall.eq.0) lprn=.false.
1433 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1434 C we have the original box)
1438 do i=iatsc_s,iatsc_e
1439 itypi=iabs(itype(i))
1440 if (itypi.eq.ntyp1) cycle
1441 itypi1=iabs(itype(i+1))
1445 C Return atom into box, boxxsize is size of box in x dimension
1447 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1448 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1449 C Condition for being inside the proper box
1450 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1451 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1455 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1456 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1457 C Condition for being inside the proper box
1458 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1459 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1463 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1464 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1465 C Condition for being inside the proper box
1466 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1467 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1471 if (xi.lt.0) xi=xi+boxxsize
1473 if (yi.lt.0) yi=yi+boxysize
1475 if (zi.lt.0) zi=zi+boxzsize
1476 C xi=xi+xshift*boxxsize
1477 C yi=yi+yshift*boxysize
1478 C zi=zi+zshift*boxzsize
1480 dxi=dc_norm(1,nres+i)
1481 dyi=dc_norm(2,nres+i)
1482 dzi=dc_norm(3,nres+i)
1483 c dsci_inv=dsc_inv(itypi)
1484 dsci_inv=vbld_inv(i+nres)
1485 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1486 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1488 C Calculate SC interaction energy.
1490 do iint=1,nint_gr(i)
1491 do j=istart(i,iint),iend(i,iint)
1492 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1493 call dyn_ssbond_ene(i,j,evdwij)
1495 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1496 & 'evdw',i,j,evdwij,' ss'
1499 itypj=iabs(itype(j))
1500 if (itypj.eq.ntyp1) cycle
1501 c dscj_inv=dsc_inv(itypj)
1502 dscj_inv=vbld_inv(j+nres)
1503 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1504 c & 1.0d0/vbld(j+nres)
1505 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1506 sig0ij=sigma(itypi,itypj)
1507 chi1=chi(itypi,itypj)
1508 chi2=chi(itypj,itypi)
1515 alf12=0.5D0*(alf1+alf2)
1516 C For diagnostics only!!!
1529 C Return atom J into box the original box
1531 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1532 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1533 C Condition for being inside the proper box
1534 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1535 c & (xj.lt.((-0.5d0)*boxxsize))) then
1539 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1540 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1541 C Condition for being inside the proper box
1542 c if ((yj.gt.((0.5d0)*boxysize)).or.
1543 c & (yj.lt.((-0.5d0)*boxysize))) then
1547 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1548 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1549 C Condition for being inside the proper box
1550 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1551 c & (zj.lt.((-0.5d0)*boxzsize))) then
1555 if (xj.lt.0) xj=xj+boxxsize
1557 if (yj.lt.0) yj=yj+boxysize
1559 if (zj.lt.0) zj=zj+boxzsize
1560 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1568 xj=xj_safe+xshift*boxxsize
1569 yj=yj_safe+yshift*boxysize
1570 zj=zj_safe+zshift*boxzsize
1571 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1572 if(dist_temp.lt.dist_init) then
1582 if (subchap.eq.1) then
1591 dxj=dc_norm(1,nres+j)
1592 dyj=dc_norm(2,nres+j)
1593 dzj=dc_norm(3,nres+j)
1597 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1598 c write (iout,*) "j",j," dc_norm",
1599 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1600 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1602 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1603 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1605 c write (iout,'(a7,4f8.3)')
1606 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1607 if (sss.gt.0.0d0) then
1608 C Calculate angle-dependent terms of energy and contributions to their
1612 sig=sig0ij*dsqrt(sigsq)
1613 rij_shift=1.0D0/rij-sig+sig0ij
1614 c for diagnostics; uncomment
1615 c rij_shift=1.2*sig0ij
1616 C I hate to put IF's in the loops, but here don't have another choice!!!!
1617 if (rij_shift.le.0.0D0) then
1619 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1620 cd & restyp(itypi),i,restyp(itypj),j,
1621 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1625 c---------------------------------------------------------------
1626 rij_shift=1.0D0/rij_shift
1627 fac=rij_shift**expon
1628 e1=fac*fac*aa(itypi,itypj)
1629 e2=fac*bb(itypi,itypj)
1630 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1631 eps2der=evdwij*eps3rt
1632 eps3der=evdwij*eps2rt
1633 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1634 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1635 evdwij=evdwij*eps2rt*eps3rt
1636 evdw=evdw+evdwij*sss
1638 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1639 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1640 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1641 & restyp(itypi),i,restyp(itypj),j,
1642 & epsi,sigm,chi1,chi2,chip1,chip2,
1643 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1644 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1648 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1651 C Calculate gradient components.
1652 e1=e1*eps1*eps2rt**2*eps3rt**2
1653 fac=-expon*(e1+evdwij)*rij_shift
1656 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1657 c & evdwij,fac,sigma(itypi,itypj),expon
1658 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1660 C Calculate the radial part of the gradient
1664 C Calculate angular part of the gradient.
1674 c write (iout,*) "Number of loop steps in EGB:",ind
1675 cccc energy_dec=.false.
1678 C-----------------------------------------------------------------------------
1679 subroutine egbv(evdw)
1681 C This subroutine calculates the interaction energy of nonbonded side chains
1682 C assuming the Gay-Berne-Vorobjev potential of interaction.
1684 implicit real*8 (a-h,o-z)
1685 include 'DIMENSIONS'
1686 include 'COMMON.GEO'
1687 include 'COMMON.VAR'
1688 include 'COMMON.LOCAL'
1689 include 'COMMON.CHAIN'
1690 include 'COMMON.DERIV'
1691 include 'COMMON.NAMES'
1692 include 'COMMON.INTERACT'
1693 include 'COMMON.IOUNITS'
1694 include 'COMMON.CALC'
1695 common /srutu/ icall
1698 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1701 c if (icall.eq.0) lprn=.true.
1703 do i=iatsc_s,iatsc_e
1704 itypi=iabs(itype(i))
1705 if (itypi.eq.ntyp1) cycle
1706 itypi1=iabs(itype(i+1))
1710 dxi=dc_norm(1,nres+i)
1711 dyi=dc_norm(2,nres+i)
1712 dzi=dc_norm(3,nres+i)
1713 c dsci_inv=dsc_inv(itypi)
1714 dsci_inv=vbld_inv(i+nres)
1716 C Calculate SC interaction energy.
1718 do iint=1,nint_gr(i)
1719 do j=istart(i,iint),iend(i,iint)
1721 itypj=iabs(itype(j))
1722 if (itypj.eq.ntyp1) cycle
1723 c dscj_inv=dsc_inv(itypj)
1724 dscj_inv=vbld_inv(j+nres)
1725 sig0ij=sigma(itypi,itypj)
1726 r0ij=r0(itypi,itypj)
1727 chi1=chi(itypi,itypj)
1728 chi2=chi(itypj,itypi)
1735 alf12=0.5D0*(alf1+alf2)
1736 C For diagnostics only!!!
1749 dxj=dc_norm(1,nres+j)
1750 dyj=dc_norm(2,nres+j)
1751 dzj=dc_norm(3,nres+j)
1752 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1754 C Calculate angle-dependent terms of energy and contributions to their
1758 sig=sig0ij*dsqrt(sigsq)
1759 rij_shift=1.0D0/rij-sig+r0ij
1760 C I hate to put IF's in the loops, but here don't have another choice!!!!
1761 if (rij_shift.le.0.0D0) then
1766 c---------------------------------------------------------------
1767 rij_shift=1.0D0/rij_shift
1768 fac=rij_shift**expon
1769 e1=fac*fac*aa(itypi,itypj)
1770 e2=fac*bb(itypi,itypj)
1771 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1772 eps2der=evdwij*eps3rt
1773 eps3der=evdwij*eps2rt
1774 fac_augm=rrij**expon
1775 e_augm=augm(itypi,itypj)*fac_augm
1776 evdwij=evdwij*eps2rt*eps3rt
1777 evdw=evdw+evdwij+e_augm
1779 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1780 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1781 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1782 & restyp(itypi),i,restyp(itypj),j,
1783 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1784 & chi1,chi2,chip1,chip2,
1785 & eps1,eps2rt**2,eps3rt**2,
1786 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1789 C Calculate gradient components.
1790 e1=e1*eps1*eps2rt**2*eps3rt**2
1791 fac=-expon*(e1+evdwij)*rij_shift
1793 fac=rij*fac-2*expon*rrij*e_augm
1794 C Calculate the radial part of the gradient
1798 C Calculate angular part of the gradient.
1804 C-----------------------------------------------------------------------------
1805 subroutine sc_angular
1806 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1807 C om12. Called by ebp, egb, and egbv.
1809 include 'COMMON.CALC'
1810 include 'COMMON.IOUNITS'
1814 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1815 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1816 om12=dxi*dxj+dyi*dyj+dzi*dzj
1818 C Calculate eps1(om12) and its derivative in om12
1819 faceps1=1.0D0-om12*chiom12
1820 faceps1_inv=1.0D0/faceps1
1821 eps1=dsqrt(faceps1_inv)
1822 C Following variable is eps1*deps1/dom12
1823 eps1_om12=faceps1_inv*chiom12
1828 c write (iout,*) "om12",om12," eps1",eps1
1829 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1834 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1835 sigsq=1.0D0-facsig*faceps1_inv
1836 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1837 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1838 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1844 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1845 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1847 C Calculate eps2 and its derivatives in om1, om2, and om12.
1850 chipom12=chip12*om12
1851 facp=1.0D0-om12*chipom12
1853 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1854 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1855 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1856 C Following variable is the square root of eps2
1857 eps2rt=1.0D0-facp1*facp_inv
1858 C Following three variables are the derivatives of the square root of eps
1859 C in om1, om2, and om12.
1860 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1861 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1862 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1863 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1864 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1865 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1866 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1867 c & " eps2rt_om12",eps2rt_om12
1868 C Calculate whole angle-dependent part of epsilon and contributions
1869 C to its derivatives
1872 C----------------------------------------------------------------------------
1874 implicit real*8 (a-h,o-z)
1875 include 'DIMENSIONS'
1876 include 'COMMON.CHAIN'
1877 include 'COMMON.DERIV'
1878 include 'COMMON.CALC'
1879 include 'COMMON.IOUNITS'
1880 double precision dcosom1(3),dcosom2(3)
1881 cc print *,'sss=',sss
1882 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1883 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1884 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1885 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1889 c eom12=evdwij*eps1_om12
1891 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1892 c & " sigder",sigder
1893 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1894 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1896 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1897 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1900 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
1902 c write (iout,*) "gg",(gg(k),k=1,3)
1904 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1905 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1906 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
1907 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1908 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1909 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
1910 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1911 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1912 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1913 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1916 C Calculate the components of the gradient in DC and X
1920 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1924 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1925 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1929 C-----------------------------------------------------------------------
1930 subroutine e_softsphere(evdw)
1932 C This subroutine calculates the interaction energy of nonbonded side chains
1933 C assuming the LJ potential of interaction.
1935 implicit real*8 (a-h,o-z)
1936 include 'DIMENSIONS'
1937 parameter (accur=1.0d-10)
1938 include 'COMMON.GEO'
1939 include 'COMMON.VAR'
1940 include 'COMMON.LOCAL'
1941 include 'COMMON.CHAIN'
1942 include 'COMMON.DERIV'
1943 include 'COMMON.INTERACT'
1944 include 'COMMON.TORSION'
1945 include 'COMMON.SBRIDGE'
1946 include 'COMMON.NAMES'
1947 include 'COMMON.IOUNITS'
1948 include 'COMMON.CONTACTS'
1950 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1952 do i=iatsc_s,iatsc_e
1953 itypi=iabs(itype(i))
1954 if (itypi.eq.ntyp1) cycle
1955 itypi1=iabs(itype(i+1))
1960 C Calculate SC interaction energy.
1962 do iint=1,nint_gr(i)
1963 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1964 cd & 'iend=',iend(i,iint)
1965 do j=istart(i,iint),iend(i,iint)
1966 itypj=iabs(itype(j))
1967 if (itypj.eq.ntyp1) cycle
1971 rij=xj*xj+yj*yj+zj*zj
1972 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1973 r0ij=r0(itypi,itypj)
1975 c print *,i,j,r0ij,dsqrt(rij)
1976 if (rij.lt.r0ijsq) then
1977 evdwij=0.25d0*(rij-r0ijsq)**2
1985 C Calculate the components of the gradient in DC and X
1991 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1992 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1993 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1994 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1998 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2006 C--------------------------------------------------------------------------
2007 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2010 C Soft-sphere potential of p-p interaction
2012 implicit real*8 (a-h,o-z)
2013 include 'DIMENSIONS'
2014 include 'COMMON.CONTROL'
2015 include 'COMMON.IOUNITS'
2016 include 'COMMON.GEO'
2017 include 'COMMON.VAR'
2018 include 'COMMON.LOCAL'
2019 include 'COMMON.CHAIN'
2020 include 'COMMON.DERIV'
2021 include 'COMMON.INTERACT'
2022 include 'COMMON.CONTACTS'
2023 include 'COMMON.TORSION'
2024 include 'COMMON.VECTORS'
2025 include 'COMMON.FFIELD'
2027 C write(iout,*) 'In EELEC_soft_sphere'
2034 do i=iatel_s,iatel_e
2035 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2039 xmedi=c(1,i)+0.5d0*dxi
2040 ymedi=c(2,i)+0.5d0*dyi
2041 zmedi=c(3,i)+0.5d0*dzi
2042 xmedi=mod(xmedi,boxxsize)
2043 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2044 ymedi=mod(ymedi,boxysize)
2045 if (ymedi.lt.0) ymedi=ymedi+boxysize
2046 zmedi=mod(zmedi,boxzsize)
2047 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2049 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2050 do j=ielstart(i),ielend(i)
2051 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2055 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2056 r0ij=rpp(iteli,itelj)
2065 if (xj.lt.0) xj=xj+boxxsize
2067 if (yj.lt.0) yj=yj+boxysize
2069 if (zj.lt.0) zj=zj+boxzsize
2070 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2078 xj=xj_safe+xshift*boxxsize
2079 yj=yj_safe+yshift*boxysize
2080 zj=zj_safe+zshift*boxzsize
2081 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2082 if(dist_temp.lt.dist_init) then
2092 if (isubchap.eq.1) then
2101 rij=xj*xj+yj*yj+zj*zj
2102 sss=sscale(sqrt(rij))
2103 sssgrad=sscagrad(sqrt(rij))
2104 if (rij.lt.r0ijsq) then
2105 evdw1ij=0.25d0*(rij-r0ijsq)**2
2111 evdw1=evdw1+evdw1ij*sss
2113 C Calculate contributions to the Cartesian gradient.
2115 ggg(1)=fac*xj*sssgrad
2116 ggg(2)=fac*yj*sssgrad
2117 ggg(3)=fac*zj*sssgrad
2119 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2120 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2123 * Loop over residues i+1 thru j-1.
2127 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2132 cgrad do i=nnt,nct-1
2134 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2136 cgrad do j=i+1,nct-1
2138 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2144 c------------------------------------------------------------------------------
2145 subroutine vec_and_deriv
2146 implicit real*8 (a-h,o-z)
2147 include 'DIMENSIONS'
2151 include 'COMMON.IOUNITS'
2152 include 'COMMON.GEO'
2153 include 'COMMON.VAR'
2154 include 'COMMON.LOCAL'
2155 include 'COMMON.CHAIN'
2156 include 'COMMON.VECTORS'
2157 include 'COMMON.SETUP'
2158 include 'COMMON.TIME1'
2159 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2160 C Compute the local reference systems. For reference system (i), the
2161 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2162 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2164 do i=ivec_start,ivec_end
2168 if (i.eq.nres-1) then
2169 C Case of the last full residue
2170 C Compute the Z-axis
2171 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2172 costh=dcos(pi-theta(nres))
2173 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2177 C Compute the derivatives of uz
2179 uzder(2,1,1)=-dc_norm(3,i-1)
2180 uzder(3,1,1)= dc_norm(2,i-1)
2181 uzder(1,2,1)= dc_norm(3,i-1)
2183 uzder(3,2,1)=-dc_norm(1,i-1)
2184 uzder(1,3,1)=-dc_norm(2,i-1)
2185 uzder(2,3,1)= dc_norm(1,i-1)
2188 uzder(2,1,2)= dc_norm(3,i)
2189 uzder(3,1,2)=-dc_norm(2,i)
2190 uzder(1,2,2)=-dc_norm(3,i)
2192 uzder(3,2,2)= dc_norm(1,i)
2193 uzder(1,3,2)= dc_norm(2,i)
2194 uzder(2,3,2)=-dc_norm(1,i)
2196 C Compute the Y-axis
2199 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2201 C Compute the derivatives of uy
2204 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2205 & -dc_norm(k,i)*dc_norm(j,i-1)
2206 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2208 uyder(j,j,1)=uyder(j,j,1)-costh
2209 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2214 uygrad(l,k,j,i)=uyder(l,k,j)
2215 uzgrad(l,k,j,i)=uzder(l,k,j)
2219 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2220 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2221 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2222 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2225 C Compute the Z-axis
2226 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2227 costh=dcos(pi-theta(i+2))
2228 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2232 C Compute the derivatives of uz
2234 uzder(2,1,1)=-dc_norm(3,i+1)
2235 uzder(3,1,1)= dc_norm(2,i+1)
2236 uzder(1,2,1)= dc_norm(3,i+1)
2238 uzder(3,2,1)=-dc_norm(1,i+1)
2239 uzder(1,3,1)=-dc_norm(2,i+1)
2240 uzder(2,3,1)= dc_norm(1,i+1)
2243 uzder(2,1,2)= dc_norm(3,i)
2244 uzder(3,1,2)=-dc_norm(2,i)
2245 uzder(1,2,2)=-dc_norm(3,i)
2247 uzder(3,2,2)= dc_norm(1,i)
2248 uzder(1,3,2)= dc_norm(2,i)
2249 uzder(2,3,2)=-dc_norm(1,i)
2251 C Compute the Y-axis
2254 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2256 C Compute the derivatives of uy
2259 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2260 & -dc_norm(k,i)*dc_norm(j,i+1)
2261 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2263 uyder(j,j,1)=uyder(j,j,1)-costh
2264 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2269 uygrad(l,k,j,i)=uyder(l,k,j)
2270 uzgrad(l,k,j,i)=uzder(l,k,j)
2274 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2275 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2276 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2277 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2281 vbld_inv_temp(1)=vbld_inv(i+1)
2282 if (i.lt.nres-1) then
2283 vbld_inv_temp(2)=vbld_inv(i+2)
2285 vbld_inv_temp(2)=vbld_inv(i)
2290 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2291 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2296 #if defined(PARVEC) && defined(MPI)
2297 if (nfgtasks1.gt.1) then
2299 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2300 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2301 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2302 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2303 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2305 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2306 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2308 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2309 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2310 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2311 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2312 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2313 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2314 time_gather=time_gather+MPI_Wtime()-time00
2316 c if (fg_rank.eq.0) then
2317 c write (iout,*) "Arrays UY and UZ"
2319 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2326 C-----------------------------------------------------------------------------
2327 subroutine check_vecgrad
2328 implicit real*8 (a-h,o-z)
2329 include 'DIMENSIONS'
2330 include 'COMMON.IOUNITS'
2331 include 'COMMON.GEO'
2332 include 'COMMON.VAR'
2333 include 'COMMON.LOCAL'
2334 include 'COMMON.CHAIN'
2335 include 'COMMON.VECTORS'
2336 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2337 dimension uyt(3,maxres),uzt(3,maxres)
2338 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2339 double precision delta /1.0d-7/
2342 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2343 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2344 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2345 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2346 cd & (dc_norm(if90,i),if90=1,3)
2347 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2348 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2349 cd write(iout,'(a)')
2355 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2356 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2369 cd write (iout,*) 'i=',i
2371 erij(k)=dc_norm(k,i)
2375 dc_norm(k,i)=erij(k)
2377 dc_norm(j,i)=dc_norm(j,i)+delta
2378 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2380 c dc_norm(k,i)=dc_norm(k,i)/fac
2382 c write (iout,*) (dc_norm(k,i),k=1,3)
2383 c write (iout,*) (erij(k),k=1,3)
2386 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2387 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2388 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2389 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2391 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2392 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2393 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2396 dc_norm(k,i)=erij(k)
2399 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2400 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2401 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2402 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2403 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2404 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2405 cd write (iout,'(a)')
2410 C--------------------------------------------------------------------------
2411 subroutine set_matrices
2412 implicit real*8 (a-h,o-z)
2413 include 'DIMENSIONS'
2416 include "COMMON.SETUP"
2418 integer status(MPI_STATUS_SIZE)
2420 include 'COMMON.IOUNITS'
2421 include 'COMMON.GEO'
2422 include 'COMMON.VAR'
2423 include 'COMMON.LOCAL'
2424 include 'COMMON.CHAIN'
2425 include 'COMMON.DERIV'
2426 include 'COMMON.INTERACT'
2427 include 'COMMON.CONTACTS'
2428 include 'COMMON.TORSION'
2429 include 'COMMON.VECTORS'
2430 include 'COMMON.FFIELD'
2431 double precision auxvec(2),auxmat(2,2)
2433 C Compute the virtual-bond-torsional-angle dependent quantities needed
2434 C to calculate the el-loc multibody terms of various order.
2436 c write(iout,*) 'nphi=',nphi,nres
2438 do i=ivec_start+2,ivec_end+2
2443 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2444 iti = itortyp(itype(i-2))
2448 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2449 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2450 iti1 = itortyp(itype(i-1))
2455 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2456 & +bnew1(2,1,iti)*dsin(theta(i-1))
2457 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2458 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2459 & +bnew1(2,1,iti)*dcos(theta(i-1))
2460 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2461 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2462 c &*(cos(theta(i)/2.0)
2463 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2464 & +bnew2(2,1,iti)*dsin(theta(i-1))
2465 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2466 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2467 c &*(cos(theta(i)/2.0)
2468 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2469 & +bnew2(2,1,iti)*dcos(theta(i-1))
2470 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2471 c if (ggb1(1,i).eq.0.0d0) then
2472 c write(iout,*) 'i=',i,ggb1(1,i),
2473 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2474 c &bnew1(2,1,iti)*cos(theta(i)),
2475 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2477 b1(2,i-2)=bnew1(1,2,iti)
2479 b2(2,i-2)=bnew2(1,2,iti)
2481 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2482 EE(1,2,i-2)=eeold(1,2,iti)
2483 EE(2,1,i-2)=eeold(2,1,iti)
2484 EE(2,2,i-2)=eeold(2,2,iti)
2485 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2490 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2491 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2492 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2493 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2494 b1tilde(1,i-2)=b1(1,i-2)
2495 b1tilde(2,i-2)=-b1(2,i-2)
2496 b2tilde(1,i-2)=b2(1,i-2)
2497 b2tilde(2,i-2)=-b2(2,i-2)
2498 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2499 c write(iout,*) 'b1=',b1(1,i-2)
2500 c write (iout,*) 'theta=', theta(i-1)
2507 b1tilde(1,i-2)=b1(1,i-2)
2508 b1tilde(2,i-2)=-b1(2,i-2)
2509 b2tilde(1,i-2)=b2(1,i-2)
2510 b2tilde(2,i-2)=-b2(2,i-2)
2511 EE(1,2,i-2)=eeold(1,2,iti)
2512 EE(2,1,i-2)=eeold(2,1,iti)
2513 EE(2,2,i-2)=eeold(2,2,iti)
2514 EE(1,1,i-2)=eeold(1,1,iti)
2518 do i=ivec_start+2,ivec_end+2
2522 if (i .lt. nres+1) then
2559 if (i .gt. 3 .and. i .lt. nres+1) then
2560 obrot_der(1,i-2)=-sin1
2561 obrot_der(2,i-2)= cos1
2562 Ugder(1,1,i-2)= sin1
2563 Ugder(1,2,i-2)=-cos1
2564 Ugder(2,1,i-2)=-cos1
2565 Ugder(2,2,i-2)=-sin1
2568 obrot2_der(1,i-2)=-dwasin2
2569 obrot2_der(2,i-2)= dwacos2
2570 Ug2der(1,1,i-2)= dwasin2
2571 Ug2der(1,2,i-2)=-dwacos2
2572 Ug2der(2,1,i-2)=-dwacos2
2573 Ug2der(2,2,i-2)=-dwasin2
2575 obrot_der(1,i-2)=0.0d0
2576 obrot_der(2,i-2)=0.0d0
2577 Ugder(1,1,i-2)=0.0d0
2578 Ugder(1,2,i-2)=0.0d0
2579 Ugder(2,1,i-2)=0.0d0
2580 Ugder(2,2,i-2)=0.0d0
2581 obrot2_der(1,i-2)=0.0d0
2582 obrot2_der(2,i-2)=0.0d0
2583 Ug2der(1,1,i-2)=0.0d0
2584 Ug2der(1,2,i-2)=0.0d0
2585 Ug2der(2,1,i-2)=0.0d0
2586 Ug2der(2,2,i-2)=0.0d0
2588 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2589 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2590 iti = itortyp(itype(i-2))
2594 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2595 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2596 iti1 = itortyp(itype(i-1))
2600 cd write (iout,*) '*******i',i,' iti1',iti
2601 cd write (iout,*) 'b1',b1(:,iti)
2602 cd write (iout,*) 'b2',b2(:,iti)
2603 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2604 c if (i .gt. iatel_s+2) then
2605 if (i .gt. nnt+2) then
2606 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2608 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2609 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2611 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2612 c & EE(1,2,iti),EE(2,2,iti)
2613 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2614 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2615 c write(iout,*) "Macierz EUG",
2616 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2618 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2620 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2621 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2622 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2623 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2624 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2635 DtUg2(l,k,i-2)=0.0d0
2639 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2640 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2642 muder(k,i-2)=Ub2der(k,i-2)
2644 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2645 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2646 if (itype(i-1).le.ntyp) then
2647 iti1 = itortyp(itype(i-1))
2655 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2657 c write (iout,*) 'mu ',mu(:,i-2),i-2
2658 cd write (iout,*) 'mu1',mu1(:,i-2)
2659 cd write (iout,*) 'mu2',mu2(:,i-2)
2660 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2662 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2663 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2664 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2665 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2666 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2667 C Vectors and matrices dependent on a single virtual-bond dihedral.
2668 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2669 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2670 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2671 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2672 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2673 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2674 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2675 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2676 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2679 C Matrices dependent on two consecutive virtual-bond dihedrals.
2680 C The order of matrices is from left to right.
2681 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2683 c do i=max0(ivec_start,2),ivec_end
2685 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2686 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2687 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2688 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2689 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2690 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2691 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2692 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2695 #if defined(MPI) && defined(PARMAT)
2697 c if (fg_rank.eq.0) then
2698 write (iout,*) "Arrays UG and UGDER before GATHER"
2700 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2701 & ((ug(l,k,i),l=1,2),k=1,2),
2702 & ((ugder(l,k,i),l=1,2),k=1,2)
2704 write (iout,*) "Arrays UG2 and UG2DER"
2706 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2707 & ((ug2(l,k,i),l=1,2),k=1,2),
2708 & ((ug2der(l,k,i),l=1,2),k=1,2)
2710 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2712 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2713 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2714 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2716 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2718 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2719 & costab(i),sintab(i),costab2(i),sintab2(i)
2721 write (iout,*) "Array MUDER"
2723 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2727 if (nfgtasks.gt.1) then
2729 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2730 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2731 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2733 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2734 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2736 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2737 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2739 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2740 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2742 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2743 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2745 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2746 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2748 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2749 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2751 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2752 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2753 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2754 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2755 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2756 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2757 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2758 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2759 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2760 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2761 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2762 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2763 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2765 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2766 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2768 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2769 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2771 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2772 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2774 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2775 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2777 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2778 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2780 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2781 & ivec_count(fg_rank1),
2782 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2784 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2785 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2787 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2788 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2790 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2791 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2793 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2794 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2796 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2797 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2799 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2800 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2802 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2803 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2805 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2806 & ivec_count(fg_rank1),
2807 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2809 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2810 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2812 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2813 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2815 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2816 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2818 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2819 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2821 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2822 & ivec_count(fg_rank1),
2823 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2825 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2826 & ivec_count(fg_rank1),
2827 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2829 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2830 & ivec_count(fg_rank1),
2831 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2832 & MPI_MAT2,FG_COMM1,IERR)
2833 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2834 & ivec_count(fg_rank1),
2835 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2836 & MPI_MAT2,FG_COMM1,IERR)
2839 c Passes matrix info through the ring
2842 if (irecv.lt.0) irecv=nfgtasks1-1
2845 if (inext.ge.nfgtasks1) inext=0
2847 c write (iout,*) "isend",isend," irecv",irecv
2849 lensend=lentyp(isend)
2850 lenrecv=lentyp(irecv)
2851 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2852 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2853 c & MPI_ROTAT1(lensend),inext,2200+isend,
2854 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2855 c & iprev,2200+irecv,FG_COMM,status,IERR)
2856 c write (iout,*) "Gather ROTAT1"
2858 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2859 c & MPI_ROTAT2(lensend),inext,3300+isend,
2860 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2861 c & iprev,3300+irecv,FG_COMM,status,IERR)
2862 c write (iout,*) "Gather ROTAT2"
2864 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2865 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2866 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2867 & iprev,4400+irecv,FG_COMM,status,IERR)
2868 c write (iout,*) "Gather ROTAT_OLD"
2870 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2871 & MPI_PRECOMP11(lensend),inext,5500+isend,
2872 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2873 & iprev,5500+irecv,FG_COMM,status,IERR)
2874 c write (iout,*) "Gather PRECOMP11"
2876 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2877 & MPI_PRECOMP12(lensend),inext,6600+isend,
2878 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2879 & iprev,6600+irecv,FG_COMM,status,IERR)
2880 c write (iout,*) "Gather PRECOMP12"
2882 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2884 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2885 & MPI_ROTAT2(lensend),inext,7700+isend,
2886 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2887 & iprev,7700+irecv,FG_COMM,status,IERR)
2888 c write (iout,*) "Gather PRECOMP21"
2890 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2891 & MPI_PRECOMP22(lensend),inext,8800+isend,
2892 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2893 & iprev,8800+irecv,FG_COMM,status,IERR)
2894 c write (iout,*) "Gather PRECOMP22"
2896 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2897 & MPI_PRECOMP23(lensend),inext,9900+isend,
2898 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2899 & MPI_PRECOMP23(lenrecv),
2900 & iprev,9900+irecv,FG_COMM,status,IERR)
2901 c write (iout,*) "Gather PRECOMP23"
2906 if (irecv.lt.0) irecv=nfgtasks1-1
2909 time_gather=time_gather+MPI_Wtime()-time00
2912 c if (fg_rank.eq.0) then
2913 write (iout,*) "Arrays UG and UGDER"
2915 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2916 & ((ug(l,k,i),l=1,2),k=1,2),
2917 & ((ugder(l,k,i),l=1,2),k=1,2)
2919 write (iout,*) "Arrays UG2 and UG2DER"
2921 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2922 & ((ug2(l,k,i),l=1,2),k=1,2),
2923 & ((ug2der(l,k,i),l=1,2),k=1,2)
2925 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2927 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2928 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2929 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2931 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2933 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2934 & costab(i),sintab(i),costab2(i),sintab2(i)
2936 write (iout,*) "Array MUDER"
2938 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2944 cd iti = itortyp(itype(i))
2947 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2948 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2953 C--------------------------------------------------------------------------
2954 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2956 C This subroutine calculates the average interaction energy and its gradient
2957 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2958 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2959 C The potential depends both on the distance of peptide-group centers and on
2960 C the orientation of the CA-CA virtual bonds.
2962 implicit real*8 (a-h,o-z)
2966 include 'DIMENSIONS'
2967 include 'COMMON.CONTROL'
2968 include 'COMMON.SETUP'
2969 include 'COMMON.IOUNITS'
2970 include 'COMMON.GEO'
2971 include 'COMMON.VAR'
2972 include 'COMMON.LOCAL'
2973 include 'COMMON.CHAIN'
2974 include 'COMMON.DERIV'
2975 include 'COMMON.INTERACT'
2976 include 'COMMON.CONTACTS'
2977 include 'COMMON.TORSION'
2978 include 'COMMON.VECTORS'
2979 include 'COMMON.FFIELD'
2980 include 'COMMON.TIME1'
2981 include 'COMMON.SPLITELE'
2982 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2983 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2984 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2985 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2986 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2987 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2989 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2991 double precision scal_el /1.0d0/
2993 double precision scal_el /0.5d0/
2996 C 13-go grudnia roku pamietnego...
2997 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2998 & 0.0d0,1.0d0,0.0d0,
2999 & 0.0d0,0.0d0,1.0d0/
3000 cd write(iout,*) 'In EELEC'
3002 cd write(iout,*) 'Type',i
3003 cd write(iout,*) 'B1',B1(:,i)
3004 cd write(iout,*) 'B2',B2(:,i)
3005 cd write(iout,*) 'CC',CC(:,:,i)
3006 cd write(iout,*) 'DD',DD(:,:,i)
3007 cd write(iout,*) 'EE',EE(:,:,i)
3009 cd call check_vecgrad
3011 if (icheckgrad.eq.1) then
3013 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3015 dc_norm(k,i)=dc(k,i)*fac
3017 c write (iout,*) 'i',i,' fac',fac
3020 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3021 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3022 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3023 c call vec_and_deriv
3029 time_mat=time_mat+MPI_Wtime()-time01
3033 cd write (iout,*) 'i=',i
3035 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3038 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3039 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3052 cd print '(a)','Enter EELEC'
3053 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3055 gel_loc_loc(i)=0.0d0
3060 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3062 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3064 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3065 do i=iturn3_start,iturn3_end
3066 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3067 & .or. itype(i+2).eq.ntyp1
3068 & .or. itype(i+3).eq.ntyp1
3069 & .or. itype(i-1).eq.ntyp1
3070 & .or. itype(i+4).eq.ntyp1
3075 dx_normi=dc_norm(1,i)
3076 dy_normi=dc_norm(2,i)
3077 dz_normi=dc_norm(3,i)
3078 xmedi=c(1,i)+0.5d0*dxi
3079 ymedi=c(2,i)+0.5d0*dyi
3080 zmedi=c(3,i)+0.5d0*dzi
3081 xmedi=mod(xmedi,boxxsize)
3082 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3083 ymedi=mod(ymedi,boxysize)
3084 if (ymedi.lt.0) ymedi=ymedi+boxysize
3085 zmedi=mod(zmedi,boxzsize)
3086 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3088 call eelecij(i,i+2,ees,evdw1,eel_loc)
3089 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3090 num_cont_hb(i)=num_conti
3092 do i=iturn4_start,iturn4_end
3093 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3094 & .or. itype(i+3).eq.ntyp1
3095 & .or. itype(i+4).eq.ntyp1
3096 & .or. itype(i+5).eq.ntyp1
3097 & .or. itype(i).eq.ntyp1
3098 & .or. itype(i-1).eq.ntyp1
3103 dx_normi=dc_norm(1,i)
3104 dy_normi=dc_norm(2,i)
3105 dz_normi=dc_norm(3,i)
3106 xmedi=c(1,i)+0.5d0*dxi
3107 ymedi=c(2,i)+0.5d0*dyi
3108 zmedi=c(3,i)+0.5d0*dzi
3109 C Return atom into box, boxxsize is size of box in x dimension
3111 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3112 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3113 C Condition for being inside the proper box
3114 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3115 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3119 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3120 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3121 C Condition for being inside the proper box
3122 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3123 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3127 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3128 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3129 C Condition for being inside the proper box
3130 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3131 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3134 xmedi=mod(xmedi,boxxsize)
3135 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3136 ymedi=mod(ymedi,boxysize)
3137 if (ymedi.lt.0) ymedi=ymedi+boxysize
3138 zmedi=mod(zmedi,boxzsize)
3139 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3141 num_conti=num_cont_hb(i)
3142 c write(iout,*) "JESTEM W PETLI"
3143 call eelecij(i,i+3,ees,evdw1,eel_loc)
3144 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3145 & call eturn4(i,eello_turn4)
3146 num_cont_hb(i)=num_conti
3148 C Loop over all neighbouring boxes
3153 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3155 do i=iatel_s,iatel_e
3156 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3157 & .or. itype(i+2).eq.ntyp1
3158 & .or. itype(i-1).eq.ntyp1
3163 dx_normi=dc_norm(1,i)
3164 dy_normi=dc_norm(2,i)
3165 dz_normi=dc_norm(3,i)
3166 xmedi=c(1,i)+0.5d0*dxi
3167 ymedi=c(2,i)+0.5d0*dyi
3168 zmedi=c(3,i)+0.5d0*dzi
3169 xmedi=mod(xmedi,boxxsize)
3170 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3171 ymedi=mod(ymedi,boxysize)
3172 if (ymedi.lt.0) ymedi=ymedi+boxysize
3173 zmedi=mod(zmedi,boxzsize)
3174 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3175 C xmedi=xmedi+xshift*boxxsize
3176 C ymedi=ymedi+yshift*boxysize
3177 C zmedi=zmedi+zshift*boxzsize
3179 C Return tom into box, boxxsize is size of box in x dimension
3181 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3182 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3183 C Condition for being inside the proper box
3184 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3185 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3189 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3190 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3191 C Condition for being inside the proper box
3192 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3193 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3197 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3198 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3199 cC Condition for being inside the proper box
3200 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3201 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3205 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3206 num_conti=num_cont_hb(i)
3207 do j=ielstart(i),ielend(i)
3208 c write (iout,*) i,j,itype(i),itype(j)
3209 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3210 & .or.itype(j+2).eq.ntyp1
3211 & .or.itype(j-1).eq.ntyp1
3213 call eelecij(i,j,ees,evdw1,eel_loc)
3215 num_cont_hb(i)=num_conti
3221 c write (iout,*) "Number of loop steps in EELEC:",ind
3223 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3224 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3226 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3227 ccc eel_loc=eel_loc+eello_turn3
3228 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3231 C-------------------------------------------------------------------------------
3232 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3233 implicit real*8 (a-h,o-z)
3234 include 'DIMENSIONS'
3238 include 'COMMON.CONTROL'
3239 include 'COMMON.IOUNITS'
3240 include 'COMMON.GEO'
3241 include 'COMMON.VAR'
3242 include 'COMMON.LOCAL'
3243 include 'COMMON.CHAIN'
3244 include 'COMMON.DERIV'
3245 include 'COMMON.INTERACT'
3246 include 'COMMON.CONTACTS'
3247 include 'COMMON.TORSION'
3248 include 'COMMON.VECTORS'
3249 include 'COMMON.FFIELD'
3250 include 'COMMON.TIME1'
3251 include 'COMMON.SPLITELE'
3252 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3253 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3254 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3255 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3256 & gmuij2(4),gmuji2(4)
3257 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3258 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3260 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3262 double precision scal_el /1.0d0/
3264 double precision scal_el /0.5d0/
3267 C 13-go grudnia roku pamietnego...
3268 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3269 & 0.0d0,1.0d0,0.0d0,
3270 & 0.0d0,0.0d0,1.0d0/
3271 c time00=MPI_Wtime()
3272 cd write (iout,*) "eelecij",i,j
3276 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3277 aaa=app(iteli,itelj)
3278 bbb=bpp(iteli,itelj)
3279 ael6i=ael6(iteli,itelj)
3280 ael3i=ael3(iteli,itelj)
3284 dx_normj=dc_norm(1,j)
3285 dy_normj=dc_norm(2,j)
3286 dz_normj=dc_norm(3,j)
3287 C xj=c(1,j)+0.5D0*dxj-xmedi
3288 C yj=c(2,j)+0.5D0*dyj-ymedi
3289 C zj=c(3,j)+0.5D0*dzj-zmedi
3294 if (xj.lt.0) xj=xj+boxxsize
3296 if (yj.lt.0) yj=yj+boxysize
3298 if (zj.lt.0) zj=zj+boxzsize
3299 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3300 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3308 xj=xj_safe+xshift*boxxsize
3309 yj=yj_safe+yshift*boxysize
3310 zj=zj_safe+zshift*boxzsize
3311 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3312 if(dist_temp.lt.dist_init) then
3322 if (isubchap.eq.1) then
3331 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3333 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3334 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3335 C Condition for being inside the proper box
3336 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3337 c & (xj.lt.((-0.5d0)*boxxsize))) then
3341 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3342 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3343 C Condition for being inside the proper box
3344 c if ((yj.gt.((0.5d0)*boxysize)).or.
3345 c & (yj.lt.((-0.5d0)*boxysize))) then
3349 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3350 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3351 C Condition for being inside the proper box
3352 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3353 c & (zj.lt.((-0.5d0)*boxzsize))) then
3356 C endif !endPBC condintion
3360 rij=xj*xj+yj*yj+zj*zj
3362 sss=sscale(sqrt(rij))
3363 sssgrad=sscagrad(sqrt(rij))
3364 c if (sss.gt.0.0d0) then
3370 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3371 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3372 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3373 fac=cosa-3.0D0*cosb*cosg
3375 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3376 if (j.eq.i+2) ev1=scal_el*ev1
3381 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3385 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3386 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3388 evdw1=evdw1+evdwij*sss
3389 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3390 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3391 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3392 cd & xmedi,ymedi,zmedi,xj,yj,zj
3394 if (energy_dec) then
3395 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3397 &,iteli,itelj,aaa,evdw1
3398 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3402 C Calculate contributions to the Cartesian gradient.
3405 facvdw=-6*rrmij*(ev1+evdwij)*sss
3406 facel=-3*rrmij*(el1+eesij)
3412 * Radial derivatives. First process both termini of the fragment (i,j)
3418 c ghalf=0.5D0*ggg(k)
3419 c gelc(k,i)=gelc(k,i)+ghalf
3420 c gelc(k,j)=gelc(k,j)+ghalf
3422 c 9/28/08 AL Gradient compotents will be summed only at the end
3424 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3425 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3428 * Loop over residues i+1 thru j-1.
3432 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3435 if (sss.gt.0.0) then
3436 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3437 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3438 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3445 c ghalf=0.5D0*ggg(k)
3446 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3447 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3449 c 9/28/08 AL Gradient compotents will be summed only at the end
3451 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3452 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3455 * Loop over residues i+1 thru j-1.
3459 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3464 facvdw=(ev1+evdwij)*sss
3467 fac=-3*rrmij*(facvdw+facvdw+facel)
3472 * Radial derivatives. First process both termini of the fragment (i,j)
3478 c ghalf=0.5D0*ggg(k)
3479 c gelc(k,i)=gelc(k,i)+ghalf
3480 c gelc(k,j)=gelc(k,j)+ghalf
3482 c 9/28/08 AL Gradient compotents will be summed only at the end
3484 gelc_long(k,j)=gelc(k,j)+ggg(k)
3485 gelc_long(k,i)=gelc(k,i)-ggg(k)
3488 * Loop over residues i+1 thru j-1.
3492 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3495 c 9/28/08 AL Gradient compotents will be summed only at the end
3496 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3497 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3498 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3500 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3501 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3507 ecosa=2.0D0*fac3*fac1+fac4
3510 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3511 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3513 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3514 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3516 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3517 cd & (dcosg(k),k=1,3)
3519 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3522 c ghalf=0.5D0*ggg(k)
3523 c gelc(k,i)=gelc(k,i)+ghalf
3524 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3525 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3526 c gelc(k,j)=gelc(k,j)+ghalf
3527 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3528 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3532 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3537 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3538 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3540 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3541 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3542 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3543 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3547 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3548 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3549 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3551 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3552 C energy of a peptide unit is assumed in the form of a second-order
3553 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3554 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3555 C are computed for EVERY pair of non-contiguous peptide groups.
3558 if (j.lt.nres-1) then
3570 muij(kkk)=mu(k,i)*mu(l,j)
3571 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3573 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3574 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3575 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3576 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3577 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3578 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3582 cd write (iout,*) 'EELEC: i',i,' j',j
3583 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3584 cd write(iout,*) 'muij',muij
3585 ury=scalar(uy(1,i),erij)
3586 urz=scalar(uz(1,i),erij)
3587 vry=scalar(uy(1,j),erij)
3588 vrz=scalar(uz(1,j),erij)
3589 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3590 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3591 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3592 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3593 fac=dsqrt(-ael6i)*r3ij
3598 cd write (iout,'(4i5,4f10.5)')
3599 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3600 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3601 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3602 cd & uy(:,j),uz(:,j)
3603 cd write (iout,'(4f10.5)')
3604 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3605 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3606 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3607 cd write (iout,'(9f10.5/)')
3608 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3609 C Derivatives of the elements of A in virtual-bond vectors
3610 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3612 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3613 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3614 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3615 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3616 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3617 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3618 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3619 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3620 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3621 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3622 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3623 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3625 C Compute radial contributions to the gradient
3643 C Add the contributions coming from er
3646 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3647 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3648 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3649 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3652 C Derivatives in DC(i)
3653 cgrad ghalf1=0.5d0*agg(k,1)
3654 cgrad ghalf2=0.5d0*agg(k,2)
3655 cgrad ghalf3=0.5d0*agg(k,3)
3656 cgrad ghalf4=0.5d0*agg(k,4)
3657 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3658 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3659 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3660 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3661 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3662 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3663 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3664 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3665 C Derivatives in DC(i+1)
3666 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3667 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3668 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3669 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3670 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3671 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3672 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3673 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3674 C Derivatives in DC(j)
3675 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3676 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3677 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3678 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3679 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3680 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3681 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3682 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3683 C Derivatives in DC(j+1) or DC(nres-1)
3684 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3685 & -3.0d0*vryg(k,3)*ury)
3686 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3687 & -3.0d0*vrzg(k,3)*ury)
3688 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3689 & -3.0d0*vryg(k,3)*urz)
3690 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3691 & -3.0d0*vrzg(k,3)*urz)
3692 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3694 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3707 aggi(k,l)=-aggi(k,l)
3708 aggi1(k,l)=-aggi1(k,l)
3709 aggj(k,l)=-aggj(k,l)
3710 aggj1(k,l)=-aggj1(k,l)
3713 if (j.lt.nres-1) then
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)
3733 aggi(k,l)=-aggi(k,l)
3734 aggi1(k,l)=-aggi1(k,l)
3735 aggj(k,l)=-aggj(k,l)
3736 aggj1(k,l)=-aggj1(k,l)
3741 IF (wel_loc.gt.0.0d0) THEN
3742 C Contribution to the local-electrostatic energy coming from the i-j pair
3743 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3745 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3746 c & ' eel_loc_ij',eel_loc_ij
3747 c write(iout,*) 'muije=',muij(1),muij(2),muij(3),muij(4)
3748 C Calculate patrial derivative for theta angle
3750 geel_loc_ij=a22*gmuij1(1)
3754 c write(iout,*) "derivative over thatai"
3755 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3757 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3758 & geel_loc_ij*wel_loc
3759 c write(iout,*) "derivative over thatai-1"
3760 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3767 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3768 & geel_loc_ij*wel_loc
3769 c Derivative over j residue
3770 geel_loc_ji=a22*gmuji1(1)
3774 c write(iout,*) "derivative over thataj"
3775 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3778 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3779 & geel_loc_ji*wel_loc
3785 c write(iout,*) "derivative over thataj-1"
3786 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3788 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3789 & geel_loc_ji*wel_loc
3791 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3793 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3794 & 'eelloc',i,j,eel_loc_ij
3795 c if (eel_loc_ij.ne.0)
3796 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3797 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3799 eel_loc=eel_loc+eel_loc_ij
3800 C Partial derivatives in virtual-bond dihedral angles gamma
3802 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3803 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3804 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3805 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3806 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3807 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3808 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3810 ggg(l)=agg(l,1)*muij(1)+
3811 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3812 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3813 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3814 cgrad ghalf=0.5d0*ggg(l)
3815 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3816 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3820 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3823 C Remaining derivatives of eello
3825 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3826 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3827 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3828 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3829 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3830 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3831 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3832 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3835 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3836 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3837 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3838 & .and. num_conti.le.maxconts) then
3839 c write (iout,*) i,j," entered corr"
3841 C Calculate the contact function. The ith column of the array JCONT will
3842 C contain the numbers of atoms that make contacts with the atom I (of numbers
3843 C greater than I). The arrays FACONT and GACONT will contain the values of
3844 C the contact function and its derivative.
3845 c r0ij=1.02D0*rpp(iteli,itelj)
3846 c r0ij=1.11D0*rpp(iteli,itelj)
3847 r0ij=2.20D0*rpp(iteli,itelj)
3848 c r0ij=1.55D0*rpp(iteli,itelj)
3849 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3850 if (fcont.gt.0.0D0) then
3851 num_conti=num_conti+1
3852 if (num_conti.gt.maxconts) then
3853 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3854 & ' will skip next contacts for this conf.'
3856 jcont_hb(num_conti,i)=j
3857 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3858 cd & " jcont_hb",jcont_hb(num_conti,i)
3859 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3860 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3861 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3863 d_cont(num_conti,i)=rij
3864 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3865 C --- Electrostatic-interaction matrix ---
3866 a_chuj(1,1,num_conti,i)=a22
3867 a_chuj(1,2,num_conti,i)=a23
3868 a_chuj(2,1,num_conti,i)=a32
3869 a_chuj(2,2,num_conti,i)=a33
3870 C --- Gradient of rij
3872 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3879 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3880 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3881 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3882 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3883 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3888 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3889 C Calculate contact energies
3891 wij=cosa-3.0D0*cosb*cosg
3894 c fac3=dsqrt(-ael6i)/r0ij**3
3895 fac3=dsqrt(-ael6i)*r3ij
3896 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3897 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3898 if (ees0tmp.gt.0) then
3899 ees0pij=dsqrt(ees0tmp)
3903 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3904 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3905 if (ees0tmp.gt.0) then
3906 ees0mij=dsqrt(ees0tmp)
3911 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3912 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3913 C Diagnostics. Comment out or remove after debugging!
3914 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3915 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3916 c ees0m(num_conti,i)=0.0D0
3918 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3919 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3920 C Angular derivatives of the contact function
3921 ees0pij1=fac3/ees0pij
3922 ees0mij1=fac3/ees0mij
3923 fac3p=-3.0D0*fac3*rrmij
3924 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3925 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3927 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3928 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3929 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3930 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3931 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3932 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3933 ecosap=ecosa1+ecosa2
3934 ecosbp=ecosb1+ecosb2
3935 ecosgp=ecosg1+ecosg2
3936 ecosam=ecosa1-ecosa2
3937 ecosbm=ecosb1-ecosb2
3938 ecosgm=ecosg1-ecosg2
3947 facont_hb(num_conti,i)=fcont
3948 fprimcont=fprimcont/rij
3949 cd facont_hb(num_conti,i)=1.0D0
3950 C Following line is for diagnostics.
3953 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3954 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3957 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3958 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3960 gggp(1)=gggp(1)+ees0pijp*xj
3961 gggp(2)=gggp(2)+ees0pijp*yj
3962 gggp(3)=gggp(3)+ees0pijp*zj
3963 gggm(1)=gggm(1)+ees0mijp*xj
3964 gggm(2)=gggm(2)+ees0mijp*yj
3965 gggm(3)=gggm(3)+ees0mijp*zj
3966 C Derivatives due to the contact function
3967 gacont_hbr(1,num_conti,i)=fprimcont*xj
3968 gacont_hbr(2,num_conti,i)=fprimcont*yj
3969 gacont_hbr(3,num_conti,i)=fprimcont*zj
3972 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3973 c following the change of gradient-summation algorithm.
3975 cgrad ghalfp=0.5D0*gggp(k)
3976 cgrad ghalfm=0.5D0*gggm(k)
3977 gacontp_hb1(k,num_conti,i)=!ghalfp
3978 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3979 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3980 gacontp_hb2(k,num_conti,i)=!ghalfp
3981 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3982 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3983 gacontp_hb3(k,num_conti,i)=gggp(k)
3984 gacontm_hb1(k,num_conti,i)=!ghalfm
3985 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3986 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3987 gacontm_hb2(k,num_conti,i)=!ghalfm
3988 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3989 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3990 gacontm_hb3(k,num_conti,i)=gggm(k)
3992 C Diagnostics. Comment out or remove after debugging!
3994 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3995 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3996 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3997 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3998 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3999 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4002 endif ! num_conti.le.maxconts
4005 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4008 ghalf=0.5d0*agg(l,k)
4009 aggi(l,k)=aggi(l,k)+ghalf
4010 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4011 aggj(l,k)=aggj(l,k)+ghalf
4014 if (j.eq.nres-1 .and. i.lt.j-2) then
4017 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4022 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4025 C-----------------------------------------------------------------------------
4026 subroutine eturn3(i,eello_turn3)
4027 C Third- and fourth-order contributions from turns
4028 implicit real*8 (a-h,o-z)
4029 include 'DIMENSIONS'
4030 include 'COMMON.IOUNITS'
4031 include 'COMMON.GEO'
4032 include 'COMMON.VAR'
4033 include 'COMMON.LOCAL'
4034 include 'COMMON.CHAIN'
4035 include 'COMMON.DERIV'
4036 include 'COMMON.INTERACT'
4037 include 'COMMON.CONTACTS'
4038 include 'COMMON.TORSION'
4039 include 'COMMON.VECTORS'
4040 include 'COMMON.FFIELD'
4041 include 'COMMON.CONTROL'
4043 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4044 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4045 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4046 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4047 & auxgmat2(2,2),auxgmatt2(2,2)
4048 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4049 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4050 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4051 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4054 c write (iout,*) "eturn3",i,j,j1,j2
4059 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4061 C Third-order contributions
4068 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4069 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4070 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4071 c auxalary matices for theta gradient
4072 c auxalary matrix for i+1 and constant i+2
4073 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4074 c auxalary matrix for i+2 and constant i+1
4075 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4076 call transpose2(auxmat(1,1),auxmat1(1,1))
4077 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4078 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4079 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4080 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4081 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4082 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4083 C Derivatives in theta
4084 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4085 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4086 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4087 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4089 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4090 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4091 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4092 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4093 cd & ' eello_turn3_num',4*eello_turn3_num
4094 C Derivatives in gamma(i)
4095 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4096 call transpose2(auxmat2(1,1),auxmat3(1,1))
4097 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4098 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4099 C Derivatives in gamma(i+1)
4100 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4101 call transpose2(auxmat2(1,1),auxmat3(1,1))
4102 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4103 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4104 & +0.5d0*(pizda(1,1)+pizda(2,2))
4105 C Cartesian derivatives
4107 c ghalf1=0.5d0*agg(l,1)
4108 c ghalf2=0.5d0*agg(l,2)
4109 c ghalf3=0.5d0*agg(l,3)
4110 c ghalf4=0.5d0*agg(l,4)
4111 a_temp(1,1)=aggi(l,1)!+ghalf1
4112 a_temp(1,2)=aggi(l,2)!+ghalf2
4113 a_temp(2,1)=aggi(l,3)!+ghalf3
4114 a_temp(2,2)=aggi(l,4)!+ghalf4
4115 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4116 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4117 & +0.5d0*(pizda(1,1)+pizda(2,2))
4118 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4119 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4120 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4121 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4122 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4123 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4124 & +0.5d0*(pizda(1,1)+pizda(2,2))
4125 a_temp(1,1)=aggj(l,1)!+ghalf1
4126 a_temp(1,2)=aggj(l,2)!+ghalf2
4127 a_temp(2,1)=aggj(l,3)!+ghalf3
4128 a_temp(2,2)=aggj(l,4)!+ghalf4
4129 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4130 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4131 & +0.5d0*(pizda(1,1)+pizda(2,2))
4132 a_temp(1,1)=aggj1(l,1)
4133 a_temp(1,2)=aggj1(l,2)
4134 a_temp(2,1)=aggj1(l,3)
4135 a_temp(2,2)=aggj1(l,4)
4136 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4137 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4138 & +0.5d0*(pizda(1,1)+pizda(2,2))
4142 C-------------------------------------------------------------------------------
4143 subroutine eturn4(i,eello_turn4)
4144 C Third- and fourth-order contributions from turns
4145 implicit real*8 (a-h,o-z)
4146 include 'DIMENSIONS'
4147 include 'COMMON.IOUNITS'
4148 include 'COMMON.GEO'
4149 include 'COMMON.VAR'
4150 include 'COMMON.LOCAL'
4151 include 'COMMON.CHAIN'
4152 include 'COMMON.DERIV'
4153 include 'COMMON.INTERACT'
4154 include 'COMMON.CONTACTS'
4155 include 'COMMON.TORSION'
4156 include 'COMMON.VECTORS'
4157 include 'COMMON.FFIELD'
4158 include 'COMMON.CONTROL'
4160 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4161 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4162 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4163 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4164 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4165 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4166 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4167 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4168 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4169 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4170 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4173 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4175 C Fourth-order contributions
4183 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4184 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4185 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4186 c write(iout,*)"WCHODZE W PROGRAM"
4191 iti1=itortyp(itype(i+1))
4192 iti2=itortyp(itype(i+2))
4193 iti3=itortyp(itype(i+3))
4194 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4195 call transpose2(EUg(1,1,i+1),e1t(1,1))
4196 call transpose2(Eug(1,1,i+2),e2t(1,1))
4197 call transpose2(Eug(1,1,i+3),e3t(1,1))
4198 C Ematrix derivative in theta
4199 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4200 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4201 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4202 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4203 c eta1 in derivative theta
4204 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4205 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4206 c auxgvec is derivative of Ub2 so i+3 theta
4207 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4208 c auxalary matrix of E i+1
4209 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4212 s1=scalar2(b1(1,i+2),auxvec(1))
4213 c derivative of theta i+2 with constant i+3
4214 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4215 c derivative of theta i+2 with constant i+2
4216 gs32=scalar2(b1(1,i+2),auxgvec(1))
4217 c derivative of E matix in theta of i+1
4218 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4220 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4221 c ea31 in derivative theta
4222 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4223 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4224 c auxilary matrix auxgvec of Ub2 with constant E matirx
4225 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4226 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4227 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4231 s2=scalar2(b1(1,i+1),auxvec(1))
4232 c derivative of theta i+1 with constant i+3
4233 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4234 c derivative of theta i+2 with constant i+1
4235 gs21=scalar2(b1(1,i+1),auxgvec(1))
4236 c derivative of theta i+3 with constant i+1
4237 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4238 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4240 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4241 c two derivatives over diffetent matrices
4242 c gtae3e2 is derivative over i+3
4243 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4244 c ae3gte2 is derivative over i+2
4245 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4246 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4247 c three possible derivative over theta E matices
4249 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4251 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4253 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4254 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4256 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4257 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4258 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4260 eello_turn4=eello_turn4-(s1+s2+s3)
4261 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4262 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4263 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4264 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4265 cd & ' eello_turn4_num',8*eello_turn4_num
4267 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4268 & -(gs13+gsE13+gsEE1)*wturn4
4269 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4270 & -(gs23+gs21+gsEE2)*wturn4
4271 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4272 & -(gs32+gsE31+gsEE3)*wturn4
4273 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4276 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4277 & 'eturn4',i,j,-(s1+s2+s3)
4278 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4279 c & ' eello_turn4_num',8*eello_turn4_num
4280 C Derivatives in gamma(i)
4281 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4282 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4283 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4284 s1=scalar2(b1(1,i+2),auxvec(1))
4285 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4286 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4287 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4288 C Derivatives in gamma(i+1)
4289 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4290 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4291 s2=scalar2(b1(1,i+1),auxvec(1))
4292 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4293 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4294 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4295 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4296 C Derivatives in gamma(i+2)
4297 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4298 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4299 s1=scalar2(b1(1,i+2),auxvec(1))
4300 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4301 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4302 s2=scalar2(b1(1,i+1),auxvec(1))
4303 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4304 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4305 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4306 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4307 C Cartesian derivatives
4308 C Derivatives of this turn contributions in DC(i+2)
4309 if (j.lt.nres-1) then
4311 a_temp(1,1)=agg(l,1)
4312 a_temp(1,2)=agg(l,2)
4313 a_temp(2,1)=agg(l,3)
4314 a_temp(2,2)=agg(l,4)
4315 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4316 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4317 s1=scalar2(b1(1,i+2),auxvec(1))
4318 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4319 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4320 s2=scalar2(b1(1,i+1),auxvec(1))
4321 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4322 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4323 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4325 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4328 C Remaining derivatives of this turn contribution
4330 a_temp(1,1)=aggi(l,1)
4331 a_temp(1,2)=aggi(l,2)
4332 a_temp(2,1)=aggi(l,3)
4333 a_temp(2,2)=aggi(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)=gcorr4_turn(l,i)-(s1+s2+s3)
4344 a_temp(1,1)=aggi1(l,1)
4345 a_temp(1,2)=aggi1(l,2)
4346 a_temp(2,1)=aggi1(l,3)
4347 a_temp(2,2)=aggi1(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,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4358 a_temp(1,1)=aggj(l,1)
4359 a_temp(1,2)=aggj(l,2)
4360 a_temp(2,1)=aggj(l,3)
4361 a_temp(2,2)=aggj(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 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4372 a_temp(1,1)=aggj1(l,1)
4373 a_temp(1,2)=aggj1(l,2)
4374 a_temp(2,1)=aggj1(l,3)
4375 a_temp(2,2)=aggj1(l,4)
4376 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4377 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4378 s1=scalar2(b1(1,i+2),auxvec(1))
4379 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4380 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4381 s2=scalar2(b1(1,i+1),auxvec(1))
4382 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4383 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4384 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4385 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4386 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4390 C-----------------------------------------------------------------------------
4391 subroutine vecpr(u,v,w)
4392 implicit real*8(a-h,o-z)
4393 dimension u(3),v(3),w(3)
4394 w(1)=u(2)*v(3)-u(3)*v(2)
4395 w(2)=-u(1)*v(3)+u(3)*v(1)
4396 w(3)=u(1)*v(2)-u(2)*v(1)
4399 C-----------------------------------------------------------------------------
4400 subroutine unormderiv(u,ugrad,unorm,ungrad)
4401 C This subroutine computes the derivatives of a normalized vector u, given
4402 C the derivatives computed without normalization conditions, ugrad. Returns
4405 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4406 double precision vec(3)
4407 double precision scalar
4409 c write (2,*) 'ugrad',ugrad
4412 vec(i)=scalar(ugrad(1,i),u(1))
4414 c write (2,*) 'vec',vec
4417 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4420 c write (2,*) 'ungrad',ungrad
4423 C-----------------------------------------------------------------------------
4424 subroutine escp_soft_sphere(evdw2,evdw2_14)
4426 C This subroutine calculates the excluded-volume interaction energy between
4427 C peptide-group centers and side chains and its gradient in virtual-bond and
4428 C side-chain vectors.
4430 implicit real*8 (a-h,o-z)
4431 include 'DIMENSIONS'
4432 include 'COMMON.GEO'
4433 include 'COMMON.VAR'
4434 include 'COMMON.LOCAL'
4435 include 'COMMON.CHAIN'
4436 include 'COMMON.DERIV'
4437 include 'COMMON.INTERACT'
4438 include 'COMMON.FFIELD'
4439 include 'COMMON.IOUNITS'
4440 include 'COMMON.CONTROL'
4445 cd print '(a)','Enter ESCP'
4446 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4450 do i=iatscp_s,iatscp_e
4451 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4453 xi=0.5D0*(c(1,i)+c(1,i+1))
4454 yi=0.5D0*(c(2,i)+c(2,i+1))
4455 zi=0.5D0*(c(3,i)+c(3,i+1))
4456 C Return atom into box, boxxsize is size of box in x dimension
4458 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4459 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4460 C Condition for being inside the proper box
4461 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4462 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4466 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4467 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4468 C Condition for being inside the proper box
4469 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4470 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4474 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4475 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4476 cC Condition for being inside the proper box
4477 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4478 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4482 if (xi.lt.0) xi=xi+boxxsize
4484 if (yi.lt.0) yi=yi+boxysize
4486 if (zi.lt.0) zi=zi+boxzsize
4487 C xi=xi+xshift*boxxsize
4488 C yi=yi+yshift*boxysize
4489 C zi=zi+zshift*boxzsize
4490 do iint=1,nscp_gr(i)
4492 do j=iscpstart(i,iint),iscpend(i,iint)
4493 if (itype(j).eq.ntyp1) cycle
4494 itypj=iabs(itype(j))
4495 C Uncomment following three lines for SC-p interactions
4499 C Uncomment following three lines for Ca-p interactions
4504 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4505 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4506 C Condition for being inside the proper box
4507 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4508 c & (xj.lt.((-0.5d0)*boxxsize))) then
4512 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4513 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4514 cC Condition for being inside the proper box
4515 c if ((yj.gt.((0.5d0)*boxysize)).or.
4516 c & (yj.lt.((-0.5d0)*boxysize))) then
4520 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4521 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4522 C Condition for being inside the proper box
4523 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4524 c & (zj.lt.((-0.5d0)*boxzsize))) then
4527 if (xj.lt.0) xj=xj+boxxsize
4529 if (yj.lt.0) yj=yj+boxysize
4531 if (zj.lt.0) zj=zj+boxzsize
4532 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4540 xj=xj_safe+xshift*boxxsize
4541 yj=yj_safe+yshift*boxysize
4542 zj=zj_safe+zshift*boxzsize
4543 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4544 if(dist_temp.lt.dist_init) then
4554 if (subchap.eq.1) then
4567 rij=xj*xj+yj*yj+zj*zj
4571 if (rij.lt.r0ijsq) then
4572 evdwij=0.25d0*(rij-r0ijsq)**2
4580 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4585 cgrad if (j.lt.i) then
4586 cd write (iout,*) 'j<i'
4587 C Uncomment following three lines for SC-p interactions
4589 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4592 cd write (iout,*) 'j>i'
4594 cgrad ggg(k)=-ggg(k)
4595 C Uncomment following line for SC-p interactions
4596 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4600 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4602 cgrad kstart=min0(i+1,j)
4603 cgrad kend=max0(i-1,j-1)
4604 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4605 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4606 cgrad do k=kstart,kend
4608 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4612 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4613 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4624 C-----------------------------------------------------------------------------
4625 subroutine escp(evdw2,evdw2_14)
4627 C This subroutine calculates the excluded-volume interaction energy between
4628 C peptide-group centers and side chains and its gradient in virtual-bond and
4629 C side-chain vectors.
4631 implicit real*8 (a-h,o-z)
4632 include 'DIMENSIONS'
4633 include 'COMMON.GEO'
4634 include 'COMMON.VAR'
4635 include 'COMMON.LOCAL'
4636 include 'COMMON.CHAIN'
4637 include 'COMMON.DERIV'
4638 include 'COMMON.INTERACT'
4639 include 'COMMON.FFIELD'
4640 include 'COMMON.IOUNITS'
4641 include 'COMMON.CONTROL'
4642 include 'COMMON.SPLITELE'
4646 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4647 cd print '(a)','Enter ESCP'
4648 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4652 do i=iatscp_s,iatscp_e
4653 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4655 xi=0.5D0*(c(1,i)+c(1,i+1))
4656 yi=0.5D0*(c(2,i)+c(2,i+1))
4657 zi=0.5D0*(c(3,i)+c(3,i+1))
4659 if (xi.lt.0) xi=xi+boxxsize
4661 if (yi.lt.0) yi=yi+boxysize
4663 if (zi.lt.0) zi=zi+boxzsize
4664 c xi=xi+xshift*boxxsize
4665 c yi=yi+yshift*boxysize
4666 c zi=zi+zshift*boxzsize
4667 c print *,xi,yi,zi,'polozenie i'
4668 C Return atom into box, boxxsize is size of box in x dimension
4670 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4671 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4672 C Condition for being inside the proper box
4673 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4674 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4678 c print *,xi,boxxsize,"pierwszy"
4680 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4681 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4682 C Condition for being inside the proper box
4683 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4684 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4688 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4689 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4690 C Condition for being inside the proper box
4691 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4692 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4695 do iint=1,nscp_gr(i)
4697 do j=iscpstart(i,iint),iscpend(i,iint)
4698 itypj=iabs(itype(j))
4699 if (itypj.eq.ntyp1) cycle
4700 C Uncomment following three lines for SC-p interactions
4704 C Uncomment following three lines for Ca-p interactions
4709 if (xj.lt.0) xj=xj+boxxsize
4711 if (yj.lt.0) yj=yj+boxysize
4713 if (zj.lt.0) zj=zj+boxzsize
4715 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4716 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4717 C Condition for being inside the proper box
4718 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4719 c & (xj.lt.((-0.5d0)*boxxsize))) then
4723 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4724 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4725 cC Condition for being inside the proper box
4726 c if ((yj.gt.((0.5d0)*boxysize)).or.
4727 c & (yj.lt.((-0.5d0)*boxysize))) then
4731 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4732 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4733 C Condition for being inside the proper box
4734 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4735 c & (zj.lt.((-0.5d0)*boxzsize))) then
4738 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
4739 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4747 xj=xj_safe+xshift*boxxsize
4748 yj=yj_safe+yshift*boxysize
4749 zj=zj_safe+zshift*boxzsize
4750 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4751 if(dist_temp.lt.dist_init) then
4761 if (subchap.eq.1) then
4770 c print *,xj,yj,zj,'polozenie j'
4771 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4773 sss=sscale(1.0d0/(dsqrt(rrij)))
4774 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
4775 c if (sss.eq.0) print *,'czasem jest OK'
4776 if (sss.le.0.0d0) cycle
4777 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4779 e1=fac*fac*aad(itypj,iteli)
4780 e2=fac*bad(itypj,iteli)
4781 if (iabs(j-i) .le. 2) then
4784 evdw2_14=evdw2_14+(e1+e2)*sss
4787 evdw2=evdw2+evdwij*sss
4788 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4789 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4792 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4794 fac=-(evdwij+e1)*rrij*sss
4795 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4799 cgrad if (j.lt.i) then
4800 cd write (iout,*) 'j<i'
4801 C Uncomment following three lines for SC-p interactions
4803 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4806 cd write (iout,*) 'j>i'
4808 cgrad ggg(k)=-ggg(k)
4809 C Uncomment following line for SC-p interactions
4810 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4811 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4815 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4817 cgrad kstart=min0(i+1,j)
4818 cgrad kend=max0(i-1,j-1)
4819 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4820 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4821 cgrad do k=kstart,kend
4823 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4827 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4828 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4830 c endif !endif for sscale cutoff
4840 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4841 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4842 gradx_scp(j,i)=expon*gradx_scp(j,i)
4845 C******************************************************************************
4849 C To save time the factor EXPON has been extracted from ALL components
4850 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4853 C******************************************************************************
4856 C--------------------------------------------------------------------------
4857 subroutine edis(ehpb)
4859 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4861 implicit real*8 (a-h,o-z)
4862 include 'DIMENSIONS'
4863 include 'COMMON.SBRIDGE'
4864 include 'COMMON.CHAIN'
4865 include 'COMMON.DERIV'
4866 include 'COMMON.VAR'
4867 include 'COMMON.INTERACT'
4868 include 'COMMON.IOUNITS'
4871 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4872 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4873 if (link_end.eq.0) return
4874 do i=link_start,link_end
4875 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4876 C CA-CA distance used in regularization of structure.
4879 C iii and jjj point to the residues for which the distance is assigned.
4880 if (ii.gt.nres) then
4887 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4888 c & dhpb(i),dhpb1(i),forcon(i)
4889 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4890 C distance and angle dependent SS bond potential.
4891 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4892 & iabs(itype(jjj)).eq.1) then
4893 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4894 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4895 if (.not.dyn_ss .and. i.le.nss) then
4896 C 15/02/13 CC dynamic SSbond - additional check
4898 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4899 call ssbond_ene(iii,jjj,eij)
4902 cd write (iout,*) "eij",eij
4904 C Calculate the distance between the two points and its difference from the
4908 C Get the force constant corresponding to this distance.
4910 C Calculate the contribution to energy.
4911 ehpb=ehpb+waga*rdis*rdis
4913 C Evaluate gradient.
4916 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4917 cd & ' waga=',waga,' fac=',fac
4919 ggg(j)=fac*(c(j,jj)-c(j,ii))
4921 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4922 C If this is a SC-SC distance, we need to calculate the contributions to the
4923 C Cartesian gradient in the SC vectors (ghpbx).
4926 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4927 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4930 cgrad do j=iii,jjj-1
4932 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4936 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4937 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4945 C--------------------------------------------------------------------------
4946 subroutine ssbond_ene(i,j,eij)
4948 C Calculate the distance and angle dependent SS-bond potential energy
4949 C using a free-energy function derived based on RHF/6-31G** ab initio
4950 C calculations of diethyl disulfide.
4952 C A. Liwo and U. Kozlowska, 11/24/03
4954 implicit real*8 (a-h,o-z)
4955 include 'DIMENSIONS'
4956 include 'COMMON.SBRIDGE'
4957 include 'COMMON.CHAIN'
4958 include 'COMMON.DERIV'
4959 include 'COMMON.LOCAL'
4960 include 'COMMON.INTERACT'
4961 include 'COMMON.VAR'
4962 include 'COMMON.IOUNITS'
4963 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4964 itypi=iabs(itype(i))
4968 dxi=dc_norm(1,nres+i)
4969 dyi=dc_norm(2,nres+i)
4970 dzi=dc_norm(3,nres+i)
4971 c dsci_inv=dsc_inv(itypi)
4972 dsci_inv=vbld_inv(nres+i)
4973 itypj=iabs(itype(j))
4974 c dscj_inv=dsc_inv(itypj)
4975 dscj_inv=vbld_inv(nres+j)
4979 dxj=dc_norm(1,nres+j)
4980 dyj=dc_norm(2,nres+j)
4981 dzj=dc_norm(3,nres+j)
4982 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4987 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4988 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4989 om12=dxi*dxj+dyi*dyj+dzi*dzj
4991 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4992 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4998 deltat12=om2-om1+2.0d0
5000 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5001 & +akct*deltad*deltat12
5002 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5003 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5004 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5005 c & " deltat12",deltat12," eij",eij
5006 ed=2*akcm*deltad+akct*deltat12
5008 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5009 eom1=-2*akth*deltat1-pom1-om2*pom2
5010 eom2= 2*akth*deltat2+pom1-om1*pom2
5013 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5014 ghpbx(k,i)=ghpbx(k,i)-ggk
5015 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5016 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5017 ghpbx(k,j)=ghpbx(k,j)+ggk
5018 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5019 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5020 ghpbc(k,i)=ghpbc(k,i)-ggk
5021 ghpbc(k,j)=ghpbc(k,j)+ggk
5024 C Calculate the components of the gradient in DC and X
5028 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5033 C--------------------------------------------------------------------------
5034 subroutine ebond(estr)
5036 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5038 implicit real*8 (a-h,o-z)
5039 include 'DIMENSIONS'
5040 include 'COMMON.LOCAL'
5041 include 'COMMON.GEO'
5042 include 'COMMON.INTERACT'
5043 include 'COMMON.DERIV'
5044 include 'COMMON.VAR'
5045 include 'COMMON.CHAIN'
5046 include 'COMMON.IOUNITS'
5047 include 'COMMON.NAMES'
5048 include 'COMMON.FFIELD'
5049 include 'COMMON.CONTROL'
5050 include 'COMMON.SETUP'
5051 double precision u(3),ud(3)
5054 do i=ibondp_start,ibondp_end
5055 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5056 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5058 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5059 c & *dc(j,i-1)/vbld(i)
5061 c if (energy_dec) write(iout,*)
5062 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5064 C Checking if it involves dummy (NH3+ or COO-) group
5065 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5066 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5067 diff = vbld(i)-vbldpDUM
5069 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5070 diff = vbld(i)-vbldp0
5072 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5073 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5076 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5078 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5081 estr=0.5d0*AKP*estr+estr1
5083 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5085 do i=ibond_start,ibond_end
5087 if (iti.ne.10 .and. iti.ne.ntyp1) then
5090 diff=vbld(i+nres)-vbldsc0(1,iti)
5091 if (energy_dec) write (iout,*)
5092 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5093 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5094 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5096 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5100 diff=vbld(i+nres)-vbldsc0(j,iti)
5101 ud(j)=aksc(j,iti)*diff
5102 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5116 uprod2=uprod2*u(k)*u(k)
5120 usumsqder=usumsqder+ud(j)*uprod2
5122 estr=estr+uprod/usum
5124 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5132 C--------------------------------------------------------------------------
5133 subroutine ebend(etheta)
5135 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5136 C angles gamma and its derivatives in consecutive thetas and gammas.
5138 implicit real*8 (a-h,o-z)
5139 include 'DIMENSIONS'
5140 include 'COMMON.LOCAL'
5141 include 'COMMON.GEO'
5142 include 'COMMON.INTERACT'
5143 include 'COMMON.DERIV'
5144 include 'COMMON.VAR'
5145 include 'COMMON.CHAIN'
5146 include 'COMMON.IOUNITS'
5147 include 'COMMON.NAMES'
5148 include 'COMMON.FFIELD'
5149 include 'COMMON.CONTROL'
5150 common /calcthet/ term1,term2,termm,diffak,ratak,
5151 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5152 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5153 double precision y(2),z(2)
5155 c time11=dexp(-2*time)
5158 c write (*,'(a,i2)') 'EBEND ICG=',icg
5159 do i=ithet_start,ithet_end
5160 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5161 & .or.itype(i).eq.ntyp1) cycle
5162 C Zero the energy function and its derivative at 0 or pi.
5163 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5165 ichir1=isign(1,itype(i-2))
5166 ichir2=isign(1,itype(i))
5167 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5168 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5169 if (itype(i-1).eq.10) then
5170 itype1=isign(10,itype(i-2))
5171 ichir11=isign(1,itype(i-2))
5172 ichir12=isign(1,itype(i-2))
5173 itype2=isign(10,itype(i))
5174 ichir21=isign(1,itype(i))
5175 ichir22=isign(1,itype(i))
5178 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5181 if (phii.ne.phii) phii=150.0
5191 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5194 if (phii1.ne.phii1) phii1=150.0
5206 C Calculate the "mean" value of theta from the part of the distribution
5207 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5208 C In following comments this theta will be referred to as t_c.
5209 thet_pred_mean=0.0d0
5211 athetk=athet(k,it,ichir1,ichir2)
5212 bthetk=bthet(k,it,ichir1,ichir2)
5214 athetk=athet(k,itype1,ichir11,ichir12)
5215 bthetk=bthet(k,itype2,ichir21,ichir22)
5217 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5218 c write(iout,*) 'chuj tu', y(k),z(k)
5220 dthett=thet_pred_mean*ssd
5221 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5222 C Derivatives of the "mean" values in gamma1 and gamma2.
5223 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5224 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5225 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5226 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5228 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5229 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5230 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5231 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5233 if (theta(i).gt.pi-delta) then
5234 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5236 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5237 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5238 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5240 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5242 else if (theta(i).lt.delta) then
5243 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5244 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5245 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5247 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5248 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5251 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5254 etheta=etheta+ethetai
5255 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5256 & 'ebend',i,ethetai,theta(i),itype(i)
5257 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5258 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5259 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5261 C Ufff.... We've done all this!!!
5264 C---------------------------------------------------------------------------
5265 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5267 implicit real*8 (a-h,o-z)
5268 include 'DIMENSIONS'
5269 include 'COMMON.LOCAL'
5270 include 'COMMON.IOUNITS'
5271 common /calcthet/ term1,term2,termm,diffak,ratak,
5272 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5273 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5274 C Calculate the contributions to both Gaussian lobes.
5275 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5276 C The "polynomial part" of the "standard deviation" of this part of
5277 C the distributioni.
5278 ccc write (iout,*) thetai,thet_pred_mean
5281 sig=sig*thet_pred_mean+polthet(j,it)
5283 C Derivative of the "interior part" of the "standard deviation of the"
5284 C gamma-dependent Gaussian lobe in t_c.
5285 sigtc=3*polthet(3,it)
5287 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5290 C Set the parameters of both Gaussian lobes of the distribution.
5291 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5292 fac=sig*sig+sigc0(it)
5295 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5296 sigsqtc=-4.0D0*sigcsq*sigtc
5297 c print *,i,sig,sigtc,sigsqtc
5298 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5299 sigtc=-sigtc/(fac*fac)
5300 C Following variable is sigma(t_c)**(-2)
5301 sigcsq=sigcsq*sigcsq
5303 sig0inv=1.0D0/sig0i**2
5304 delthec=thetai-thet_pred_mean
5305 delthe0=thetai-theta0i
5306 term1=-0.5D0*sigcsq*delthec*delthec
5307 term2=-0.5D0*sig0inv*delthe0*delthe0
5308 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5309 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5310 C NaNs in taking the logarithm. We extract the largest exponent which is added
5311 C to the energy (this being the log of the distribution) at the end of energy
5312 C term evaluation for this virtual-bond angle.
5313 if (term1.gt.term2) then
5315 term2=dexp(term2-termm)
5319 term1=dexp(term1-termm)
5322 C The ratio between the gamma-independent and gamma-dependent lobes of
5323 C the distribution is a Gaussian function of thet_pred_mean too.
5324 diffak=gthet(2,it)-thet_pred_mean
5325 ratak=diffak/gthet(3,it)**2
5326 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5327 C Let's differentiate it in thet_pred_mean NOW.
5329 C Now put together the distribution terms to make complete distribution.
5330 termexp=term1+ak*term2
5331 termpre=sigc+ak*sig0i
5332 C Contribution of the bending energy from this theta is just the -log of
5333 C the sum of the contributions from the two lobes and the pre-exponential
5334 C factor. Simple enough, isn't it?
5335 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5336 C write (iout,*) 'termexp',termexp,termm,termpre,i
5337 C NOW the derivatives!!!
5338 C 6/6/97 Take into account the deformation.
5339 E_theta=(delthec*sigcsq*term1
5340 & +ak*delthe0*sig0inv*term2)/termexp
5341 E_tc=((sigtc+aktc*sig0i)/termpre
5342 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5343 & aktc*term2)/termexp)
5346 c-----------------------------------------------------------------------------
5347 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5348 implicit real*8 (a-h,o-z)
5349 include 'DIMENSIONS'
5350 include 'COMMON.LOCAL'
5351 include 'COMMON.IOUNITS'
5352 common /calcthet/ term1,term2,termm,diffak,ratak,
5353 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5354 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5355 delthec=thetai-thet_pred_mean
5356 delthe0=thetai-theta0i
5357 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5358 t3 = thetai-thet_pred_mean
5362 t14 = t12+t6*sigsqtc
5364 t21 = thetai-theta0i
5370 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5371 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5372 & *(-t12*t9-ak*sig0inv*t27)
5376 C--------------------------------------------------------------------------
5377 subroutine ebend(etheta)
5379 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5380 C angles gamma and its derivatives in consecutive thetas and gammas.
5381 C ab initio-derived potentials from
5382 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5384 implicit real*8 (a-h,o-z)
5385 include 'DIMENSIONS'
5386 include 'COMMON.LOCAL'
5387 include 'COMMON.GEO'
5388 include 'COMMON.INTERACT'
5389 include 'COMMON.DERIV'
5390 include 'COMMON.VAR'
5391 include 'COMMON.CHAIN'
5392 include 'COMMON.IOUNITS'
5393 include 'COMMON.NAMES'
5394 include 'COMMON.FFIELD'
5395 include 'COMMON.CONTROL'
5396 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5397 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5398 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5399 & sinph1ph2(maxdouble,maxdouble)
5400 logical lprn /.false./, lprn1 /.false./
5402 do i=ithet_start,ithet_end
5403 c print *,i,itype(i-1),itype(i),itype(i-2)
5404 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5405 & .or.itype(i).eq.ntyp1) cycle
5406 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5408 if (iabs(itype(i+1)).eq.20) iblock=2
5409 if (iabs(itype(i+1)).ne.20) iblock=1
5413 theti2=0.5d0*theta(i)
5414 ityp2=ithetyp((itype(i-1)))
5416 coskt(k)=dcos(k*theti2)
5417 sinkt(k)=dsin(k*theti2)
5419 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5422 if (phii.ne.phii) phii=150.0
5426 ityp1=ithetyp((itype(i-2)))
5427 C propagation of chirality for glycine type
5429 cosph1(k)=dcos(k*phii)
5430 sinph1(k)=dsin(k*phii)
5440 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5443 if (phii1.ne.phii1) phii1=150.0
5448 ityp3=ithetyp((itype(i)))
5450 cosph2(k)=dcos(k*phii1)
5451 sinph2(k)=dsin(k*phii1)
5461 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5464 ccl=cosph1(l)*cosph2(k-l)
5465 ssl=sinph1(l)*sinph2(k-l)
5466 scl=sinph1(l)*cosph2(k-l)
5467 csl=cosph1(l)*sinph2(k-l)
5468 cosph1ph2(l,k)=ccl-ssl
5469 cosph1ph2(k,l)=ccl+ssl
5470 sinph1ph2(l,k)=scl+csl
5471 sinph1ph2(k,l)=scl-csl
5475 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5476 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5477 write (iout,*) "coskt and sinkt"
5479 write (iout,*) k,coskt(k),sinkt(k)
5483 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5484 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5487 & write (iout,*) "k",k,"
5488 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5489 & " ethetai",ethetai
5492 write (iout,*) "cosph and sinph"
5494 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5496 write (iout,*) "cosph1ph2 and sinph2ph2"
5499 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5500 & sinph1ph2(l,k),sinph1ph2(k,l)
5503 write(iout,*) "ethetai",ethetai
5507 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5508 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5509 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5510 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5511 ethetai=ethetai+sinkt(m)*aux
5512 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5513 dephii=dephii+k*sinkt(m)*(
5514 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5515 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5516 dephii1=dephii1+k*sinkt(m)*(
5517 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5518 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5520 & write (iout,*) "m",m," k",k," bbthet",
5521 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5522 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5523 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5524 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5528 & write(iout,*) "ethetai",ethetai
5532 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5533 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5534 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5535 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5536 ethetai=ethetai+sinkt(m)*aux
5537 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5538 dephii=dephii+l*sinkt(m)*(
5539 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5540 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5541 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5542 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5543 dephii1=dephii1+(k-l)*sinkt(m)*(
5544 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5545 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5546 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5547 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5549 write (iout,*) "m",m," k",k," l",l," ffthet",
5550 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5551 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5552 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5553 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5554 & " ethetai",ethetai
5555 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5556 & cosph1ph2(k,l)*sinkt(m),
5557 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5565 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5566 & i,theta(i)*rad2deg,phii*rad2deg,
5567 & phii1*rad2deg,ethetai
5569 etheta=etheta+ethetai
5570 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5571 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5572 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
5578 c-----------------------------------------------------------------------------
5579 subroutine esc(escloc)
5580 C Calculate the local energy of a side chain and its derivatives in the
5581 C corresponding virtual-bond valence angles THETA and the spherical angles
5583 implicit real*8 (a-h,o-z)
5584 include 'DIMENSIONS'
5585 include 'COMMON.GEO'
5586 include 'COMMON.LOCAL'
5587 include 'COMMON.VAR'
5588 include 'COMMON.INTERACT'
5589 include 'COMMON.DERIV'
5590 include 'COMMON.CHAIN'
5591 include 'COMMON.IOUNITS'
5592 include 'COMMON.NAMES'
5593 include 'COMMON.FFIELD'
5594 include 'COMMON.CONTROL'
5595 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5596 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5597 common /sccalc/ time11,time12,time112,theti,it,nlobit
5600 c write (iout,'(a)') 'ESC'
5601 do i=loc_start,loc_end
5603 if (it.eq.ntyp1) cycle
5604 if (it.eq.10) goto 1
5605 nlobit=nlob(iabs(it))
5606 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5607 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5608 theti=theta(i+1)-pipol
5613 if (x(2).gt.pi-delta) then
5617 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5619 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5620 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5622 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5623 & ddersc0(1),dersc(1))
5624 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5625 & ddersc0(3),dersc(3))
5627 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5629 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5630 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5631 & dersc0(2),esclocbi,dersc02)
5632 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5634 call splinthet(x(2),0.5d0*delta,ss,ssd)
5639 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5641 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5642 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5644 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5646 c write (iout,*) escloci
5647 else if (x(2).lt.delta) then
5651 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5653 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5654 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5656 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5657 & ddersc0(1),dersc(1))
5658 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5659 & ddersc0(3),dersc(3))
5661 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5663 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5664 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5665 & dersc0(2),esclocbi,dersc02)
5666 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5671 call splinthet(x(2),0.5d0*delta,ss,ssd)
5673 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5675 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5676 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5678 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5679 c write (iout,*) escloci
5681 call enesc(x,escloci,dersc,ddummy,.false.)
5684 escloc=escloc+escloci
5685 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5686 & 'escloc',i,escloci
5687 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5689 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5691 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5692 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5697 C---------------------------------------------------------------------------
5698 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5699 implicit real*8 (a-h,o-z)
5700 include 'DIMENSIONS'
5701 include 'COMMON.GEO'
5702 include 'COMMON.LOCAL'
5703 include 'COMMON.IOUNITS'
5704 common /sccalc/ time11,time12,time112,theti,it,nlobit
5705 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5706 double precision contr(maxlob,-1:1)
5708 c write (iout,*) 'it=',it,' nlobit=',nlobit
5712 if (mixed) ddersc(j)=0.0d0
5716 C Because of periodicity of the dependence of the SC energy in omega we have
5717 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5718 C To avoid underflows, first compute & store the exponents.
5726 z(k)=x(k)-censc(k,j,it)
5731 Axk=Axk+gaussc(l,k,j,it)*z(l)
5737 expfac=expfac+Ax(k,j,iii)*z(k)
5745 C As in the case of ebend, we want to avoid underflows in exponentiation and
5746 C subsequent NaNs and INFs in energy calculation.
5747 C Find the largest exponent
5751 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5755 cd print *,'it=',it,' emin=',emin
5757 C Compute the contribution to SC energy and derivatives
5762 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5763 if(adexp.ne.adexp) adexp=1.0
5766 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5768 cd print *,'j=',j,' expfac=',expfac
5769 escloc_i=escloc_i+expfac
5771 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5775 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5776 & +gaussc(k,2,j,it))*expfac
5783 dersc(1)=dersc(1)/cos(theti)**2
5784 ddersc(1)=ddersc(1)/cos(theti)**2
5787 escloci=-(dlog(escloc_i)-emin)
5789 dersc(j)=dersc(j)/escloc_i
5793 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5798 C------------------------------------------------------------------------------
5799 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5800 implicit real*8 (a-h,o-z)
5801 include 'DIMENSIONS'
5802 include 'COMMON.GEO'
5803 include 'COMMON.LOCAL'
5804 include 'COMMON.IOUNITS'
5805 common /sccalc/ time11,time12,time112,theti,it,nlobit
5806 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5807 double precision contr(maxlob)
5818 z(k)=x(k)-censc(k,j,it)
5824 Axk=Axk+gaussc(l,k,j,it)*z(l)
5830 expfac=expfac+Ax(k,j)*z(k)
5835 C As in the case of ebend, we want to avoid underflows in exponentiation and
5836 C subsequent NaNs and INFs in energy calculation.
5837 C Find the largest exponent
5840 if (emin.gt.contr(j)) emin=contr(j)
5844 C Compute the contribution to SC energy and derivatives
5848 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5849 escloc_i=escloc_i+expfac
5851 dersc(k)=dersc(k)+Ax(k,j)*expfac
5853 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5854 & +gaussc(1,2,j,it))*expfac
5858 dersc(1)=dersc(1)/cos(theti)**2
5859 dersc12=dersc12/cos(theti)**2
5860 escloci=-(dlog(escloc_i)-emin)
5862 dersc(j)=dersc(j)/escloc_i
5864 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5868 c----------------------------------------------------------------------------------
5869 subroutine esc(escloc)
5870 C Calculate the local energy of a side chain and its derivatives in the
5871 C corresponding virtual-bond valence angles THETA and the spherical angles
5872 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5873 C added by Urszula Kozlowska. 07/11/2007
5875 implicit real*8 (a-h,o-z)
5876 include 'DIMENSIONS'
5877 include 'COMMON.GEO'
5878 include 'COMMON.LOCAL'
5879 include 'COMMON.VAR'
5880 include 'COMMON.SCROT'
5881 include 'COMMON.INTERACT'
5882 include 'COMMON.DERIV'
5883 include 'COMMON.CHAIN'
5884 include 'COMMON.IOUNITS'
5885 include 'COMMON.NAMES'
5886 include 'COMMON.FFIELD'
5887 include 'COMMON.CONTROL'
5888 include 'COMMON.VECTORS'
5889 double precision x_prime(3),y_prime(3),z_prime(3)
5890 & , sumene,dsc_i,dp2_i,x(65),
5891 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5892 & de_dxx,de_dyy,de_dzz,de_dt
5893 double precision s1_t,s1_6_t,s2_t,s2_6_t
5895 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5896 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5897 & dt_dCi(3),dt_dCi1(3)
5898 common /sccalc/ time11,time12,time112,theti,it,nlobit
5901 do i=loc_start,loc_end
5902 if (itype(i).eq.ntyp1) cycle
5903 costtab(i+1) =dcos(theta(i+1))
5904 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5905 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5906 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5907 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5908 cosfac=dsqrt(cosfac2)
5909 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5910 sinfac=dsqrt(sinfac2)
5912 if (it.eq.10) goto 1
5914 C Compute the axes of tghe local cartesian coordinates system; store in
5915 c x_prime, y_prime and z_prime
5922 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5923 C & dc_norm(3,i+nres)
5925 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5926 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5929 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5932 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5933 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5934 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5935 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5936 c & " xy",scalar(x_prime(1),y_prime(1)),
5937 c & " xz",scalar(x_prime(1),z_prime(1)),
5938 c & " yy",scalar(y_prime(1),y_prime(1)),
5939 c & " yz",scalar(y_prime(1),z_prime(1)),
5940 c & " zz",scalar(z_prime(1),z_prime(1))
5942 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5943 C to local coordinate system. Store in xx, yy, zz.
5949 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5950 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5951 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5958 C Compute the energy of the ith side cbain
5960 c write (2,*) "xx",xx," yy",yy," zz",zz
5963 x(j) = sc_parmin(j,it)
5966 Cc diagnostics - remove later
5968 yy1 = dsin(alph(2))*dcos(omeg(2))
5969 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5970 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5971 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5973 C," --- ", xx_w,yy_w,zz_w
5976 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5977 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5979 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5980 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5982 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5983 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5984 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5985 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5986 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5988 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5989 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5990 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5991 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5992 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5994 dsc_i = 0.743d0+x(61)
5996 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5997 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5998 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5999 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6000 s1=(1+x(63))/(0.1d0 + dscp1)
6001 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6002 s2=(1+x(65))/(0.1d0 + dscp2)
6003 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6004 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6005 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6006 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6008 c & dscp1,dscp2,sumene
6009 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6010 escloc = escloc + sumene
6011 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6016 C This section to check the numerical derivatives of the energy of ith side
6017 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6018 C #define DEBUG in the code to turn it on.
6020 write (2,*) "sumene =",sumene
6024 write (2,*) xx,yy,zz
6025 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6026 de_dxx_num=(sumenep-sumene)/aincr
6028 write (2,*) "xx+ sumene from enesc=",sumenep
6031 write (2,*) xx,yy,zz
6032 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6033 de_dyy_num=(sumenep-sumene)/aincr
6035 write (2,*) "yy+ sumene from enesc=",sumenep
6038 write (2,*) xx,yy,zz
6039 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6040 de_dzz_num=(sumenep-sumene)/aincr
6042 write (2,*) "zz+ sumene from enesc=",sumenep
6043 costsave=cost2tab(i+1)
6044 sintsave=sint2tab(i+1)
6045 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6046 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6047 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6048 de_dt_num=(sumenep-sumene)/aincr
6049 write (2,*) " t+ sumene from enesc=",sumenep
6050 cost2tab(i+1)=costsave
6051 sint2tab(i+1)=sintsave
6052 C End of diagnostics section.
6055 C Compute the gradient of esc
6057 c zz=zz*dsign(1.0,dfloat(itype(i)))
6058 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6059 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6060 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6061 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6062 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6063 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6064 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6065 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6066 pom1=(sumene3*sint2tab(i+1)+sumene1)
6067 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6068 pom2=(sumene4*cost2tab(i+1)+sumene2)
6069 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6070 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6071 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6072 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6074 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6075 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6076 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6078 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6079 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6080 & +(pom1+pom2)*pom_dx
6082 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6085 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6086 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6087 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6089 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6090 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6091 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6092 & +x(59)*zz**2 +x(60)*xx*zz
6093 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6094 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6095 & +(pom1-pom2)*pom_dy
6097 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6100 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6101 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6102 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6103 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6104 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6105 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6106 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6107 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6109 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6112 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6113 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6114 & +pom1*pom_dt1+pom2*pom_dt2
6116 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6121 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6122 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6123 cosfac2xx=cosfac2*xx
6124 sinfac2yy=sinfac2*yy
6126 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6128 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6130 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6131 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6132 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6133 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6134 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6135 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6136 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6137 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6138 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6139 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6143 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6144 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6145 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6146 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6149 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6150 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6151 dZZ_XYZ(k)=vbld_inv(i+nres)*
6152 & (z_prime(k)-zz*dC_norm(k,i+nres))
6154 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6155 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6159 dXX_Ctab(k,i)=dXX_Ci(k)
6160 dXX_C1tab(k,i)=dXX_Ci1(k)
6161 dYY_Ctab(k,i)=dYY_Ci(k)
6162 dYY_C1tab(k,i)=dYY_Ci1(k)
6163 dZZ_Ctab(k,i)=dZZ_Ci(k)
6164 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6165 dXX_XYZtab(k,i)=dXX_XYZ(k)
6166 dYY_XYZtab(k,i)=dYY_XYZ(k)
6167 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6171 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6172 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6173 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6174 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6175 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6177 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6178 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6179 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6180 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6181 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6182 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6183 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6184 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6186 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6187 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6189 C to check gradient call subroutine check_grad
6195 c------------------------------------------------------------------------------
6196 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6198 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6199 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6200 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6201 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6203 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6204 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6206 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6207 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6208 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6209 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6210 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6212 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6213 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6214 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6215 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6216 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6218 dsc_i = 0.743d0+x(61)
6220 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6221 & *(xx*cost2+yy*sint2))
6222 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6223 & *(xx*cost2-yy*sint2))
6224 s1=(1+x(63))/(0.1d0 + dscp1)
6225 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6226 s2=(1+x(65))/(0.1d0 + dscp2)
6227 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6228 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6229 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6234 c------------------------------------------------------------------------------
6235 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6237 C This procedure calculates two-body contact function g(rij) and its derivative:
6240 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6243 C where x=(rij-r0ij)/delta
6245 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6248 double precision rij,r0ij,eps0ij,fcont,fprimcont
6249 double precision x,x2,x4,delta
6253 if (x.lt.-1.0D0) then
6256 else if (x.le.1.0D0) then
6259 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6260 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6267 c------------------------------------------------------------------------------
6268 subroutine splinthet(theti,delta,ss,ssder)
6269 implicit real*8 (a-h,o-z)
6270 include 'DIMENSIONS'
6271 include 'COMMON.VAR'
6272 include 'COMMON.GEO'
6275 if (theti.gt.pipol) then
6276 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6278 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6283 c------------------------------------------------------------------------------
6284 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6286 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6287 double precision ksi,ksi2,ksi3,a1,a2,a3
6288 a1=fprim0*delta/(f1-f0)
6294 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6295 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6298 c------------------------------------------------------------------------------
6299 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6301 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6302 double precision ksi,ksi2,ksi3,a1,a2,a3
6307 a2=3*(f1x-f0x)-2*fprim0x*delta
6308 a3=fprim0x*delta-2*(f1x-f0x)
6309 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6312 C-----------------------------------------------------------------------------
6314 C-----------------------------------------------------------------------------
6315 subroutine etor(etors,edihcnstr)
6316 implicit real*8 (a-h,o-z)
6317 include 'DIMENSIONS'
6318 include 'COMMON.VAR'
6319 include 'COMMON.GEO'
6320 include 'COMMON.LOCAL'
6321 include 'COMMON.TORSION'
6322 include 'COMMON.INTERACT'
6323 include 'COMMON.DERIV'
6324 include 'COMMON.CHAIN'
6325 include 'COMMON.NAMES'
6326 include 'COMMON.IOUNITS'
6327 include 'COMMON.FFIELD'
6328 include 'COMMON.TORCNSTR'
6329 include 'COMMON.CONTROL'
6331 C Set lprn=.true. for debugging
6335 do i=iphi_start,iphi_end
6337 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6338 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6339 itori=itortyp(itype(i-2))
6340 itori1=itortyp(itype(i-1))
6343 C Proline-Proline pair is a special case...
6344 if (itori.eq.3 .and. itori1.eq.3) then
6345 if (phii.gt.-dwapi3) then
6347 fac=1.0D0/(1.0D0-cosphi)
6348 etorsi=v1(1,3,3)*fac
6349 etorsi=etorsi+etorsi
6350 etors=etors+etorsi-v1(1,3,3)
6351 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6352 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6355 v1ij=v1(j+1,itori,itori1)
6356 v2ij=v2(j+1,itori,itori1)
6359 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6360 if (energy_dec) etors_ii=etors_ii+
6361 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6362 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6366 v1ij=v1(j,itori,itori1)
6367 v2ij=v2(j,itori,itori1)
6370 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6371 if (energy_dec) etors_ii=etors_ii+
6372 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6373 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6376 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6379 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6380 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6381 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6382 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6383 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6385 ! 6/20/98 - dihedral angle constraints
6388 itori=idih_constr(i)
6391 if (difi.gt.drange(i)) then
6393 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6394 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6395 else if (difi.lt.-drange(i)) then
6397 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6398 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6400 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6401 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6403 ! write (iout,*) 'edihcnstr',edihcnstr
6406 c------------------------------------------------------------------------------
6407 subroutine etor_d(etors_d)
6411 c----------------------------------------------------------------------------
6413 subroutine etor(etors,edihcnstr)
6414 implicit real*8 (a-h,o-z)
6415 include 'DIMENSIONS'
6416 include 'COMMON.VAR'
6417 include 'COMMON.GEO'
6418 include 'COMMON.LOCAL'
6419 include 'COMMON.TORSION'
6420 include 'COMMON.INTERACT'
6421 include 'COMMON.DERIV'
6422 include 'COMMON.CHAIN'
6423 include 'COMMON.NAMES'
6424 include 'COMMON.IOUNITS'
6425 include 'COMMON.FFIELD'
6426 include 'COMMON.TORCNSTR'
6427 include 'COMMON.CONTROL'
6429 C Set lprn=.true. for debugging
6433 do i=iphi_start,iphi_end
6434 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6435 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6436 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6437 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6438 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6439 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6440 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6441 C For introducing the NH3+ and COO- group please check the etor_d for reference
6444 if (iabs(itype(i)).eq.20) then
6449 itori=itortyp(itype(i-2))
6450 itori1=itortyp(itype(i-1))
6453 C Regular cosine and sine terms
6454 do j=1,nterm(itori,itori1,iblock)
6455 v1ij=v1(j,itori,itori1,iblock)
6456 v2ij=v2(j,itori,itori1,iblock)
6459 etors=etors+v1ij*cosphi+v2ij*sinphi
6460 if (energy_dec) etors_ii=etors_ii+
6461 & v1ij*cosphi+v2ij*sinphi
6462 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6466 C E = SUM ----------------------------------- - v1
6467 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6469 cosphi=dcos(0.5d0*phii)
6470 sinphi=dsin(0.5d0*phii)
6471 do j=1,nlor(itori,itori1,iblock)
6472 vl1ij=vlor1(j,itori,itori1)
6473 vl2ij=vlor2(j,itori,itori1)
6474 vl3ij=vlor3(j,itori,itori1)
6475 pom=vl2ij*cosphi+vl3ij*sinphi
6476 pom1=1.0d0/(pom*pom+1.0d0)
6477 etors=etors+vl1ij*pom1
6478 if (energy_dec) etors_ii=etors_ii+
6481 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6483 C Subtract the constant term
6484 etors=etors-v0(itori,itori1,iblock)
6485 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6486 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6488 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6489 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6490 & (v1(j,itori,itori1,iblock),j=1,6),
6491 & (v2(j,itori,itori1,iblock),j=1,6)
6492 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6493 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6495 ! 6/20/98 - dihedral angle constraints
6497 c do i=1,ndih_constr
6498 do i=idihconstr_start,idihconstr_end
6499 itori=idih_constr(i)
6501 difi=pinorm(phii-phi0(i))
6502 if (difi.gt.drange(i)) then
6504 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6505 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6506 else if (difi.lt.-drange(i)) then
6508 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6509 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6513 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6514 cd & rad2deg*phi0(i), rad2deg*drange(i),
6515 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6517 cd write (iout,*) 'edihcnstr',edihcnstr
6520 c----------------------------------------------------------------------------
6521 subroutine etor_d(etors_d)
6522 C 6/23/01 Compute double torsional energy
6523 implicit real*8 (a-h,o-z)
6524 include 'DIMENSIONS'
6525 include 'COMMON.VAR'
6526 include 'COMMON.GEO'
6527 include 'COMMON.LOCAL'
6528 include 'COMMON.TORSION'
6529 include 'COMMON.INTERACT'
6530 include 'COMMON.DERIV'
6531 include 'COMMON.CHAIN'
6532 include 'COMMON.NAMES'
6533 include 'COMMON.IOUNITS'
6534 include 'COMMON.FFIELD'
6535 include 'COMMON.TORCNSTR'
6537 C Set lprn=.true. for debugging
6541 c write(iout,*) "a tu??"
6542 do i=iphid_start,iphid_end
6543 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6544 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6545 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6546 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6547 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6548 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6549 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6550 & (itype(i+1).eq.ntyp1)) cycle
6551 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6552 itori=itortyp(itype(i-2))
6553 itori1=itortyp(itype(i-1))
6554 itori2=itortyp(itype(i))
6560 if (iabs(itype(i+1)).eq.20) iblock=2
6561 C Iblock=2 Proline type
6562 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6563 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6564 C if (itype(i+1).eq.ntyp1) iblock=3
6565 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6566 C IS or IS NOT need for this
6567 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6568 C is (itype(i-3).eq.ntyp1) ntblock=2
6569 C ntblock is N-terminal blocking group
6571 C Regular cosine and sine terms
6572 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6573 C Example of changes for NH3+ blocking group
6574 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6575 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6576 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6577 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6578 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6579 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6580 cosphi1=dcos(j*phii)
6581 sinphi1=dsin(j*phii)
6582 cosphi2=dcos(j*phii1)
6583 sinphi2=dsin(j*phii1)
6584 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6585 & v2cij*cosphi2+v2sij*sinphi2
6586 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6587 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6589 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6591 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6592 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6593 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6594 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6595 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6596 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6597 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6598 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6599 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6600 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6601 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6602 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6603 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6604 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6607 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6608 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6613 c------------------------------------------------------------------------------
6614 subroutine eback_sc_corr(esccor)
6615 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6616 c conformational states; temporarily implemented as differences
6617 c between UNRES torsional potentials (dependent on three types of
6618 c residues) and the torsional potentials dependent on all 20 types
6619 c of residues computed from AM1 energy surfaces of terminally-blocked
6620 c amino-acid residues.
6621 implicit real*8 (a-h,o-z)
6622 include 'DIMENSIONS'
6623 include 'COMMON.VAR'
6624 include 'COMMON.GEO'
6625 include 'COMMON.LOCAL'
6626 include 'COMMON.TORSION'
6627 include 'COMMON.SCCOR'
6628 include 'COMMON.INTERACT'
6629 include 'COMMON.DERIV'
6630 include 'COMMON.CHAIN'
6631 include 'COMMON.NAMES'
6632 include 'COMMON.IOUNITS'
6633 include 'COMMON.FFIELD'
6634 include 'COMMON.CONTROL'
6636 C Set lprn=.true. for debugging
6639 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6641 do i=itau_start,itau_end
6642 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6644 isccori=isccortyp(itype(i-2))
6645 isccori1=isccortyp(itype(i-1))
6646 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6648 do intertyp=1,3 !intertyp
6649 cc Added 09 May 2012 (Adasko)
6650 cc Intertyp means interaction type of backbone mainchain correlation:
6651 c 1 = SC...Ca...Ca...Ca
6652 c 2 = Ca...Ca...Ca...SC
6653 c 3 = SC...Ca...Ca...SCi
6655 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6656 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6657 & (itype(i-1).eq.ntyp1)))
6658 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6659 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6660 & .or.(itype(i).eq.ntyp1)))
6661 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6662 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6663 & (itype(i-3).eq.ntyp1)))) cycle
6664 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6665 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6667 do j=1,nterm_sccor(isccori,isccori1)
6668 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6669 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6670 cosphi=dcos(j*tauangle(intertyp,i))
6671 sinphi=dsin(j*tauangle(intertyp,i))
6672 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6673 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6675 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6676 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6678 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6679 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6680 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6681 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6682 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6688 c----------------------------------------------------------------------------
6689 subroutine multibody(ecorr)
6690 C This subroutine calculates multi-body contributions to energy following
6691 C the idea of Skolnick et al. If side chains I and J make a contact and
6692 C at the same time side chains I+1 and J+1 make a contact, an extra
6693 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6694 implicit real*8 (a-h,o-z)
6695 include 'DIMENSIONS'
6696 include 'COMMON.IOUNITS'
6697 include 'COMMON.DERIV'
6698 include 'COMMON.INTERACT'
6699 include 'COMMON.CONTACTS'
6700 double precision gx(3),gx1(3)
6703 C Set lprn=.true. for debugging
6707 write (iout,'(a)') 'Contact function values:'
6709 write (iout,'(i2,20(1x,i2,f10.5))')
6710 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6725 num_conti=num_cont(i)
6726 num_conti1=num_cont(i1)
6731 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6732 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6733 cd & ' ishift=',ishift
6734 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6735 C The system gains extra energy.
6736 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6737 endif ! j1==j+-ishift
6746 c------------------------------------------------------------------------------
6747 double precision function esccorr(i,j,k,l,jj,kk)
6748 implicit real*8 (a-h,o-z)
6749 include 'DIMENSIONS'
6750 include 'COMMON.IOUNITS'
6751 include 'COMMON.DERIV'
6752 include 'COMMON.INTERACT'
6753 include 'COMMON.CONTACTS'
6754 double precision gx(3),gx1(3)
6759 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6760 C Calculate the multi-body contribution to energy.
6761 C Calculate multi-body contributions to the gradient.
6762 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6763 cd & k,l,(gacont(m,kk,k),m=1,3)
6765 gx(m) =ekl*gacont(m,jj,i)
6766 gx1(m)=eij*gacont(m,kk,k)
6767 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6768 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6769 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6770 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6774 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6779 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6785 c------------------------------------------------------------------------------
6786 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6787 C This subroutine calculates multi-body contributions to hydrogen-bonding
6788 implicit real*8 (a-h,o-z)
6789 include 'DIMENSIONS'
6790 include 'COMMON.IOUNITS'
6793 parameter (max_cont=maxconts)
6794 parameter (max_dim=26)
6795 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6796 double precision zapas(max_dim,maxconts,max_fg_procs),
6797 & zapas_recv(max_dim,maxconts,max_fg_procs)
6798 common /przechowalnia/ zapas
6799 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6800 & status_array(MPI_STATUS_SIZE,maxconts*2)
6802 include 'COMMON.SETUP'
6803 include 'COMMON.FFIELD'
6804 include 'COMMON.DERIV'
6805 include 'COMMON.INTERACT'
6806 include 'COMMON.CONTACTS'
6807 include 'COMMON.CONTROL'
6808 include 'COMMON.LOCAL'
6809 double precision gx(3),gx1(3),time00
6812 C Set lprn=.true. for debugging
6817 if (nfgtasks.le.1) goto 30
6819 write (iout,'(a)') 'Contact function values before RECEIVE:'
6821 write (iout,'(2i3,50(1x,i2,f5.2))')
6822 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6823 & j=1,num_cont_hb(i))
6827 do i=1,ntask_cont_from
6830 do i=1,ntask_cont_to
6833 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6835 C Make the list of contacts to send to send to other procesors
6836 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6838 do i=iturn3_start,iturn3_end
6839 c write (iout,*) "make contact list turn3",i," num_cont",
6841 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6843 do i=iturn4_start,iturn4_end
6844 c write (iout,*) "make contact list turn4",i," num_cont",
6846 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6850 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6852 do j=1,num_cont_hb(i)
6855 iproc=iint_sent_local(k,jjc,ii)
6856 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6857 if (iproc.gt.0) then
6858 ncont_sent(iproc)=ncont_sent(iproc)+1
6859 nn=ncont_sent(iproc)
6861 zapas(2,nn,iproc)=jjc
6862 zapas(3,nn,iproc)=facont_hb(j,i)
6863 zapas(4,nn,iproc)=ees0p(j,i)
6864 zapas(5,nn,iproc)=ees0m(j,i)
6865 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6866 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6867 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6868 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6869 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6870 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6871 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6872 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6873 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6874 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6875 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6876 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6877 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6878 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6879 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6880 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6881 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6882 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6883 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6884 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6885 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6892 & "Numbers of contacts to be sent to other processors",
6893 & (ncont_sent(i),i=1,ntask_cont_to)
6894 write (iout,*) "Contacts sent"
6895 do ii=1,ntask_cont_to
6897 iproc=itask_cont_to(ii)
6898 write (iout,*) nn," contacts to processor",iproc,
6899 & " of CONT_TO_COMM group"
6901 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6909 CorrelID1=nfgtasks+fg_rank+1
6911 C Receive the numbers of needed contacts from other processors
6912 do ii=1,ntask_cont_from
6913 iproc=itask_cont_from(ii)
6915 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6916 & FG_COMM,req(ireq),IERR)
6918 c write (iout,*) "IRECV ended"
6920 C Send the number of contacts needed by other processors
6921 do ii=1,ntask_cont_to
6922 iproc=itask_cont_to(ii)
6924 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6925 & FG_COMM,req(ireq),IERR)
6927 c write (iout,*) "ISEND ended"
6928 c write (iout,*) "number of requests (nn)",ireq
6931 & call MPI_Waitall(ireq,req,status_array,ierr)
6933 c & "Numbers of contacts to be received from other processors",
6934 c & (ncont_recv(i),i=1,ntask_cont_from)
6938 do ii=1,ntask_cont_from
6939 iproc=itask_cont_from(ii)
6941 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6942 c & " of CONT_TO_COMM group"
6946 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6947 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6948 c write (iout,*) "ireq,req",ireq,req(ireq)
6951 C Send the contacts to processors that need them
6952 do ii=1,ntask_cont_to
6953 iproc=itask_cont_to(ii)
6955 c write (iout,*) nn," contacts to processor",iproc,
6956 c & " of CONT_TO_COMM group"
6959 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6960 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6961 c write (iout,*) "ireq,req",ireq,req(ireq)
6963 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6967 c write (iout,*) "number of requests (contacts)",ireq
6968 c write (iout,*) "req",(req(i),i=1,4)
6971 & call MPI_Waitall(ireq,req,status_array,ierr)
6972 do iii=1,ntask_cont_from
6973 iproc=itask_cont_from(iii)
6976 write (iout,*) "Received",nn," contacts from processor",iproc,
6977 & " of CONT_FROM_COMM group"
6980 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6985 ii=zapas_recv(1,i,iii)
6986 c Flag the received contacts to prevent double-counting
6987 jj=-zapas_recv(2,i,iii)
6988 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6990 nnn=num_cont_hb(ii)+1
6993 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6994 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6995 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6996 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6997 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6998 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6999 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7000 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7001 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7002 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7003 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7004 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7005 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7006 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7007 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7008 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7009 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7010 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7011 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7012 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7013 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7014 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7015 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7016 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7021 write (iout,'(a)') 'Contact function values after receive:'
7023 write (iout,'(2i3,50(1x,i3,f5.2))')
7024 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7025 & j=1,num_cont_hb(i))
7032 write (iout,'(a)') 'Contact function values:'
7034 write (iout,'(2i3,50(1x,i3,f5.2))')
7035 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7036 & j=1,num_cont_hb(i))
7040 C Remove the loop below after debugging !!!
7047 C Calculate the local-electrostatic correlation terms
7048 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7050 num_conti=num_cont_hb(i)
7051 num_conti1=num_cont_hb(i+1)
7058 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7059 c & ' jj=',jj,' kk=',kk
7060 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7061 & .or. j.lt.0 .and. j1.gt.0) .and.
7062 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7063 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7064 C The system gains extra energy.
7065 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7066 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7067 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7069 else if (j1.eq.j) then
7070 C Contacts I-J and I-(J+1) occur simultaneously.
7071 C The system loses extra energy.
7072 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7077 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7078 c & ' jj=',jj,' kk=',kk
7080 C Contacts I-J and (I+1)-J occur simultaneously.
7081 C The system loses extra energy.
7082 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7089 c------------------------------------------------------------------------------
7090 subroutine add_hb_contact(ii,jj,itask)
7091 implicit real*8 (a-h,o-z)
7092 include "DIMENSIONS"
7093 include "COMMON.IOUNITS"
7096 parameter (max_cont=maxconts)
7097 parameter (max_dim=26)
7098 include "COMMON.CONTACTS"
7099 double precision zapas(max_dim,maxconts,max_fg_procs),
7100 & zapas_recv(max_dim,maxconts,max_fg_procs)
7101 common /przechowalnia/ zapas
7102 integer i,j,ii,jj,iproc,itask(4),nn
7103 c write (iout,*) "itask",itask
7106 if (iproc.gt.0) then
7107 do j=1,num_cont_hb(ii)
7109 c write (iout,*) "i",ii," j",jj," jjc",jjc
7111 ncont_sent(iproc)=ncont_sent(iproc)+1
7112 nn=ncont_sent(iproc)
7113 zapas(1,nn,iproc)=ii
7114 zapas(2,nn,iproc)=jjc
7115 zapas(3,nn,iproc)=facont_hb(j,ii)
7116 zapas(4,nn,iproc)=ees0p(j,ii)
7117 zapas(5,nn,iproc)=ees0m(j,ii)
7118 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7119 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7120 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7121 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7122 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7123 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7124 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7125 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7126 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7127 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7128 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7129 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7130 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7131 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7132 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7133 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7134 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7135 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7136 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7137 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7138 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7146 c------------------------------------------------------------------------------
7147 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7149 C This subroutine calculates multi-body contributions to hydrogen-bonding
7150 implicit real*8 (a-h,o-z)
7151 include 'DIMENSIONS'
7152 include 'COMMON.IOUNITS'
7155 parameter (max_cont=maxconts)
7156 parameter (max_dim=70)
7157 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7158 double precision zapas(max_dim,maxconts,max_fg_procs),
7159 & zapas_recv(max_dim,maxconts,max_fg_procs)
7160 common /przechowalnia/ zapas
7161 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7162 & status_array(MPI_STATUS_SIZE,maxconts*2)
7164 include 'COMMON.SETUP'
7165 include 'COMMON.FFIELD'
7166 include 'COMMON.DERIV'
7167 include 'COMMON.LOCAL'
7168 include 'COMMON.INTERACT'
7169 include 'COMMON.CONTACTS'
7170 include 'COMMON.CHAIN'
7171 include 'COMMON.CONTROL'
7172 double precision gx(3),gx1(3)
7173 integer num_cont_hb_old(maxres)
7175 double precision eello4,eello5,eelo6,eello_turn6
7176 external eello4,eello5,eello6,eello_turn6
7177 C Set lprn=.true. for debugging
7182 num_cont_hb_old(i)=num_cont_hb(i)
7186 if (nfgtasks.le.1) goto 30
7188 write (iout,'(a)') 'Contact function values before RECEIVE:'
7190 write (iout,'(2i3,50(1x,i2,f5.2))')
7191 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7192 & j=1,num_cont_hb(i))
7196 do i=1,ntask_cont_from
7199 do i=1,ntask_cont_to
7202 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7204 C Make the list of contacts to send to send to other procesors
7205 do i=iturn3_start,iturn3_end
7206 c write (iout,*) "make contact list turn3",i," num_cont",
7208 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7210 do i=iturn4_start,iturn4_end
7211 c write (iout,*) "make contact list turn4",i," num_cont",
7213 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7217 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7219 do j=1,num_cont_hb(i)
7222 iproc=iint_sent_local(k,jjc,ii)
7223 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7224 if (iproc.ne.0) then
7225 ncont_sent(iproc)=ncont_sent(iproc)+1
7226 nn=ncont_sent(iproc)
7228 zapas(2,nn,iproc)=jjc
7229 zapas(3,nn,iproc)=d_cont(j,i)
7233 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7238 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7246 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7257 & "Numbers of contacts to be sent to other processors",
7258 & (ncont_sent(i),i=1,ntask_cont_to)
7259 write (iout,*) "Contacts sent"
7260 do ii=1,ntask_cont_to
7262 iproc=itask_cont_to(ii)
7263 write (iout,*) nn," contacts to processor",iproc,
7264 & " of CONT_TO_COMM group"
7266 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7274 CorrelID1=nfgtasks+fg_rank+1
7276 C Receive the numbers of needed contacts from other processors
7277 do ii=1,ntask_cont_from
7278 iproc=itask_cont_from(ii)
7280 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7281 & FG_COMM,req(ireq),IERR)
7283 c write (iout,*) "IRECV ended"
7285 C Send the number of contacts needed by other processors
7286 do ii=1,ntask_cont_to
7287 iproc=itask_cont_to(ii)
7289 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7290 & FG_COMM,req(ireq),IERR)
7292 c write (iout,*) "ISEND ended"
7293 c write (iout,*) "number of requests (nn)",ireq
7296 & call MPI_Waitall(ireq,req,status_array,ierr)
7298 c & "Numbers of contacts to be received from other processors",
7299 c & (ncont_recv(i),i=1,ntask_cont_from)
7303 do ii=1,ntask_cont_from
7304 iproc=itask_cont_from(ii)
7306 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7307 c & " of CONT_TO_COMM group"
7311 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7312 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7313 c write (iout,*) "ireq,req",ireq,req(ireq)
7316 C Send the contacts to processors that need them
7317 do ii=1,ntask_cont_to
7318 iproc=itask_cont_to(ii)
7320 c write (iout,*) nn," contacts to processor",iproc,
7321 c & " of CONT_TO_COMM group"
7324 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7325 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7326 c write (iout,*) "ireq,req",ireq,req(ireq)
7328 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7332 c write (iout,*) "number of requests (contacts)",ireq
7333 c write (iout,*) "req",(req(i),i=1,4)
7336 & call MPI_Waitall(ireq,req,status_array,ierr)
7337 do iii=1,ntask_cont_from
7338 iproc=itask_cont_from(iii)
7341 write (iout,*) "Received",nn," contacts from processor",iproc,
7342 & " of CONT_FROM_COMM group"
7345 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7350 ii=zapas_recv(1,i,iii)
7351 c Flag the received contacts to prevent double-counting
7352 jj=-zapas_recv(2,i,iii)
7353 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7355 nnn=num_cont_hb(ii)+1
7358 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7362 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7367 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7375 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7384 write (iout,'(a)') 'Contact function values after receive:'
7386 write (iout,'(2i3,50(1x,i3,5f6.3))')
7387 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7388 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7395 write (iout,'(a)') 'Contact function values:'
7397 write (iout,'(2i3,50(1x,i2,5f6.3))')
7398 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7399 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7405 C Remove the loop below after debugging !!!
7412 C Calculate the dipole-dipole interaction energies
7413 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7414 do i=iatel_s,iatel_e+1
7415 num_conti=num_cont_hb(i)
7424 C Calculate the local-electrostatic correlation terms
7425 c write (iout,*) "gradcorr5 in eello5 before loop"
7427 c write (iout,'(i5,3f10.5)')
7428 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7430 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7431 c write (iout,*) "corr loop i",i
7433 num_conti=num_cont_hb(i)
7434 num_conti1=num_cont_hb(i+1)
7441 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7442 c & ' jj=',jj,' kk=',kk
7443 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7444 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7445 & .or. j.lt.0 .and. j1.gt.0) .and.
7446 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7447 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7448 C The system gains extra energy.
7450 sqd1=dsqrt(d_cont(jj,i))
7451 sqd2=dsqrt(d_cont(kk,i1))
7452 sred_geom = sqd1*sqd2
7453 IF (sred_geom.lt.cutoff_corr) THEN
7454 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7456 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7457 cd & ' jj=',jj,' kk=',kk
7458 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7459 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7461 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7462 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7465 cd write (iout,*) 'sred_geom=',sred_geom,
7466 cd & ' ekont=',ekont,' fprim=',fprimcont,
7467 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7468 cd write (iout,*) "g_contij",g_contij
7469 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7470 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7471 call calc_eello(i,jp,i+1,jp1,jj,kk)
7472 if (wcorr4.gt.0.0d0)
7473 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7474 if (energy_dec.and.wcorr4.gt.0.0d0)
7475 1 write (iout,'(a6,4i5,0pf7.3)')
7476 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7477 c write (iout,*) "gradcorr5 before eello5"
7479 c write (iout,'(i5,3f10.5)')
7480 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7482 if (wcorr5.gt.0.0d0)
7483 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7484 c write (iout,*) "gradcorr5 after eello5"
7486 c write (iout,'(i5,3f10.5)')
7487 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7489 if (energy_dec.and.wcorr5.gt.0.0d0)
7490 1 write (iout,'(a6,4i5,0pf7.3)')
7491 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7492 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7493 cd write(2,*)'ijkl',i,jp,i+1,jp1
7494 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7495 & .or. wturn6.eq.0.0d0))then
7496 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7497 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7498 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7499 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7500 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7501 cd & 'ecorr6=',ecorr6
7502 cd write (iout,'(4e15.5)') sred_geom,
7503 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7504 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7505 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7506 else if (wturn6.gt.0.0d0
7507 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7508 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7509 eturn6=eturn6+eello_turn6(i,jj,kk)
7510 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7511 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7512 cd write (2,*) 'multibody_eello:eturn6',eturn6
7521 num_cont_hb(i)=num_cont_hb_old(i)
7523 c write (iout,*) "gradcorr5 in eello5"
7525 c write (iout,'(i5,3f10.5)')
7526 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7530 c------------------------------------------------------------------------------
7531 subroutine add_hb_contact_eello(ii,jj,itask)
7532 implicit real*8 (a-h,o-z)
7533 include "DIMENSIONS"
7534 include "COMMON.IOUNITS"
7537 parameter (max_cont=maxconts)
7538 parameter (max_dim=70)
7539 include "COMMON.CONTACTS"
7540 double precision zapas(max_dim,maxconts,max_fg_procs),
7541 & zapas_recv(max_dim,maxconts,max_fg_procs)
7542 common /przechowalnia/ zapas
7543 integer i,j,ii,jj,iproc,itask(4),nn
7544 c write (iout,*) "itask",itask
7547 if (iproc.gt.0) then
7548 do j=1,num_cont_hb(ii)
7550 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7552 ncont_sent(iproc)=ncont_sent(iproc)+1
7553 nn=ncont_sent(iproc)
7554 zapas(1,nn,iproc)=ii
7555 zapas(2,nn,iproc)=jjc
7556 zapas(3,nn,iproc)=d_cont(j,ii)
7560 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7565 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7573 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7585 c------------------------------------------------------------------------------
7586 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7587 implicit real*8 (a-h,o-z)
7588 include 'DIMENSIONS'
7589 include 'COMMON.IOUNITS'
7590 include 'COMMON.DERIV'
7591 include 'COMMON.INTERACT'
7592 include 'COMMON.CONTACTS'
7593 double precision gx(3),gx1(3)
7603 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7604 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7605 C Following 4 lines for diagnostics.
7610 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7611 c & 'Contacts ',i,j,
7612 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7613 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7615 C Calculate the multi-body contribution to energy.
7616 c ecorr=ecorr+ekont*ees
7617 C Calculate multi-body contributions to the gradient.
7618 coeffpees0pij=coeffp*ees0pij
7619 coeffmees0mij=coeffm*ees0mij
7620 coeffpees0pkl=coeffp*ees0pkl
7621 coeffmees0mkl=coeffm*ees0mkl
7623 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7624 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7625 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7626 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7627 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7628 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7629 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7630 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7631 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7632 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7633 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7634 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7635 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7636 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7637 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7638 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7639 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7640 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7641 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7642 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7643 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7644 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7645 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7646 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7647 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7652 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7653 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7654 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7655 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7660 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7661 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7662 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7663 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7666 c write (iout,*) "ehbcorr",ekont*ees
7671 C---------------------------------------------------------------------------
7672 subroutine dipole(i,j,jj)
7673 implicit real*8 (a-h,o-z)
7674 include 'DIMENSIONS'
7675 include 'COMMON.IOUNITS'
7676 include 'COMMON.CHAIN'
7677 include 'COMMON.FFIELD'
7678 include 'COMMON.DERIV'
7679 include 'COMMON.INTERACT'
7680 include 'COMMON.CONTACTS'
7681 include 'COMMON.TORSION'
7682 include 'COMMON.VAR'
7683 include 'COMMON.GEO'
7684 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7686 iti1 = itortyp(itype(i+1))
7687 if (j.lt.nres-1) then
7688 itj1 = itortyp(itype(j+1))
7693 dipi(iii,1)=Ub2(iii,i)
7694 dipderi(iii)=Ub2der(iii,i)
7695 dipi(iii,2)=b1(iii,i+1)
7696 dipj(iii,1)=Ub2(iii,j)
7697 dipderj(iii)=Ub2der(iii,j)
7698 dipj(iii,2)=b1(iii,j+1)
7702 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7705 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7712 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7716 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7721 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7722 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7724 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7726 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7728 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7733 C---------------------------------------------------------------------------
7734 subroutine calc_eello(i,j,k,l,jj,kk)
7736 C This subroutine computes matrices and vectors needed to calculate
7737 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7739 implicit real*8 (a-h,o-z)
7740 include 'DIMENSIONS'
7741 include 'COMMON.IOUNITS'
7742 include 'COMMON.CHAIN'
7743 include 'COMMON.DERIV'
7744 include 'COMMON.INTERACT'
7745 include 'COMMON.CONTACTS'
7746 include 'COMMON.TORSION'
7747 include 'COMMON.VAR'
7748 include 'COMMON.GEO'
7749 include 'COMMON.FFIELD'
7750 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7751 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7754 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7755 cd & ' jj=',jj,' kk=',kk
7756 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7757 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7758 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7761 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7762 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7765 call transpose2(aa1(1,1),aa1t(1,1))
7766 call transpose2(aa2(1,1),aa2t(1,1))
7769 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7770 & aa1tder(1,1,lll,kkk))
7771 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7772 & aa2tder(1,1,lll,kkk))
7776 C parallel orientation of the two CA-CA-CA frames.
7778 iti=itortyp(itype(i))
7782 itk1=itortyp(itype(k+1))
7783 itj=itortyp(itype(j))
7784 if (l.lt.nres-1) then
7785 itl1=itortyp(itype(l+1))
7789 C A1 kernel(j+1) A2T
7791 cd write (iout,'(3f10.5,5x,3f10.5)')
7792 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7794 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7795 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7796 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7797 C Following matrices are needed only for 6-th order cumulants
7798 IF (wcorr6.gt.0.0d0) THEN
7799 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7800 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7801 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7802 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7803 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7804 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7805 & ADtEAderx(1,1,1,1,1,1))
7807 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7808 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7809 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7810 & ADtEA1derx(1,1,1,1,1,1))
7812 C End 6-th order cumulants
7815 cd write (2,*) 'In calc_eello6'
7817 cd write (2,*) 'iii=',iii
7819 cd write (2,*) 'kkk=',kkk
7821 cd write (2,'(3(2f10.5),5x)')
7822 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7827 call transpose2(EUgder(1,1,k),auxmat(1,1))
7828 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7829 call transpose2(EUg(1,1,k),auxmat(1,1))
7830 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7831 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7835 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7836 & EAEAderx(1,1,lll,kkk,iii,1))
7840 C A1T kernel(i+1) A2
7841 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7842 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7843 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7844 C Following matrices are needed only for 6-th order cumulants
7845 IF (wcorr6.gt.0.0d0) THEN
7846 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7847 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7848 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7849 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7850 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7851 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7852 & ADtEAderx(1,1,1,1,1,2))
7853 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7854 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7855 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7856 & ADtEA1derx(1,1,1,1,1,2))
7858 C End 6-th order cumulants
7859 call transpose2(EUgder(1,1,l),auxmat(1,1))
7860 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7861 call transpose2(EUg(1,1,l),auxmat(1,1))
7862 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7863 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7867 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7868 & EAEAderx(1,1,lll,kkk,iii,2))
7873 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7874 C They are needed only when the fifth- or the sixth-order cumulants are
7876 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7877 call transpose2(AEA(1,1,1),auxmat(1,1))
7878 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7879 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7880 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7881 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7882 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7883 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7884 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7885 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7886 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7887 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7888 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7889 call transpose2(AEA(1,1,2),auxmat(1,1))
7890 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7891 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7892 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7893 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7894 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7895 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7896 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7897 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7898 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7899 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7900 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7901 C Calculate the Cartesian derivatives of the vectors.
7905 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7906 call matvec2(auxmat(1,1),b1(1,i),
7907 & AEAb1derx(1,lll,kkk,iii,1,1))
7908 call matvec2(auxmat(1,1),Ub2(1,i),
7909 & AEAb2derx(1,lll,kkk,iii,1,1))
7910 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7911 & AEAb1derx(1,lll,kkk,iii,2,1))
7912 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7913 & AEAb2derx(1,lll,kkk,iii,2,1))
7914 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7915 call matvec2(auxmat(1,1),b1(1,j),
7916 & AEAb1derx(1,lll,kkk,iii,1,2))
7917 call matvec2(auxmat(1,1),Ub2(1,j),
7918 & AEAb2derx(1,lll,kkk,iii,1,2))
7919 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7920 & AEAb1derx(1,lll,kkk,iii,2,2))
7921 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7922 & AEAb2derx(1,lll,kkk,iii,2,2))
7929 C Antiparallel orientation of the two CA-CA-CA frames.
7931 iti=itortyp(itype(i))
7935 itk1=itortyp(itype(k+1))
7936 itl=itortyp(itype(l))
7937 itj=itortyp(itype(j))
7938 if (j.lt.nres-1) then
7939 itj1=itortyp(itype(j+1))
7943 C A2 kernel(j-1)T A1T
7944 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7945 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7946 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7947 C Following matrices are needed only for 6-th order cumulants
7948 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7949 & j.eq.i+4 .and. l.eq.i+3)) THEN
7950 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7951 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7952 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7953 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7954 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7955 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7956 & ADtEAderx(1,1,1,1,1,1))
7957 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7958 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7959 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7960 & ADtEA1derx(1,1,1,1,1,1))
7962 C End 6-th order cumulants
7963 call transpose2(EUgder(1,1,k),auxmat(1,1))
7964 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7965 call transpose2(EUg(1,1,k),auxmat(1,1))
7966 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7967 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7971 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7972 & EAEAderx(1,1,lll,kkk,iii,1))
7976 C A2T kernel(i+1)T A1
7977 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7978 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7979 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7980 C Following matrices are needed only for 6-th order cumulants
7981 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7982 & j.eq.i+4 .and. l.eq.i+3)) THEN
7983 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7984 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7985 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7986 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7987 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7988 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7989 & ADtEAderx(1,1,1,1,1,2))
7990 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7991 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7992 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7993 & ADtEA1derx(1,1,1,1,1,2))
7995 C End 6-th order cumulants
7996 call transpose2(EUgder(1,1,j),auxmat(1,1))
7997 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7998 call transpose2(EUg(1,1,j),auxmat(1,1))
7999 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8000 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8004 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8005 & EAEAderx(1,1,lll,kkk,iii,2))
8010 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8011 C They are needed only when the fifth- or the sixth-order cumulants are
8013 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8014 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8015 call transpose2(AEA(1,1,1),auxmat(1,1))
8016 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8017 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8018 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8019 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8020 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8021 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8022 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8023 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8024 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8025 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8026 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8027 call transpose2(AEA(1,1,2),auxmat(1,1))
8028 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8029 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8030 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8031 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8032 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8033 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8034 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8035 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8036 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8037 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8038 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8039 C Calculate the Cartesian derivatives of the vectors.
8043 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8044 call matvec2(auxmat(1,1),b1(1,i),
8045 & AEAb1derx(1,lll,kkk,iii,1,1))
8046 call matvec2(auxmat(1,1),Ub2(1,i),
8047 & AEAb2derx(1,lll,kkk,iii,1,1))
8048 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8049 & AEAb1derx(1,lll,kkk,iii,2,1))
8050 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8051 & AEAb2derx(1,lll,kkk,iii,2,1))
8052 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8053 call matvec2(auxmat(1,1),b1(1,l),
8054 & AEAb1derx(1,lll,kkk,iii,1,2))
8055 call matvec2(auxmat(1,1),Ub2(1,l),
8056 & AEAb2derx(1,lll,kkk,iii,1,2))
8057 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8058 & AEAb1derx(1,lll,kkk,iii,2,2))
8059 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8060 & AEAb2derx(1,lll,kkk,iii,2,2))
8069 C---------------------------------------------------------------------------
8070 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8071 & KK,KKderg,AKA,AKAderg,AKAderx)
8075 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8076 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8077 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8082 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8084 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8087 cd if (lprn) write (2,*) 'In kernel'
8089 cd if (lprn) write (2,*) 'kkk=',kkk
8091 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8092 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8094 cd write (2,*) 'lll=',lll
8095 cd write (2,*) 'iii=1'
8097 cd write (2,'(3(2f10.5),5x)')
8098 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8101 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8102 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8104 cd write (2,*) 'lll=',lll
8105 cd write (2,*) 'iii=2'
8107 cd write (2,'(3(2f10.5),5x)')
8108 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8115 C---------------------------------------------------------------------------
8116 double precision function eello4(i,j,k,l,jj,kk)
8117 implicit real*8 (a-h,o-z)
8118 include 'DIMENSIONS'
8119 include 'COMMON.IOUNITS'
8120 include 'COMMON.CHAIN'
8121 include 'COMMON.DERIV'
8122 include 'COMMON.INTERACT'
8123 include 'COMMON.CONTACTS'
8124 include 'COMMON.TORSION'
8125 include 'COMMON.VAR'
8126 include 'COMMON.GEO'
8127 double precision pizda(2,2),ggg1(3),ggg2(3)
8128 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8132 cd print *,'eello4:',i,j,k,l,jj,kk
8133 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8134 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8135 cold eij=facont_hb(jj,i)
8136 cold ekl=facont_hb(kk,k)
8138 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8139 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8140 gcorr_loc(k-1)=gcorr_loc(k-1)
8141 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8143 gcorr_loc(l-1)=gcorr_loc(l-1)
8144 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8146 gcorr_loc(j-1)=gcorr_loc(j-1)
8147 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8152 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8153 & -EAEAderx(2,2,lll,kkk,iii,1)
8154 cd derx(lll,kkk,iii)=0.0d0
8158 cd gcorr_loc(l-1)=0.0d0
8159 cd gcorr_loc(j-1)=0.0d0
8160 cd gcorr_loc(k-1)=0.0d0
8162 cd write (iout,*)'Contacts have occurred for peptide groups',
8163 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8164 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8165 if (j.lt.nres-1) then
8172 if (l.lt.nres-1) then
8180 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8181 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8182 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8183 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8184 cgrad ghalf=0.5d0*ggg1(ll)
8185 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8186 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8187 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8188 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8189 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8190 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8191 cgrad ghalf=0.5d0*ggg2(ll)
8192 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8193 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8194 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8195 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8196 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8197 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8201 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8206 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8211 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8216 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8220 cd write (2,*) iii,gcorr_loc(iii)
8223 cd write (2,*) 'ekont',ekont
8224 cd write (iout,*) 'eello4',ekont*eel4
8227 C---------------------------------------------------------------------------
8228 double precision function eello5(i,j,k,l,jj,kk)
8229 implicit real*8 (a-h,o-z)
8230 include 'DIMENSIONS'
8231 include 'COMMON.IOUNITS'
8232 include 'COMMON.CHAIN'
8233 include 'COMMON.DERIV'
8234 include 'COMMON.INTERACT'
8235 include 'COMMON.CONTACTS'
8236 include 'COMMON.TORSION'
8237 include 'COMMON.VAR'
8238 include 'COMMON.GEO'
8239 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8240 double precision ggg1(3),ggg2(3)
8241 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8246 C /l\ / \ \ / \ / \ / C
8247 C / \ / \ \ / \ / \ / C
8248 C j| o |l1 | o | o| o | | o |o C
8249 C \ |/k\| |/ \| / |/ \| |/ \| C
8250 C \i/ \ / \ / / \ / \ C
8252 C (I) (II) (III) (IV) C
8254 C eello5_1 eello5_2 eello5_3 eello5_4 C
8256 C Antiparallel chains C
8259 C /j\ / \ \ / \ / \ / C
8260 C / \ / \ \ / \ / \ / C
8261 C j1| o |l | o | o| o | | o |o C
8262 C \ |/k\| |/ \| / |/ \| |/ \| C
8263 C \i/ \ / \ / / \ / \ C
8265 C (I) (II) (III) (IV) C
8267 C eello5_1 eello5_2 eello5_3 eello5_4 C
8269 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8271 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8272 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8277 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8279 itk=itortyp(itype(k))
8280 itl=itortyp(itype(l))
8281 itj=itortyp(itype(j))
8286 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8287 cd & eel5_3_num,eel5_4_num)
8291 derx(lll,kkk,iii)=0.0d0
8295 cd eij=facont_hb(jj,i)
8296 cd ekl=facont_hb(kk,k)
8298 cd write (iout,*)'Contacts have occurred for peptide groups',
8299 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8301 C Contribution from the graph I.
8302 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8303 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8304 call transpose2(EUg(1,1,k),auxmat(1,1))
8305 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8306 vv(1)=pizda(1,1)-pizda(2,2)
8307 vv(2)=pizda(1,2)+pizda(2,1)
8308 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8309 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8310 C Explicit gradient in virtual-dihedral angles.
8311 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8312 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8313 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8314 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8315 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8316 vv(1)=pizda(1,1)-pizda(2,2)
8317 vv(2)=pizda(1,2)+pizda(2,1)
8318 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8319 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8320 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8321 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8322 vv(1)=pizda(1,1)-pizda(2,2)
8323 vv(2)=pizda(1,2)+pizda(2,1)
8325 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8326 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8327 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8329 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8330 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8331 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8333 C Cartesian gradient
8337 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8339 vv(1)=pizda(1,1)-pizda(2,2)
8340 vv(2)=pizda(1,2)+pizda(2,1)
8341 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8342 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8343 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8349 C Contribution from graph II
8350 call transpose2(EE(1,1,itk),auxmat(1,1))
8351 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8352 vv(1)=pizda(1,1)+pizda(2,2)
8353 vv(2)=pizda(2,1)-pizda(1,2)
8354 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8355 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8356 C Explicit gradient in virtual-dihedral angles.
8357 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8358 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8359 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8360 vv(1)=pizda(1,1)+pizda(2,2)
8361 vv(2)=pizda(2,1)-pizda(1,2)
8363 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8364 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8365 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8367 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8368 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8369 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8371 C Cartesian gradient
8375 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8377 vv(1)=pizda(1,1)+pizda(2,2)
8378 vv(2)=pizda(2,1)-pizda(1,2)
8379 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8380 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8381 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8389 C Parallel orientation
8390 C Contribution from graph III
8391 call transpose2(EUg(1,1,l),auxmat(1,1))
8392 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8393 vv(1)=pizda(1,1)-pizda(2,2)
8394 vv(2)=pizda(1,2)+pizda(2,1)
8395 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8396 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8397 C Explicit gradient in virtual-dihedral angles.
8398 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8399 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8400 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8401 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8402 vv(1)=pizda(1,1)-pizda(2,2)
8403 vv(2)=pizda(1,2)+pizda(2,1)
8404 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8405 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8406 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8407 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8408 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8409 vv(1)=pizda(1,1)-pizda(2,2)
8410 vv(2)=pizda(1,2)+pizda(2,1)
8411 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8412 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8413 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8414 C Cartesian gradient
8418 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8420 vv(1)=pizda(1,1)-pizda(2,2)
8421 vv(2)=pizda(1,2)+pizda(2,1)
8422 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8423 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8424 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8429 C Contribution from graph IV
8431 call transpose2(EE(1,1,itl),auxmat(1,1))
8432 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8433 vv(1)=pizda(1,1)+pizda(2,2)
8434 vv(2)=pizda(2,1)-pizda(1,2)
8435 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8436 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8437 C Explicit gradient in virtual-dihedral angles.
8438 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8439 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8440 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8441 vv(1)=pizda(1,1)+pizda(2,2)
8442 vv(2)=pizda(2,1)-pizda(1,2)
8443 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8444 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8445 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8446 C Cartesian gradient
8450 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8452 vv(1)=pizda(1,1)+pizda(2,2)
8453 vv(2)=pizda(2,1)-pizda(1,2)
8454 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8455 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8456 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8461 C Antiparallel orientation
8462 C Contribution from graph III
8464 call transpose2(EUg(1,1,j),auxmat(1,1))
8465 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8466 vv(1)=pizda(1,1)-pizda(2,2)
8467 vv(2)=pizda(1,2)+pizda(2,1)
8468 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8469 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8470 C Explicit gradient in virtual-dihedral angles.
8471 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8472 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8473 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8474 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8475 vv(1)=pizda(1,1)-pizda(2,2)
8476 vv(2)=pizda(1,2)+pizda(2,1)
8477 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8478 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8479 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8480 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8481 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8482 vv(1)=pizda(1,1)-pizda(2,2)
8483 vv(2)=pizda(1,2)+pizda(2,1)
8484 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8485 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8486 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8487 C Cartesian gradient
8491 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8493 vv(1)=pizda(1,1)-pizda(2,2)
8494 vv(2)=pizda(1,2)+pizda(2,1)
8495 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8496 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8497 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8502 C Contribution from graph IV
8504 call transpose2(EE(1,1,itj),auxmat(1,1))
8505 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8506 vv(1)=pizda(1,1)+pizda(2,2)
8507 vv(2)=pizda(2,1)-pizda(1,2)
8508 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8509 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8510 C Explicit gradient in virtual-dihedral angles.
8511 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8512 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8513 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8514 vv(1)=pizda(1,1)+pizda(2,2)
8515 vv(2)=pizda(2,1)-pizda(1,2)
8516 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8517 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8518 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8519 C Cartesian gradient
8523 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8525 vv(1)=pizda(1,1)+pizda(2,2)
8526 vv(2)=pizda(2,1)-pizda(1,2)
8527 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8528 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8529 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8535 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8536 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8537 cd write (2,*) 'ijkl',i,j,k,l
8538 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8539 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8541 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8542 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8543 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8544 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8545 if (j.lt.nres-1) then
8552 if (l.lt.nres-1) then
8562 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8563 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8564 C summed up outside the subrouine as for the other subroutines
8565 C handling long-range interactions. The old code is commented out
8566 C with "cgrad" to keep track of changes.
8568 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8569 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8570 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8571 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8572 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8573 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8574 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8575 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8576 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8577 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8579 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8580 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8581 cgrad ghalf=0.5d0*ggg1(ll)
8583 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8584 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8585 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8586 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8587 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8588 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8589 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8590 cgrad ghalf=0.5d0*ggg2(ll)
8592 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8593 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8594 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8595 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8596 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8597 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8602 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8603 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8608 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8609 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8615 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8620 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8624 cd write (2,*) iii,g_corr5_loc(iii)
8627 cd write (2,*) 'ekont',ekont
8628 cd write (iout,*) 'eello5',ekont*eel5
8631 c--------------------------------------------------------------------------
8632 double precision function eello6(i,j,k,l,jj,kk)
8633 implicit real*8 (a-h,o-z)
8634 include 'DIMENSIONS'
8635 include 'COMMON.IOUNITS'
8636 include 'COMMON.CHAIN'
8637 include 'COMMON.DERIV'
8638 include 'COMMON.INTERACT'
8639 include 'COMMON.CONTACTS'
8640 include 'COMMON.TORSION'
8641 include 'COMMON.VAR'
8642 include 'COMMON.GEO'
8643 include 'COMMON.FFIELD'
8644 double precision ggg1(3),ggg2(3)
8645 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8650 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8658 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8659 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8663 derx(lll,kkk,iii)=0.0d0
8667 cd eij=facont_hb(jj,i)
8668 cd ekl=facont_hb(kk,k)
8674 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8675 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8676 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8677 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8678 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8679 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8681 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8682 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8683 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8684 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8685 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8686 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8690 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8692 C If turn contributions are considered, they will be handled separately.
8693 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8694 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8695 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8696 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8697 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8698 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8699 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8701 if (j.lt.nres-1) then
8708 if (l.lt.nres-1) then
8716 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8717 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8718 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8719 cgrad ghalf=0.5d0*ggg1(ll)
8721 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8722 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8723 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8724 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8725 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8726 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8727 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8728 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8729 cgrad ghalf=0.5d0*ggg2(ll)
8730 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8732 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8733 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8734 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8735 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8736 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8737 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8742 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8743 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8748 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8749 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8755 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8760 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8764 cd write (2,*) iii,g_corr6_loc(iii)
8767 cd write (2,*) 'ekont',ekont
8768 cd write (iout,*) 'eello6',ekont*eel6
8771 c--------------------------------------------------------------------------
8772 double precision function eello6_graph1(i,j,k,l,imat,swap)
8773 implicit real*8 (a-h,o-z)
8774 include 'DIMENSIONS'
8775 include 'COMMON.IOUNITS'
8776 include 'COMMON.CHAIN'
8777 include 'COMMON.DERIV'
8778 include 'COMMON.INTERACT'
8779 include 'COMMON.CONTACTS'
8780 include 'COMMON.TORSION'
8781 include 'COMMON.VAR'
8782 include 'COMMON.GEO'
8783 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8787 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8789 C Parallel Antiparallel C
8795 C \ j|/k\| / \ |/k\|l / C
8800 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8801 itk=itortyp(itype(k))
8802 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8803 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8804 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8805 call transpose2(EUgC(1,1,k),auxmat(1,1))
8806 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8807 vv1(1)=pizda1(1,1)-pizda1(2,2)
8808 vv1(2)=pizda1(1,2)+pizda1(2,1)
8809 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8810 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8811 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8812 s5=scalar2(vv(1),Dtobr2(1,i))
8813 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8814 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8815 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8816 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8817 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8818 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8819 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8820 & +scalar2(vv(1),Dtobr2der(1,i)))
8821 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8822 vv1(1)=pizda1(1,1)-pizda1(2,2)
8823 vv1(2)=pizda1(1,2)+pizda1(2,1)
8824 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8825 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8827 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8828 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8829 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8830 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8831 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8833 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8834 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8835 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8836 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8837 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8839 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8840 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8841 vv1(1)=pizda1(1,1)-pizda1(2,2)
8842 vv1(2)=pizda1(1,2)+pizda1(2,1)
8843 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8844 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8845 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8846 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8855 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8856 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8857 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8858 call transpose2(EUgC(1,1,k),auxmat(1,1))
8859 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8861 vv1(1)=pizda1(1,1)-pizda1(2,2)
8862 vv1(2)=pizda1(1,2)+pizda1(2,1)
8863 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8864 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8865 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8866 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8867 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8868 s5=scalar2(vv(1),Dtobr2(1,i))
8869 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8875 c----------------------------------------------------------------------------
8876 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8877 implicit real*8 (a-h,o-z)
8878 include 'DIMENSIONS'
8879 include 'COMMON.IOUNITS'
8880 include 'COMMON.CHAIN'
8881 include 'COMMON.DERIV'
8882 include 'COMMON.INTERACT'
8883 include 'COMMON.CONTACTS'
8884 include 'COMMON.TORSION'
8885 include 'COMMON.VAR'
8886 include 'COMMON.GEO'
8888 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8889 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8892 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8894 C Parallel Antiparallel C
8900 C \ j|/k\| \ |/k\|l C
8905 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8906 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8907 C AL 7/4/01 s1 would occur in the sixth-order moment,
8908 C but not in a cluster cumulant
8910 s1=dip(1,jj,i)*dip(1,kk,k)
8912 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8913 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8914 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8915 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8916 call transpose2(EUg(1,1,k),auxmat(1,1))
8917 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8918 vv(1)=pizda(1,1)-pizda(2,2)
8919 vv(2)=pizda(1,2)+pizda(2,1)
8920 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8921 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8923 eello6_graph2=-(s1+s2+s3+s4)
8925 eello6_graph2=-(s2+s3+s4)
8928 C Derivatives in gamma(i-1)
8931 s1=dipderg(1,jj,i)*dip(1,kk,k)
8933 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8934 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8935 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8936 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8938 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8940 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8942 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8944 C Derivatives in gamma(k-1)
8946 s1=dip(1,jj,i)*dipderg(1,kk,k)
8948 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8949 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8950 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8951 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8952 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8953 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8954 vv(1)=pizda(1,1)-pizda(2,2)
8955 vv(2)=pizda(1,2)+pizda(2,1)
8956 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8958 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8960 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8962 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8963 C Derivatives in gamma(j-1) or gamma(l-1)
8966 s1=dipderg(3,jj,i)*dip(1,kk,k)
8968 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8969 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8970 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8971 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8972 vv(1)=pizda(1,1)-pizda(2,2)
8973 vv(2)=pizda(1,2)+pizda(2,1)
8974 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8977 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8979 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8982 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8983 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8985 C Derivatives in gamma(l-1) or gamma(j-1)
8988 s1=dip(1,jj,i)*dipderg(3,kk,k)
8990 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8991 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8992 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8993 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8994 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8995 vv(1)=pizda(1,1)-pizda(2,2)
8996 vv(2)=pizda(1,2)+pizda(2,1)
8997 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9000 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9002 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9005 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9006 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9008 C Cartesian derivatives.
9010 write (2,*) 'In eello6_graph2'
9012 write (2,*) 'iii=',iii
9014 write (2,*) 'kkk=',kkk
9016 write (2,'(3(2f10.5),5x)')
9017 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9027 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9029 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9032 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9034 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9035 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9037 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9038 call transpose2(EUg(1,1,k),auxmat(1,1))
9039 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9041 vv(1)=pizda(1,1)-pizda(2,2)
9042 vv(2)=pizda(1,2)+pizda(2,1)
9043 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9044 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9046 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9048 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9051 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9053 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9060 c----------------------------------------------------------------------------
9061 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9062 implicit real*8 (a-h,o-z)
9063 include 'DIMENSIONS'
9064 include 'COMMON.IOUNITS'
9065 include 'COMMON.CHAIN'
9066 include 'COMMON.DERIV'
9067 include 'COMMON.INTERACT'
9068 include 'COMMON.CONTACTS'
9069 include 'COMMON.TORSION'
9070 include 'COMMON.VAR'
9071 include 'COMMON.GEO'
9072 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9074 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9076 C Parallel Antiparallel C
9082 C j|/k\| / |/k\|l / C
9087 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9089 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9090 C energy moment and not to the cluster cumulant.
9091 iti=itortyp(itype(i))
9092 if (j.lt.nres-1) then
9093 itj1=itortyp(itype(j+1))
9097 itk=itortyp(itype(k))
9098 itk1=itortyp(itype(k+1))
9099 if (l.lt.nres-1) then
9100 itl1=itortyp(itype(l+1))
9105 s1=dip(4,jj,i)*dip(4,kk,k)
9107 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9108 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9109 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9110 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9111 call transpose2(EE(1,1,itk),auxmat(1,1))
9112 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9113 vv(1)=pizda(1,1)+pizda(2,2)
9114 vv(2)=pizda(2,1)-pizda(1,2)
9115 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9116 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9117 cd & "sum",-(s2+s3+s4)
9119 eello6_graph3=-(s1+s2+s3+s4)
9121 eello6_graph3=-(s2+s3+s4)
9124 C Derivatives in gamma(k-1)
9125 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9126 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9127 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9128 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9129 C Derivatives in gamma(l-1)
9130 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9131 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9132 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9133 vv(1)=pizda(1,1)+pizda(2,2)
9134 vv(2)=pizda(2,1)-pizda(1,2)
9135 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9136 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9137 C Cartesian derivatives.
9143 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9145 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9148 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9150 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9151 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9153 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9154 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9156 vv(1)=pizda(1,1)+pizda(2,2)
9157 vv(2)=pizda(2,1)-pizda(1,2)
9158 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9160 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9162 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9165 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9167 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9169 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9175 c----------------------------------------------------------------------------
9176 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9177 implicit real*8 (a-h,o-z)
9178 include 'DIMENSIONS'
9179 include 'COMMON.IOUNITS'
9180 include 'COMMON.CHAIN'
9181 include 'COMMON.DERIV'
9182 include 'COMMON.INTERACT'
9183 include 'COMMON.CONTACTS'
9184 include 'COMMON.TORSION'
9185 include 'COMMON.VAR'
9186 include 'COMMON.GEO'
9187 include 'COMMON.FFIELD'
9188 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9189 & auxvec1(2),auxmat1(2,2)
9191 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9193 C Parallel Antiparallel C
9199 C \ j|/k\| \ |/k\|l C
9204 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9206 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9207 C energy moment and not to the cluster cumulant.
9208 cd write (2,*) 'eello_graph4: wturn6',wturn6
9209 iti=itortyp(itype(i))
9210 itj=itortyp(itype(j))
9211 if (j.lt.nres-1) then
9212 itj1=itortyp(itype(j+1))
9216 itk=itortyp(itype(k))
9217 if (k.lt.nres-1) then
9218 itk1=itortyp(itype(k+1))
9222 itl=itortyp(itype(l))
9223 if (l.lt.nres-1) then
9224 itl1=itortyp(itype(l+1))
9228 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9229 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9230 cd & ' itl',itl,' itl1',itl1
9233 s1=dip(3,jj,i)*dip(3,kk,k)
9235 s1=dip(2,jj,j)*dip(2,kk,l)
9238 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9239 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9241 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9242 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9244 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9245 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9247 call transpose2(EUg(1,1,k),auxmat(1,1))
9248 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9249 vv(1)=pizda(1,1)-pizda(2,2)
9250 vv(2)=pizda(2,1)+pizda(1,2)
9251 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9252 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9254 eello6_graph4=-(s1+s2+s3+s4)
9256 eello6_graph4=-(s2+s3+s4)
9258 C Derivatives in gamma(i-1)
9262 s1=dipderg(2,jj,i)*dip(3,kk,k)
9264 s1=dipderg(4,jj,j)*dip(2,kk,l)
9267 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9269 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9270 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9272 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9273 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9275 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9276 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9277 cd write (2,*) 'turn6 derivatives'
9279 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9281 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9285 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9287 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9291 C Derivatives in gamma(k-1)
9294 s1=dip(3,jj,i)*dipderg(2,kk,k)
9296 s1=dip(2,jj,j)*dipderg(4,kk,l)
9299 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9300 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9302 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9303 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9305 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9306 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9308 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9309 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9310 vv(1)=pizda(1,1)-pizda(2,2)
9311 vv(2)=pizda(2,1)+pizda(1,2)
9312 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9313 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9315 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9317 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9321 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9323 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9326 C Derivatives in gamma(j-1) or gamma(l-1)
9327 if (l.eq.j+1 .and. l.gt.1) then
9328 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9329 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9330 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9331 vv(1)=pizda(1,1)-pizda(2,2)
9332 vv(2)=pizda(2,1)+pizda(1,2)
9333 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9334 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9335 else if (j.gt.1) then
9336 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9337 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9338 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9339 vv(1)=pizda(1,1)-pizda(2,2)
9340 vv(2)=pizda(2,1)+pizda(1,2)
9341 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9342 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9343 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9345 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9348 C Cartesian derivatives.
9355 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9357 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9361 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9363 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9367 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9369 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9371 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9372 & b1(1,j+1),auxvec(1))
9373 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9375 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9376 & b1(1,l+1),auxvec(1))
9377 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9379 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9381 vv(1)=pizda(1,1)-pizda(2,2)
9382 vv(2)=pizda(2,1)+pizda(1,2)
9383 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9385 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9387 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9390 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9393 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9396 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9398 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9400 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9404 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9406 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9409 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9411 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9419 c----------------------------------------------------------------------------
9420 double precision function eello_turn6(i,jj,kk)
9421 implicit real*8 (a-h,o-z)
9422 include 'DIMENSIONS'
9423 include 'COMMON.IOUNITS'
9424 include 'COMMON.CHAIN'
9425 include 'COMMON.DERIV'
9426 include 'COMMON.INTERACT'
9427 include 'COMMON.CONTACTS'
9428 include 'COMMON.TORSION'
9429 include 'COMMON.VAR'
9430 include 'COMMON.GEO'
9431 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9432 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9434 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9435 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9436 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9437 C the respective energy moment and not to the cluster cumulant.
9446 iti=itortyp(itype(i))
9447 itk=itortyp(itype(k))
9448 itk1=itortyp(itype(k+1))
9449 itl=itortyp(itype(l))
9450 itj=itortyp(itype(j))
9451 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9452 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9453 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9458 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9460 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9464 derx_turn(lll,kkk,iii)=0.0d0
9471 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9473 cd write (2,*) 'eello6_5',eello6_5
9475 call transpose2(AEA(1,1,1),auxmat(1,1))
9476 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9477 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9478 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9480 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9481 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9482 s2 = scalar2(b1(1,k),vtemp1(1))
9484 call transpose2(AEA(1,1,2),atemp(1,1))
9485 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9486 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9487 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9489 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9490 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9491 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9493 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9494 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9495 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9496 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9497 ss13 = scalar2(b1(1,k),vtemp4(1))
9498 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9500 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9506 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9507 C Derivatives in gamma(i+2)
9511 call transpose2(AEA(1,1,1),auxmatd(1,1))
9512 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9513 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9514 call transpose2(AEAderg(1,1,2),atempd(1,1))
9515 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9516 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9518 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9519 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9520 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9526 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9527 C Derivatives in gamma(i+3)
9529 call transpose2(AEA(1,1,1),auxmatd(1,1))
9530 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9531 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9532 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9534 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9535 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9536 s2d = scalar2(b1(1,k),vtemp1d(1))
9538 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9539 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9541 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9543 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9544 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9545 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9553 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9554 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9556 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9557 & -0.5d0*ekont*(s2d+s12d)
9559 C Derivatives in gamma(i+4)
9560 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9561 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9562 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9564 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9565 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9566 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9574 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9576 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9578 C Derivatives in gamma(i+5)
9580 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9581 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9582 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9584 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9585 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9586 s2d = scalar2(b1(1,k),vtemp1d(1))
9588 call transpose2(AEA(1,1,2),atempd(1,1))
9589 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9590 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9592 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9593 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9595 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9596 ss13d = scalar2(b1(1,k),vtemp4d(1))
9597 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9605 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9606 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9608 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9609 & -0.5d0*ekont*(s2d+s12d)
9611 C Cartesian derivatives
9616 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9617 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9618 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9620 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9621 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9623 s2d = scalar2(b1(1,k),vtemp1d(1))
9625 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9626 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9627 s8d = -(atempd(1,1)+atempd(2,2))*
9628 & scalar2(cc(1,1,itl),vtemp2(1))
9630 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9632 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9633 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9640 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9643 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9647 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9648 & - 0.5d0*(s8d+s12d)
9650 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9659 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9661 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9662 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9663 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9664 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9665 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9667 ss13d = scalar2(b1(1,k),vtemp4d(1))
9668 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9669 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9673 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9674 cd & 16*eel_turn6_num
9676 if (j.lt.nres-1) then
9683 if (l.lt.nres-1) then
9691 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9692 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9693 cgrad ghalf=0.5d0*ggg1(ll)
9695 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9696 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9697 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9698 & +ekont*derx_turn(ll,2,1)
9699 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9700 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9701 & +ekont*derx_turn(ll,4,1)
9702 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9703 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9704 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9705 cgrad ghalf=0.5d0*ggg2(ll)
9707 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9708 & +ekont*derx_turn(ll,2,2)
9709 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9710 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9711 & +ekont*derx_turn(ll,4,2)
9712 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9713 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9714 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9719 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9724 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9730 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9735 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9739 cd write (2,*) iii,g_corr6_loc(iii)
9741 eello_turn6=ekont*eel_turn6
9742 cd write (2,*) 'ekont',ekont
9743 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9747 C-----------------------------------------------------------------------------
9748 double precision function scalar(u,v)
9749 !DIR$ INLINEALWAYS scalar
9751 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9754 double precision u(3),v(3)
9755 cd double precision sc
9763 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9766 crc-------------------------------------------------
9767 SUBROUTINE MATVEC2(A1,V1,V2)
9768 !DIR$ INLINEALWAYS MATVEC2
9770 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9772 implicit real*8 (a-h,o-z)
9773 include 'DIMENSIONS'
9774 DIMENSION A1(2,2),V1(2),V2(2)
9778 c 3 VI=VI+A1(I,K)*V1(K)
9782 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9783 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9788 C---------------------------------------
9789 SUBROUTINE MATMAT2(A1,A2,A3)
9791 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9793 implicit real*8 (a-h,o-z)
9794 include 'DIMENSIONS'
9795 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9796 c DIMENSION AI3(2,2)
9800 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9806 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9807 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9808 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9809 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9817 c-------------------------------------------------------------------------
9818 double precision function scalar2(u,v)
9819 !DIR$ INLINEALWAYS scalar2
9821 double precision u(2),v(2)
9824 scalar2=u(1)*v(1)+u(2)*v(2)
9828 C-----------------------------------------------------------------------------
9830 subroutine transpose2(a,at)
9831 !DIR$ INLINEALWAYS transpose2
9833 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9836 double precision a(2,2),at(2,2)
9843 c--------------------------------------------------------------------------
9844 subroutine transpose(n,a,at)
9847 double precision a(n,n),at(n,n)
9855 C---------------------------------------------------------------------------
9856 subroutine prodmat3(a1,a2,kk,transp,prod)
9857 !DIR$ INLINEALWAYS prodmat3
9859 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9863 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9865 crc double precision auxmat(2,2),prod_(2,2)
9868 crc call transpose2(kk(1,1),auxmat(1,1))
9869 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9870 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9872 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9873 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9874 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9875 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9876 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9877 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9878 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9879 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9882 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9883 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9885 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9886 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9887 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9888 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9889 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9890 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9891 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9892 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9895 c call transpose2(a2(1,1),a2t(1,1))
9898 crc print *,((prod_(i,j),i=1,2),j=1,2)
9899 crc print *,((prod(i,j),i=1,2),j=1,2)