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.
60 C FG Master broadcasts the WEIGHTS_ array
61 call MPI_Bcast(weights_(1),n_ene,
62 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
64 C FG slaves receive the WEIGHTS array
65 call MPI_Bcast(weights(1),n_ene,
66 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
88 time_Bcast=time_Bcast+MPI_Wtime()-time00
89 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
90 c call chainbuild_cart
92 c print *,'Processor',myrank,' calling etotal ipot=',ipot
93 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
95 c if (modecalc.eq.12.or.modecalc.eq.14) then
96 c call int_from_cart1(.false.)
103 C Compute the side-chain and electrostatic interaction energy
106 goto (101,102,103,104,105,106) ipot
107 C Lennard-Jones potential.
109 cd print '(a)','Exit ELJ'
111 C Lennard-Jones-Kihara potential (shifted).
114 C Berne-Pechukas potential (dilated LJ, angular dependence).
117 C Gay-Berne potential (shifted LJ, angular dependence).
119 C print *,"bylem w egb"
121 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
124 C Soft-sphere potential
125 106 call e_softsphere(evdw)
127 C Calculate electrostatic (H-bonding) energy of the main chain.
131 cmc Sep-06: egb takes care of dynamic ss bonds too
133 c if (dyn_ss) call dyn_set_nss
135 c print *,"Processor",myrank," computed USCSC"
141 time_vec=time_vec+MPI_Wtime()-time01
143 C Introduction of shielding effect first for each peptide group
144 C the shielding factor is set this factor is describing how each
145 C peptide group is shielded by side-chains
146 C the matrix - shield_fac(i) the i index describe the ith between i and i+1
147 C write (iout,*) "shield_mode",shield_mode
148 if (shield_mode.eq.1) then
150 else if (shield_mode.eq.2) then
153 c print *,"Processor",myrank," left VEC_AND_DERIV"
156 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
157 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
158 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
159 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
161 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
162 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
163 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
164 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
166 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
175 write (iout,*) "Soft-spheer ELEC potential"
176 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
179 c print *,"Processor",myrank," computed UELEC"
181 C Calculate excluded-volume interaction energy between peptide groups
186 call escp(evdw2,evdw2_14)
192 c write (iout,*) "Soft-sphere SCP potential"
193 call escp_soft_sphere(evdw2,evdw2_14)
196 c Calculate the bond-stretching energy
200 C Calculate the disulfide-bridge and other energy and the contributions
201 C from other distance constraints.
202 cd print *,'Calling EHPB'
204 cd print *,'EHPB exitted succesfully.'
206 C Calculate the virtual-bond-angle energy.
208 if (wang.gt.0d0) then
209 if ((tor_mode.eq.0).or.(tor_mode.eq.2)) then
210 call ebend(ebe,ethetacnstr)
212 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
214 if ((tor_mode.eq.1).or.(tor_mode.eq.2)) then
215 call ebend_kcc(ebe,ethetacnstr)
221 c print *,"Processor",myrank," computed UB"
223 C Calculate the SC local energy.
225 C print *,"TU DOCHODZE?"
227 c print *,"Processor",myrank," computed USC"
229 C Calculate the virtual-bond torsional energy.
231 cd print *,'nterm=',nterm
232 C print *,"tor",tor_mode
234 if ((tor_mode.eq.0).or.(tor_mode.eq.2)) then
235 call etor(etors,edihcnstr)
237 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
239 if ((tor_mode.eq.1).or.(tor_mode.eq.2)) then
240 call etor_kcc(etors,edihcnstr)
246 c print *,"Processor",myrank," computed Utor"
248 C 6/23/01 Calculate double-torsional energy
250 if ((wtor_d.gt.0).and.((tor_mode.eq.0).or.(tor_mode.eq.2))) then
255 c print *,"Processor",myrank," computed Utord"
257 C 21/5/07 Calculate local sicdechain correlation energy
259 if (wsccor.gt.0.0d0) then
260 call eback_sc_corr(esccor)
264 C print *,"PRZED MULIt"
265 c print *,"Processor",myrank," computed Usccorr"
267 C 12/1/95 Multi-body terms
271 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
272 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
273 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
274 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
275 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
282 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
283 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
284 cd write (iout,*) "multibody_hb ecorr",ecorr
286 c print *,"Processor",myrank," computed Ucorr"
288 C If performing constraint dynamics, call the constraint energy
289 C after the equilibration time
290 if(usampl.and.totT.gt.eq_time) then
297 C 01/27/2015 added by adasko
298 C the energy component below is energy transfer into lipid environment
299 C based on partition function
300 C print *,"przed lipidami"
301 if (wliptran.gt.0) then
302 call Eliptransfer(eliptran)
304 C print *,"za lipidami"
305 if (AFMlog.gt.0) then
306 call AFMforce(Eafmforce)
307 else if (selfguide.gt.0) then
308 call AFMvel(Eafmforce)
310 if (TUBElog.gt.0) then
311 C print *,"just before call"
318 time_enecalc=time_enecalc+MPI_Wtime()-time00
320 c print *,"Processor",myrank," computed Uconstr"
329 energia(2)=evdw2-evdw2_14
346 energia(8)=eello_turn3
347 energia(9)=eello_turn4
354 energia(19)=edihcnstr
356 energia(20)=Uconst+Uconst_back
359 energia(23)=Eafmforce
360 energia(24)=ethetacnstr
362 c Here are the energies showed per procesor if the are more processors
363 c per molecule then we sum it up in sum_energy subroutine
364 c print *," Processor",myrank," calls SUM_ENERGY"
365 call sum_energy(energia,.true.)
366 if (dyn_ss) call dyn_set_nss
367 c print *," Processor",myrank," left SUM_ENERGY"
369 time_sumene=time_sumene+MPI_Wtime()-time00
373 c-------------------------------------------------------------------------------
374 subroutine sum_energy(energia,reduce)
375 implicit real*8 (a-h,o-z)
380 cMS$ATTRIBUTES C :: proc_proc
386 include 'COMMON.SETUP'
387 include 'COMMON.IOUNITS'
388 double precision energia(0:n_ene),enebuff(0:n_ene+1)
389 include 'COMMON.FFIELD'
390 include 'COMMON.DERIV'
391 include 'COMMON.INTERACT'
392 include 'COMMON.SBRIDGE'
393 include 'COMMON.CHAIN'
395 include 'COMMON.CONTROL'
396 include 'COMMON.TIME1'
399 if (nfgtasks.gt.1 .and. reduce) then
401 write (iout,*) "energies before REDUCE"
402 call enerprint(energia)
406 enebuff(i)=energia(i)
409 call MPI_Barrier(FG_COMM,IERR)
410 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
412 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
413 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
415 write (iout,*) "energies after REDUCE"
416 call enerprint(energia)
419 time_Reduce=time_Reduce+MPI_Wtime()-time00
421 if (fg_rank.eq.0) then
425 evdw2=energia(2)+energia(18)
441 eello_turn3=energia(8)
442 eello_turn4=energia(9)
449 edihcnstr=energia(19)
454 Eafmforce=energia(23)
455 ethetacnstr=energia(24)
458 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
459 & +wang*ebe+wtor*etors+wscloc*escloc
460 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
461 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
462 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
463 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+Eafmforce
464 & +ethetacnstr+wtube*Etube
466 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
467 & +wang*ebe+wtor*etors+wscloc*escloc
468 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
469 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
470 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
471 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
473 & +ethetacnstr+wtube*Etube
479 if (isnan(etot).ne.0) energia(0)=1.0d+99
481 if (isnan(etot)) energia(0)=1.0d+99
486 idumm=proc_proc(etot,i)
488 call proc_proc(etot,i)
490 if(i.eq.1)energia(0)=1.0d+99
497 c-------------------------------------------------------------------------------
498 subroutine sum_gradient
499 implicit real*8 (a-h,o-z)
504 cMS$ATTRIBUTES C :: proc_proc
510 double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
511 & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
512 & ,gloc_scbuf(3,-1:maxres)
513 include 'COMMON.SETUP'
514 include 'COMMON.IOUNITS'
515 include 'COMMON.FFIELD'
516 include 'COMMON.DERIV'
517 include 'COMMON.INTERACT'
518 include 'COMMON.SBRIDGE'
519 include 'COMMON.CHAIN'
521 include 'COMMON.CONTROL'
522 include 'COMMON.TIME1'
523 include 'COMMON.MAXGRAD'
524 include 'COMMON.SCCOR'
529 write (iout,*) "sum_gradient gvdwc, gvdwx"
531 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
532 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
537 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
538 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
539 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
542 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
543 C in virtual-bond-vector coordinates
546 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
548 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
549 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
551 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
553 c write (iout,'(i5,3f10.5,2x,f10.5)')
554 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
556 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
558 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
559 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
567 gradbufc(j,i)=wsc*gvdwc(j,i)+
568 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
569 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
570 & wel_loc*gel_loc_long(j,i)+
571 & wcorr*gradcorr_long(j,i)+
572 & wcorr5*gradcorr5_long(j,i)+
573 & wcorr6*gradcorr6_long(j,i)+
574 & wturn6*gcorr6_turn_long(j,i)+
576 & +wliptran*gliptranc(j,i)
578 & +welec*gshieldc(j,i)
579 & +wcorr*gshieldc_ec(j,i)
580 & +wturn3*gshieldc_t3(j,i)
581 & +wturn4*gshieldc_t4(j,i)
582 & +wel_loc*gshieldc_ll(j,i)
583 & +wtube*gg_tube(j,i)
592 gradbufc(j,i)=wsc*gvdwc(j,i)+
593 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
594 & welec*gelc_long(j,i)+
596 & wel_loc*gel_loc_long(j,i)+
597 & wcorr*gradcorr_long(j,i)+
598 & wcorr5*gradcorr5_long(j,i)+
599 & wcorr6*gradcorr6_long(j,i)+
600 & wturn6*gcorr6_turn_long(j,i)+
602 & +wliptran*gliptranc(j,i)
604 & +welec*gshieldc(j,i)
605 & +wcorr*gshieldc_ec(j,i)
606 & +wturn4*gshieldc_t4(j,i)
607 & +wel_loc*gshieldc_ll(j,i)
608 & +wtube*gg_tube(j,i)
616 if (nfgtasks.gt.1) then
619 write (iout,*) "gradbufc before allreduce"
621 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
627 gradbufc_sum(j,i)=gradbufc(j,i)
630 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
631 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
632 c time_reduce=time_reduce+MPI_Wtime()-time00
634 c write (iout,*) "gradbufc_sum after allreduce"
636 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
641 c time_allreduce=time_allreduce+MPI_Wtime()-time00
649 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
650 write (iout,*) (i," jgrad_start",jgrad_start(i),
651 & " jgrad_end ",jgrad_end(i),
652 & i=igrad_start,igrad_end)
655 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
656 c do not parallelize this part.
658 c do i=igrad_start,igrad_end
659 c do j=jgrad_start(i),jgrad_end(i)
661 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
666 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
670 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
674 write (iout,*) "gradbufc after summing"
676 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
683 write (iout,*) "gradbufc"
685 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
691 gradbufc_sum(j,i)=gradbufc(j,i)
696 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
700 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
705 c gradbufc(k,i)=0.0d0
709 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
714 write (iout,*) "gradbufc after summing"
716 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
724 gradbufc(k,nres)=0.0d0
729 C print *,gradbufc(1,13)
730 C print *,welec*gelc(1,13)
731 C print *,wel_loc*gel_loc(1,13)
732 C print *,0.5d0*(wscp*gvdwc_scpp(1,13))
733 C print *,welec*gelc_long(1,13)+wvdwpp*gvdwpp(1,13)
734 C print *,wel_loc*gel_loc_long(1,13)
735 C print *,gradafm(1,13),"AFM"
736 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
737 & wel_loc*gel_loc(j,i)+
738 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
739 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
740 & wel_loc*gel_loc_long(j,i)+
741 & wcorr*gradcorr_long(j,i)+
742 & wcorr5*gradcorr5_long(j,i)+
743 & wcorr6*gradcorr6_long(j,i)+
744 & wturn6*gcorr6_turn_long(j,i))+
746 & wcorr*gradcorr(j,i)+
747 & wturn3*gcorr3_turn(j,i)+
748 & wturn4*gcorr4_turn(j,i)+
749 & wcorr5*gradcorr5(j,i)+
750 & wcorr6*gradcorr6(j,i)+
751 & wturn6*gcorr6_turn(j,i)+
752 & wsccor*gsccorc(j,i)
753 & +wscloc*gscloc(j,i)
754 & +wliptran*gliptranc(j,i)
756 & +welec*gshieldc(j,i)
757 & +welec*gshieldc_loc(j,i)
758 & +wcorr*gshieldc_ec(j,i)
759 & +wcorr*gshieldc_loc_ec(j,i)
760 & +wturn3*gshieldc_t3(j,i)
761 & +wturn3*gshieldc_loc_t3(j,i)
762 & +wturn4*gshieldc_t4(j,i)
763 & +wturn4*gshieldc_loc_t4(j,i)
764 & +wel_loc*gshieldc_ll(j,i)
765 & +wel_loc*gshieldc_loc_ll(j,i)
766 & +wtube*gg_tube(j,i)
769 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
770 & wel_loc*gel_loc(j,i)+
771 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
772 & welec*gelc_long(j,i)+
773 & wel_loc*gel_loc_long(j,i)+
774 & wcorr*gcorr_long(j,i)+
775 & wcorr5*gradcorr5_long(j,i)+
776 & wcorr6*gradcorr6_long(j,i)+
777 & wturn6*gcorr6_turn_long(j,i))+
779 & wcorr*gradcorr(j,i)+
780 & wturn3*gcorr3_turn(j,i)+
781 & wturn4*gcorr4_turn(j,i)+
782 & wcorr5*gradcorr5(j,i)+
783 & wcorr6*gradcorr6(j,i)+
784 & wturn6*gcorr6_turn(j,i)+
785 & wsccor*gsccorc(j,i)
786 & +wscloc*gscloc(j,i)
787 & +wliptran*gliptranc(j,i)
789 & +welec*gshieldc(j,i)
790 & +welec*gshieldc_loc(j,i)
791 & +wcorr*gshieldc_ec(j,i)
792 & +wcorr*gshieldc_loc_ec(j,i)
793 & +wturn3*gshieldc_t3(j,i)
794 & +wturn3*gshieldc_loc_t3(j,i)
795 & +wturn4*gshieldc_t4(j,i)
796 & +wturn4*gshieldc_loc_t4(j,i)
797 & +wel_loc*gshieldc_ll(j,i)
798 & +wel_loc*gshieldc_loc_ll(j,i)
799 & +wtube*gg_tube(j,i)
803 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
805 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
806 & wsccor*gsccorx(j,i)
807 & +wscloc*gsclocx(j,i)
808 & +wliptran*gliptranx(j,i)
809 & +welec*gshieldx(j,i)
810 & +wcorr*gshieldx_ec(j,i)
811 & +wturn3*gshieldx_t3(j,i)
812 & +wturn4*gshieldx_t4(j,i)
813 & +wel_loc*gshieldx_ll(j,i)
814 & +wtube*gg_tube_sc(j,i)
821 write (iout,*) "gloc before adding corr"
823 write (iout,*) i,gloc(i,icg)
827 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
828 & +wcorr5*g_corr5_loc(i)
829 & +wcorr6*g_corr6_loc(i)
830 & +wturn4*gel_loc_turn4(i)
831 & +wturn3*gel_loc_turn3(i)
832 & +wturn6*gel_loc_turn6(i)
833 & +wel_loc*gel_loc_loc(i)
836 write (iout,*) "gloc after adding corr"
838 write (iout,*) i,gloc(i,icg)
842 if (nfgtasks.gt.1) then
845 gradbufc(j,i)=gradc(j,i,icg)
846 gradbufx(j,i)=gradx(j,i,icg)
850 glocbuf(i)=gloc(i,icg)
854 write (iout,*) "gloc_sc before reduce"
857 write (iout,*) i,j,gloc_sc(j,i,icg)
864 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
868 call MPI_Barrier(FG_COMM,IERR)
869 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
871 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
872 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
873 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
874 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
875 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
876 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
877 time_reduce=time_reduce+MPI_Wtime()-time00
878 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
879 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
880 time_reduce=time_reduce+MPI_Wtime()-time00
883 write (iout,*) "gloc_sc after reduce"
886 write (iout,*) i,j,gloc_sc(j,i,icg)
892 write (iout,*) "gloc after reduce"
894 write (iout,*) i,gloc(i,icg)
899 if (gnorm_check) then
901 c Compute the maximum elements of the gradient
911 gcorr3_turn_max=0.0d0
912 gcorr4_turn_max=0.0d0
915 gcorr6_turn_max=0.0d0
925 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
926 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
927 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
928 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
929 & gvdwc_scp_max=gvdwc_scp_norm
930 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
931 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
932 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
933 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
934 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
935 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
936 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
937 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
938 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
939 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
940 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
941 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
942 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
944 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
945 & gcorr3_turn_max=gcorr3_turn_norm
946 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
948 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
949 & gcorr4_turn_max=gcorr4_turn_norm
950 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
951 if (gradcorr5_norm.gt.gradcorr5_max)
952 & gradcorr5_max=gradcorr5_norm
953 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
954 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
955 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
957 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
958 & gcorr6_turn_max=gcorr6_turn_norm
959 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
960 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
961 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
962 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
963 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
964 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
965 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
966 if (gradx_scp_norm.gt.gradx_scp_max)
967 & gradx_scp_max=gradx_scp_norm
968 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
969 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
970 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
971 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
972 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
973 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
974 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
975 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
979 open(istat,file=statname,position="append")
981 open(istat,file=statname,access="append")
983 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
984 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
985 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
986 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
987 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
988 & gsccorx_max,gsclocx_max
990 if (gvdwc_max.gt.1.0d4) then
991 write (iout,*) "gvdwc gvdwx gradb gradbx"
993 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
994 & gradb(j,i),gradbx(j,i),j=1,3)
996 call pdbout(0.0d0,'cipiszcze',iout)
1002 write (iout,*) "gradc gradx gloc"
1004 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
1005 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
1009 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
1013 c-------------------------------------------------------------------------------
1014 subroutine rescale_weights(t_bath)
1015 implicit real*8 (a-h,o-z)
1016 include 'DIMENSIONS'
1017 include 'COMMON.IOUNITS'
1018 include 'COMMON.FFIELD'
1019 include 'COMMON.SBRIDGE'
1020 include 'COMMON.CONTROL'
1021 double precision kfac /2.4d0/
1022 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
1024 c facT=2*temp0/(t_bath+temp0)
1025 if (rescale_mode.eq.0) then
1031 else if (rescale_mode.eq.1) then
1032 facT=kfac/(kfac-1.0d0+t_bath/temp0)
1033 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1034 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1035 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1036 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1037 else if (rescale_mode.eq.2) then
1043 facT=licznik/dlog(dexp(x)+dexp(-x))
1044 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
1045 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
1046 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
1047 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
1049 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1050 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1052 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1056 if (shield_mode.gt.0) then
1057 wscp=weights(2)*fact
1059 wvdwpp=weights(16)*fact
1061 welec=weights(3)*fact
1062 wcorr=weights(4)*fact3
1063 wcorr5=weights(5)*fact4
1064 wcorr6=weights(6)*fact5
1065 wel_loc=weights(7)*fact2
1066 wturn3=weights(8)*fact2
1067 wturn4=weights(9)*fact3
1068 wturn6=weights(10)*fact5
1069 wtor=weights(13)*fact
1070 wtor_d=weights(14)*fact2
1071 wsccor=weights(21)*fact
1075 C------------------------------------------------------------------------
1076 subroutine enerprint(energia)
1077 implicit real*8 (a-h,o-z)
1078 include 'DIMENSIONS'
1079 include 'COMMON.IOUNITS'
1080 include 'COMMON.FFIELD'
1081 include 'COMMON.SBRIDGE'
1083 double precision energia(0:n_ene)
1088 evdw2=energia(2)+energia(18)
1100 eello_turn3=energia(8)
1101 eello_turn4=energia(9)
1102 eello_turn6=energia(10)
1108 edihcnstr=energia(19)
1112 eliptran=energia(22)
1113 Eafmforce=energia(23)
1114 ethetacnstr=energia(24)
1117 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1118 & estr,wbond,ebe,wang,
1119 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1121 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1122 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,
1123 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1126 10 format (/'Virtual-chain energies:'//
1127 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1128 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1129 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1130 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1131 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1132 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1133 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1134 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1135 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1136 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1137 & ' (SS bridges & dist. cnstr.)'/
1138 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1139 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1140 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1141 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1142 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1143 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1144 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1145 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1146 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1147 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1148 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1149 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1150 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1151 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1152 & 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/
1153 & 'ETOT= ',1pE16.6,' (total)')
1156 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1157 & estr,wbond,ebe,wang,
1158 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1160 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1161 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1162 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1165 10 format (/'Virtual-chain energies:'//
1166 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1167 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1168 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1169 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1170 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1171 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1172 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1173 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1174 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1175 & ' (SS bridges & dist. cnstr.)'/
1176 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1177 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1178 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1179 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1180 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1181 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1182 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1183 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1184 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1185 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1186 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1187 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1188 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1189 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1190 & 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/
1191 & 'ETOT= ',1pE16.6,' (total)')
1195 C-----------------------------------------------------------------------
1196 subroutine elj(evdw)
1198 C This subroutine calculates the interaction energy of nonbonded side chains
1199 C assuming the LJ potential of interaction.
1201 implicit real*8 (a-h,o-z)
1202 include 'DIMENSIONS'
1203 parameter (accur=1.0d-10)
1204 include 'COMMON.GEO'
1205 include 'COMMON.VAR'
1206 include 'COMMON.LOCAL'
1207 include 'COMMON.CHAIN'
1208 include 'COMMON.DERIV'
1209 include 'COMMON.INTERACT'
1210 include 'COMMON.TORSION'
1211 include 'COMMON.SBRIDGE'
1212 include 'COMMON.NAMES'
1213 include 'COMMON.IOUNITS'
1214 include 'COMMON.CONTACTS'
1216 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1218 do i=iatsc_s,iatsc_e
1219 itypi=iabs(itype(i))
1220 if (itypi.eq.ntyp1) cycle
1221 itypi1=iabs(itype(i+1))
1228 C Calculate SC interaction energy.
1230 do iint=1,nint_gr(i)
1231 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1232 cd & 'iend=',iend(i,iint)
1233 do j=istart(i,iint),iend(i,iint)
1234 itypj=iabs(itype(j))
1235 if (itypj.eq.ntyp1) cycle
1239 C Change 12/1/95 to calculate four-body interactions
1240 rij=xj*xj+yj*yj+zj*zj
1242 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1243 eps0ij=eps(itypi,itypj)
1245 C have you changed here?
1249 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1250 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1251 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1252 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1253 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1254 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1257 C Calculate the components of the gradient in DC and X
1259 fac=-rrij*(e1+evdwij)
1264 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1265 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1266 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1267 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1271 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1275 C 12/1/95, revised on 5/20/97
1277 C Calculate the contact function. The ith column of the array JCONT will
1278 C contain the numbers of atoms that make contacts with the atom I (of numbers
1279 C greater than I). The arrays FACONT and GACONT will contain the values of
1280 C the contact function and its derivative.
1282 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1283 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1284 C Uncomment next line, if the correlation interactions are contact function only
1285 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1287 sigij=sigma(itypi,itypj)
1288 r0ij=rs0(itypi,itypj)
1290 C Check whether the SC's are not too far to make a contact.
1293 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1294 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1296 if (fcont.gt.0.0D0) then
1297 C If the SC-SC distance if close to sigma, apply spline.
1298 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1299 cAdam & fcont1,fprimcont1)
1300 cAdam fcont1=1.0d0-fcont1
1301 cAdam if (fcont1.gt.0.0d0) then
1302 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1303 cAdam fcont=fcont*fcont1
1305 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1306 cga eps0ij=1.0d0/dsqrt(eps0ij)
1308 cga gg(k)=gg(k)*eps0ij
1310 cga eps0ij=-evdwij*eps0ij
1311 C Uncomment for AL's type of SC correlation interactions.
1312 cadam eps0ij=-evdwij
1313 num_conti=num_conti+1
1314 jcont(num_conti,i)=j
1315 facont(num_conti,i)=fcont*eps0ij
1316 fprimcont=eps0ij*fprimcont/rij
1318 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1319 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1320 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1321 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1322 gacont(1,num_conti,i)=-fprimcont*xj
1323 gacont(2,num_conti,i)=-fprimcont*yj
1324 gacont(3,num_conti,i)=-fprimcont*zj
1325 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1326 cd write (iout,'(2i3,3f10.5)')
1327 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1333 num_cont(i)=num_conti
1337 gvdwc(j,i)=expon*gvdwc(j,i)
1338 gvdwx(j,i)=expon*gvdwx(j,i)
1341 C******************************************************************************
1345 C To save time, the factor of EXPON has been extracted from ALL components
1346 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1349 C******************************************************************************
1352 C-----------------------------------------------------------------------------
1353 subroutine eljk(evdw)
1355 C This subroutine calculates the interaction energy of nonbonded side chains
1356 C assuming the LJK potential of interaction.
1358 implicit real*8 (a-h,o-z)
1359 include 'DIMENSIONS'
1360 include 'COMMON.GEO'
1361 include 'COMMON.VAR'
1362 include 'COMMON.LOCAL'
1363 include 'COMMON.CHAIN'
1364 include 'COMMON.DERIV'
1365 include 'COMMON.INTERACT'
1366 include 'COMMON.IOUNITS'
1367 include 'COMMON.NAMES'
1370 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1372 do i=iatsc_s,iatsc_e
1373 itypi=iabs(itype(i))
1374 if (itypi.eq.ntyp1) cycle
1375 itypi1=iabs(itype(i+1))
1380 C Calculate SC interaction energy.
1382 do iint=1,nint_gr(i)
1383 do j=istart(i,iint),iend(i,iint)
1384 itypj=iabs(itype(j))
1385 if (itypj.eq.ntyp1) cycle
1389 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1390 fac_augm=rrij**expon
1391 e_augm=augm(itypi,itypj)*fac_augm
1392 r_inv_ij=dsqrt(rrij)
1394 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1395 fac=r_shift_inv**expon
1396 C have you changed here?
1400 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1401 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1402 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1403 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1404 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1405 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1406 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1409 C Calculate the components of the gradient in DC and X
1411 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1416 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1417 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1418 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1419 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1423 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1431 gvdwc(j,i)=expon*gvdwc(j,i)
1432 gvdwx(j,i)=expon*gvdwx(j,i)
1437 C-----------------------------------------------------------------------------
1438 subroutine ebp(evdw)
1440 C This subroutine calculates the interaction energy of nonbonded side chains
1441 C assuming the Berne-Pechukas potential of interaction.
1443 implicit real*8 (a-h,o-z)
1444 include 'DIMENSIONS'
1445 include 'COMMON.GEO'
1446 include 'COMMON.VAR'
1447 include 'COMMON.LOCAL'
1448 include 'COMMON.CHAIN'
1449 include 'COMMON.DERIV'
1450 include 'COMMON.NAMES'
1451 include 'COMMON.INTERACT'
1452 include 'COMMON.IOUNITS'
1453 include 'COMMON.CALC'
1454 common /srutu/ icall
1455 c double precision rrsave(maxdim)
1458 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1460 c if (icall.eq.0) then
1466 do i=iatsc_s,iatsc_e
1467 itypi=iabs(itype(i))
1468 if (itypi.eq.ntyp1) cycle
1469 itypi1=iabs(itype(i+1))
1473 dxi=dc_norm(1,nres+i)
1474 dyi=dc_norm(2,nres+i)
1475 dzi=dc_norm(3,nres+i)
1476 c dsci_inv=dsc_inv(itypi)
1477 dsci_inv=vbld_inv(i+nres)
1479 C Calculate SC interaction energy.
1481 do iint=1,nint_gr(i)
1482 do j=istart(i,iint),iend(i,iint)
1484 itypj=iabs(itype(j))
1485 if (itypj.eq.ntyp1) cycle
1486 c dscj_inv=dsc_inv(itypj)
1487 dscj_inv=vbld_inv(j+nres)
1488 chi1=chi(itypi,itypj)
1489 chi2=chi(itypj,itypi)
1496 alf12=0.5D0*(alf1+alf2)
1497 C For diagnostics only!!!
1510 dxj=dc_norm(1,nres+j)
1511 dyj=dc_norm(2,nres+j)
1512 dzj=dc_norm(3,nres+j)
1513 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1514 cd if (icall.eq.0) then
1520 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1522 C Calculate whole angle-dependent part of epsilon and contributions
1523 C to its derivatives
1524 C have you changed here?
1525 fac=(rrij*sigsq)**expon2
1528 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1529 eps2der=evdwij*eps3rt
1530 eps3der=evdwij*eps2rt
1531 evdwij=evdwij*eps2rt*eps3rt
1534 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1536 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1537 cd & restyp(itypi),i,restyp(itypj),j,
1538 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1539 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1540 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1543 C Calculate gradient components.
1544 e1=e1*eps1*eps2rt**2*eps3rt**2
1545 fac=-expon*(e1+evdwij)
1548 C Calculate radial part of the gradient
1552 C Calculate the angular part of the gradient and sum add the contributions
1553 C to the appropriate components of the Cartesian gradient.
1561 C-----------------------------------------------------------------------------
1562 subroutine egb(evdw)
1564 C This subroutine calculates the interaction energy of nonbonded side chains
1565 C assuming the Gay-Berne potential of interaction.
1567 implicit real*8 (a-h,o-z)
1568 include 'DIMENSIONS'
1569 include 'COMMON.GEO'
1570 include 'COMMON.VAR'
1571 include 'COMMON.LOCAL'
1572 include 'COMMON.CHAIN'
1573 include 'COMMON.DERIV'
1574 include 'COMMON.NAMES'
1575 include 'COMMON.INTERACT'
1576 include 'COMMON.IOUNITS'
1577 include 'COMMON.CALC'
1578 include 'COMMON.CONTROL'
1579 include 'COMMON.SPLITELE'
1580 include 'COMMON.SBRIDGE'
1582 integer xshift,yshift,zshift
1585 ccccc energy_dec=.false.
1586 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1589 c if (icall.eq.0) lprn=.false.
1591 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1592 C we have the original box)
1596 do i=iatsc_s,iatsc_e
1597 itypi=iabs(itype(i))
1598 if (itypi.eq.ntyp1) cycle
1599 itypi1=iabs(itype(i+1))
1603 C Return atom into box, boxxsize is size of box in x dimension
1605 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1606 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1607 C Condition for being inside the proper box
1608 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1609 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1613 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1614 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1615 C Condition for being inside the proper box
1616 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1617 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1621 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1622 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1623 C Condition for being inside the proper box
1624 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1625 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1629 if (xi.lt.0) xi=xi+boxxsize
1631 if (yi.lt.0) yi=yi+boxysize
1633 if (zi.lt.0) zi=zi+boxzsize
1634 C define scaling factor for lipids
1636 C if (positi.le.0) positi=positi+boxzsize
1638 C first for peptide groups
1639 c for each residue check if it is in lipid or lipid water border area
1640 if ((zi.gt.bordlipbot)
1641 &.and.(zi.lt.bordliptop)) then
1642 C the energy transfer exist
1643 if (zi.lt.buflipbot) then
1644 C what fraction I am in
1646 & ((zi-bordlipbot)/lipbufthick)
1647 C lipbufthick is thickenes of lipid buffore
1648 sslipi=sscalelip(fracinbuf)
1649 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1650 elseif (zi.gt.bufliptop) then
1651 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1652 sslipi=sscalelip(fracinbuf)
1653 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1663 C xi=xi+xshift*boxxsize
1664 C yi=yi+yshift*boxysize
1665 C zi=zi+zshift*boxzsize
1667 dxi=dc_norm(1,nres+i)
1668 dyi=dc_norm(2,nres+i)
1669 dzi=dc_norm(3,nres+i)
1670 c dsci_inv=dsc_inv(itypi)
1671 dsci_inv=vbld_inv(i+nres)
1672 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1673 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1675 C Calculate SC interaction energy.
1677 do iint=1,nint_gr(i)
1678 do j=istart(i,iint),iend(i,iint)
1679 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1681 c write(iout,*) "PRZED ZWYKLE", evdwij
1682 call dyn_ssbond_ene(i,j,evdwij)
1683 c write(iout,*) "PO ZWYKLE", evdwij
1686 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1687 & 'evdw',i,j,evdwij,' ss'
1688 C triple bond artifac removal
1689 do k=j+1,iend(i,iint)
1690 C search over all next residues
1691 if (dyn_ss_mask(k)) then
1692 C check if they are cysteins
1693 C write(iout,*) 'k=',k
1695 c write(iout,*) "PRZED TRI", evdwij
1696 evdwij_przed_tri=evdwij
1697 call triple_ssbond_ene(i,j,k,evdwij)
1698 c if(evdwij_przed_tri.ne.evdwij) then
1699 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1702 c write(iout,*) "PO TRI", evdwij
1703 C call the energy function that removes the artifical triple disulfide
1704 C bond the soubroutine is located in ssMD.F
1706 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1707 & 'evdw',i,j,evdwij,'tss'
1708 endif!dyn_ss_mask(k)
1712 itypj=iabs(itype(j))
1713 if (itypj.eq.ntyp1) cycle
1714 c dscj_inv=dsc_inv(itypj)
1715 dscj_inv=vbld_inv(j+nres)
1716 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1717 c & 1.0d0/vbld(j+nres)
1718 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1719 sig0ij=sigma(itypi,itypj)
1720 chi1=chi(itypi,itypj)
1721 chi2=chi(itypj,itypi)
1728 alf12=0.5D0*(alf1+alf2)
1729 C For diagnostics only!!!
1742 C Return atom J into box the original box
1744 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1745 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1746 C Condition for being inside the proper box
1747 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1748 c & (xj.lt.((-0.5d0)*boxxsize))) then
1752 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1753 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1754 C Condition for being inside the proper box
1755 c if ((yj.gt.((0.5d0)*boxysize)).or.
1756 c & (yj.lt.((-0.5d0)*boxysize))) then
1760 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1761 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1762 C Condition for being inside the proper box
1763 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1764 c & (zj.lt.((-0.5d0)*boxzsize))) then
1768 if (xj.lt.0) xj=xj+boxxsize
1770 if (yj.lt.0) yj=yj+boxysize
1772 if (zj.lt.0) zj=zj+boxzsize
1773 if ((zj.gt.bordlipbot)
1774 &.and.(zj.lt.bordliptop)) then
1775 C the energy transfer exist
1776 if (zj.lt.buflipbot) then
1777 C what fraction I am in
1779 & ((zj-bordlipbot)/lipbufthick)
1780 C lipbufthick is thickenes of lipid buffore
1781 sslipj=sscalelip(fracinbuf)
1782 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1783 elseif (zj.gt.bufliptop) then
1784 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1785 sslipj=sscalelip(fracinbuf)
1786 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1795 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1796 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1797 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1798 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1799 C write(iout,*) "tu,", i,j,aa_lip(itypi,itypj),bb_lip(itypi,itypj)
1800 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1801 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1802 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1803 C print *,sslipi,sslipj,bordlipbot,zi,zj
1804 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1812 xj=xj_safe+xshift*boxxsize
1813 yj=yj_safe+yshift*boxysize
1814 zj=zj_safe+zshift*boxzsize
1815 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1816 if(dist_temp.lt.dist_init) then
1826 if (subchap.eq.1) then
1835 dxj=dc_norm(1,nres+j)
1836 dyj=dc_norm(2,nres+j)
1837 dzj=dc_norm(3,nres+j)
1841 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1842 c write (iout,*) "j",j," dc_norm",
1843 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1844 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1846 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1847 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1849 c write (iout,'(a7,4f8.3)')
1850 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1851 if (sss.gt.0.0d0) then
1852 C Calculate angle-dependent terms of energy and contributions to their
1856 sig=sig0ij*dsqrt(sigsq)
1857 rij_shift=1.0D0/rij-sig+sig0ij
1858 c for diagnostics; uncomment
1859 c rij_shift=1.2*sig0ij
1860 C I hate to put IF's in the loops, but here don't have another choice!!!!
1861 if (rij_shift.le.0.0D0) then
1863 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1864 cd & restyp(itypi),i,restyp(itypj),j,
1865 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1869 c---------------------------------------------------------------
1870 rij_shift=1.0D0/rij_shift
1871 fac=rij_shift**expon
1872 C here to start with
1877 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1878 eps2der=evdwij*eps3rt
1879 eps3der=evdwij*eps2rt
1880 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1881 C &((sslipi+sslipj)/2.0d0+
1882 C &(2.0d0-sslipi-sslipj)/2.0d0)
1883 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1884 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1885 evdwij=evdwij*eps2rt*eps3rt
1886 evdw=evdw+evdwij*sss
1888 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1890 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1891 & restyp(itypi),i,restyp(itypj),j,
1892 & epsi,sigm,chi1,chi2,chip1,chip2,
1893 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1894 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1898 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1901 C Calculate gradient components.
1902 e1=e1*eps1*eps2rt**2*eps3rt**2
1903 fac=-expon*(e1+evdwij)*rij_shift
1906 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1907 c & evdwij,fac,sigma(itypi,itypj),expon
1908 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1910 C Calculate the radial part of the gradient
1911 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1912 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1913 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1914 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1915 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1916 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1922 C Calculate angular part of the gradient.
1932 c write (iout,*) "Number of loop steps in EGB:",ind
1933 cccc energy_dec=.false.
1936 C-----------------------------------------------------------------------------
1937 subroutine egbv(evdw)
1939 C This subroutine calculates the interaction energy of nonbonded side chains
1940 C assuming the Gay-Berne-Vorobjev potential of interaction.
1942 implicit real*8 (a-h,o-z)
1943 include 'DIMENSIONS'
1944 include 'COMMON.GEO'
1945 include 'COMMON.VAR'
1946 include 'COMMON.LOCAL'
1947 include 'COMMON.CHAIN'
1948 include 'COMMON.DERIV'
1949 include 'COMMON.NAMES'
1950 include 'COMMON.INTERACT'
1951 include 'COMMON.IOUNITS'
1952 include 'COMMON.CALC'
1953 common /srutu/ icall
1956 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1959 c if (icall.eq.0) lprn=.true.
1961 do i=iatsc_s,iatsc_e
1962 itypi=iabs(itype(i))
1963 if (itypi.eq.ntyp1) cycle
1964 itypi1=iabs(itype(i+1))
1969 if (xi.lt.0) xi=xi+boxxsize
1971 if (yi.lt.0) yi=yi+boxysize
1973 if (zi.lt.0) zi=zi+boxzsize
1974 C define scaling factor for lipids
1976 C if (positi.le.0) positi=positi+boxzsize
1978 C first for peptide groups
1979 c for each residue check if it is in lipid or lipid water border area
1980 if ((zi.gt.bordlipbot)
1981 &.and.(zi.lt.bordliptop)) then
1982 C the energy transfer exist
1983 if (zi.lt.buflipbot) then
1984 C what fraction I am in
1986 & ((zi-bordlipbot)/lipbufthick)
1987 C lipbufthick is thickenes of lipid buffore
1988 sslipi=sscalelip(fracinbuf)
1989 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1990 elseif (zi.gt.bufliptop) then
1991 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1992 sslipi=sscalelip(fracinbuf)
1993 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
2003 dxi=dc_norm(1,nres+i)
2004 dyi=dc_norm(2,nres+i)
2005 dzi=dc_norm(3,nres+i)
2006 c dsci_inv=dsc_inv(itypi)
2007 dsci_inv=vbld_inv(i+nres)
2009 C Calculate SC interaction energy.
2011 do iint=1,nint_gr(i)
2012 do j=istart(i,iint),iend(i,iint)
2014 itypj=iabs(itype(j))
2015 if (itypj.eq.ntyp1) cycle
2016 c dscj_inv=dsc_inv(itypj)
2017 dscj_inv=vbld_inv(j+nres)
2018 sig0ij=sigma(itypi,itypj)
2019 r0ij=r0(itypi,itypj)
2020 chi1=chi(itypi,itypj)
2021 chi2=chi(itypj,itypi)
2028 alf12=0.5D0*(alf1+alf2)
2029 C For diagnostics only!!!
2043 if (xj.lt.0) xj=xj+boxxsize
2045 if (yj.lt.0) yj=yj+boxysize
2047 if (zj.lt.0) zj=zj+boxzsize
2048 if ((zj.gt.bordlipbot)
2049 &.and.(zj.lt.bordliptop)) then
2050 C the energy transfer exist
2051 if (zj.lt.buflipbot) then
2052 C what fraction I am in
2054 & ((zj-bordlipbot)/lipbufthick)
2055 C lipbufthick is thickenes of lipid buffore
2056 sslipj=sscalelip(fracinbuf)
2057 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
2058 elseif (zj.gt.bufliptop) then
2059 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
2060 sslipj=sscalelip(fracinbuf)
2061 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
2070 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
2071 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2072 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
2073 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2074 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
2075 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
2076 C write(iout,*) "tu,", i,j,aa,bb,aa_lip(itypi,itypj),sslipi,sslipj
2077 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2085 xj=xj_safe+xshift*boxxsize
2086 yj=yj_safe+yshift*boxysize
2087 zj=zj_safe+zshift*boxzsize
2088 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2089 if(dist_temp.lt.dist_init) then
2099 if (subchap.eq.1) then
2108 dxj=dc_norm(1,nres+j)
2109 dyj=dc_norm(2,nres+j)
2110 dzj=dc_norm(3,nres+j)
2111 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2113 C Calculate angle-dependent terms of energy and contributions to their
2117 sig=sig0ij*dsqrt(sigsq)
2118 rij_shift=1.0D0/rij-sig+r0ij
2119 C I hate to put IF's in the loops, but here don't have another choice!!!!
2120 if (rij_shift.le.0.0D0) then
2125 c---------------------------------------------------------------
2126 rij_shift=1.0D0/rij_shift
2127 fac=rij_shift**expon
2130 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2131 eps2der=evdwij*eps3rt
2132 eps3der=evdwij*eps2rt
2133 fac_augm=rrij**expon
2134 e_augm=augm(itypi,itypj)*fac_augm
2135 evdwij=evdwij*eps2rt*eps3rt
2136 evdw=evdw+evdwij+e_augm
2138 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2140 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2141 & restyp(itypi),i,restyp(itypj),j,
2142 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2143 & chi1,chi2,chip1,chip2,
2144 & eps1,eps2rt**2,eps3rt**2,
2145 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2148 C Calculate gradient components.
2149 e1=e1*eps1*eps2rt**2*eps3rt**2
2150 fac=-expon*(e1+evdwij)*rij_shift
2152 fac=rij*fac-2*expon*rrij*e_augm
2153 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2154 C Calculate the radial part of the gradient
2158 C Calculate angular part of the gradient.
2164 C-----------------------------------------------------------------------------
2165 subroutine sc_angular
2166 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2167 C om12. Called by ebp, egb, and egbv.
2169 include 'COMMON.CALC'
2170 include 'COMMON.IOUNITS'
2174 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2175 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2176 om12=dxi*dxj+dyi*dyj+dzi*dzj
2178 C Calculate eps1(om12) and its derivative in om12
2179 faceps1=1.0D0-om12*chiom12
2180 faceps1_inv=1.0D0/faceps1
2181 eps1=dsqrt(faceps1_inv)
2182 C Following variable is eps1*deps1/dom12
2183 eps1_om12=faceps1_inv*chiom12
2188 c write (iout,*) "om12",om12," eps1",eps1
2189 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2194 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2195 sigsq=1.0D0-facsig*faceps1_inv
2196 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2197 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2198 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2204 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2205 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2207 C Calculate eps2 and its derivatives in om1, om2, and om12.
2210 chipom12=chip12*om12
2211 facp=1.0D0-om12*chipom12
2213 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2214 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2215 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2216 C Following variable is the square root of eps2
2217 eps2rt=1.0D0-facp1*facp_inv
2218 C Following three variables are the derivatives of the square root of eps
2219 C in om1, om2, and om12.
2220 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2221 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2222 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2223 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2224 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2225 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2226 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2227 c & " eps2rt_om12",eps2rt_om12
2228 C Calculate whole angle-dependent part of epsilon and contributions
2229 C to its derivatives
2232 C----------------------------------------------------------------------------
2234 implicit real*8 (a-h,o-z)
2235 include 'DIMENSIONS'
2236 include 'COMMON.CHAIN'
2237 include 'COMMON.DERIV'
2238 include 'COMMON.CALC'
2239 include 'COMMON.IOUNITS'
2240 double precision dcosom1(3),dcosom2(3)
2241 cc print *,'sss=',sss
2242 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2243 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2244 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2245 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2249 c eom12=evdwij*eps1_om12
2251 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2252 c & " sigder",sigder
2253 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2254 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2256 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2257 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2260 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2262 c write (iout,*) "gg",(gg(k),k=1,3)
2264 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2265 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2266 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2267 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2268 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2269 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2270 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2271 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2272 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2273 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2276 C Calculate the components of the gradient in DC and X
2280 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2284 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2285 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2289 C-----------------------------------------------------------------------
2290 subroutine e_softsphere(evdw)
2292 C This subroutine calculates the interaction energy of nonbonded side chains
2293 C assuming the LJ potential of interaction.
2295 implicit real*8 (a-h,o-z)
2296 include 'DIMENSIONS'
2297 parameter (accur=1.0d-10)
2298 include 'COMMON.GEO'
2299 include 'COMMON.VAR'
2300 include 'COMMON.LOCAL'
2301 include 'COMMON.CHAIN'
2302 include 'COMMON.DERIV'
2303 include 'COMMON.INTERACT'
2304 include 'COMMON.TORSION'
2305 include 'COMMON.SBRIDGE'
2306 include 'COMMON.NAMES'
2307 include 'COMMON.IOUNITS'
2308 include 'COMMON.CONTACTS'
2310 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2312 do i=iatsc_s,iatsc_e
2313 itypi=iabs(itype(i))
2314 if (itypi.eq.ntyp1) cycle
2315 itypi1=iabs(itype(i+1))
2320 C Calculate SC interaction energy.
2322 do iint=1,nint_gr(i)
2323 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2324 cd & 'iend=',iend(i,iint)
2325 do j=istart(i,iint),iend(i,iint)
2326 itypj=iabs(itype(j))
2327 if (itypj.eq.ntyp1) cycle
2331 rij=xj*xj+yj*yj+zj*zj
2332 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2333 r0ij=r0(itypi,itypj)
2335 c print *,i,j,r0ij,dsqrt(rij)
2336 if (rij.lt.r0ijsq) then
2337 evdwij=0.25d0*(rij-r0ijsq)**2
2345 C Calculate the components of the gradient in DC and X
2351 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2352 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2353 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2354 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2358 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2366 C--------------------------------------------------------------------------
2367 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2370 C Soft-sphere potential of p-p interaction
2372 implicit real*8 (a-h,o-z)
2373 include 'DIMENSIONS'
2374 include 'COMMON.CONTROL'
2375 include 'COMMON.IOUNITS'
2376 include 'COMMON.GEO'
2377 include 'COMMON.VAR'
2378 include 'COMMON.LOCAL'
2379 include 'COMMON.CHAIN'
2380 include 'COMMON.DERIV'
2381 include 'COMMON.INTERACT'
2382 include 'COMMON.CONTACTS'
2383 include 'COMMON.TORSION'
2384 include 'COMMON.VECTORS'
2385 include 'COMMON.FFIELD'
2387 C write(iout,*) 'In EELEC_soft_sphere'
2394 do i=iatel_s,iatel_e
2395 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2399 xmedi=c(1,i)+0.5d0*dxi
2400 ymedi=c(2,i)+0.5d0*dyi
2401 zmedi=c(3,i)+0.5d0*dzi
2402 xmedi=mod(xmedi,boxxsize)
2403 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2404 ymedi=mod(ymedi,boxysize)
2405 if (ymedi.lt.0) ymedi=ymedi+boxysize
2406 zmedi=mod(zmedi,boxzsize)
2407 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2409 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2410 do j=ielstart(i),ielend(i)
2411 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2415 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2416 r0ij=rpp(iteli,itelj)
2425 if (xj.lt.0) xj=xj+boxxsize
2427 if (yj.lt.0) yj=yj+boxysize
2429 if (zj.lt.0) zj=zj+boxzsize
2430 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2438 xj=xj_safe+xshift*boxxsize
2439 yj=yj_safe+yshift*boxysize
2440 zj=zj_safe+zshift*boxzsize
2441 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2442 if(dist_temp.lt.dist_init) then
2452 if (isubchap.eq.1) then
2461 rij=xj*xj+yj*yj+zj*zj
2462 sss=sscale(sqrt(rij))
2463 sssgrad=sscagrad(sqrt(rij))
2464 if (rij.lt.r0ijsq) then
2465 evdw1ij=0.25d0*(rij-r0ijsq)**2
2471 evdw1=evdw1+evdw1ij*sss
2473 C Calculate contributions to the Cartesian gradient.
2475 ggg(1)=fac*xj*sssgrad
2476 ggg(2)=fac*yj*sssgrad
2477 ggg(3)=fac*zj*sssgrad
2479 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2480 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2483 * Loop over residues i+1 thru j-1.
2487 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2492 cgrad do i=nnt,nct-1
2494 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2496 cgrad do j=i+1,nct-1
2498 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2504 c------------------------------------------------------------------------------
2505 subroutine vec_and_deriv
2506 implicit real*8 (a-h,o-z)
2507 include 'DIMENSIONS'
2511 include 'COMMON.IOUNITS'
2512 include 'COMMON.GEO'
2513 include 'COMMON.VAR'
2514 include 'COMMON.LOCAL'
2515 include 'COMMON.CHAIN'
2516 include 'COMMON.VECTORS'
2517 include 'COMMON.SETUP'
2518 include 'COMMON.TIME1'
2519 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2520 C Compute the local reference systems. For reference system (i), the
2521 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2522 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2524 do i=ivec_start,ivec_end
2528 if (i.eq.nres-1) then
2529 C Case of the last full residue
2530 C Compute the Z-axis
2531 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2532 costh=dcos(pi-theta(nres))
2533 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2537 C Compute the derivatives of uz
2539 uzder(2,1,1)=-dc_norm(3,i-1)
2540 uzder(3,1,1)= dc_norm(2,i-1)
2541 uzder(1,2,1)= dc_norm(3,i-1)
2543 uzder(3,2,1)=-dc_norm(1,i-1)
2544 uzder(1,3,1)=-dc_norm(2,i-1)
2545 uzder(2,3,1)= dc_norm(1,i-1)
2548 uzder(2,1,2)= dc_norm(3,i)
2549 uzder(3,1,2)=-dc_norm(2,i)
2550 uzder(1,2,2)=-dc_norm(3,i)
2552 uzder(3,2,2)= dc_norm(1,i)
2553 uzder(1,3,2)= dc_norm(2,i)
2554 uzder(2,3,2)=-dc_norm(1,i)
2556 C Compute the Y-axis
2559 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2561 C Compute the derivatives of uy
2564 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2565 & -dc_norm(k,i)*dc_norm(j,i-1)
2566 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2568 uyder(j,j,1)=uyder(j,j,1)-costh
2569 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2574 uygrad(l,k,j,i)=uyder(l,k,j)
2575 uzgrad(l,k,j,i)=uzder(l,k,j)
2579 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2580 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2581 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2582 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2585 C Compute the Z-axis
2586 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2587 costh=dcos(pi-theta(i+2))
2588 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2592 C Compute the derivatives of uz
2594 uzder(2,1,1)=-dc_norm(3,i+1)
2595 uzder(3,1,1)= dc_norm(2,i+1)
2596 uzder(1,2,1)= dc_norm(3,i+1)
2598 uzder(3,2,1)=-dc_norm(1,i+1)
2599 uzder(1,3,1)=-dc_norm(2,i+1)
2600 uzder(2,3,1)= dc_norm(1,i+1)
2603 uzder(2,1,2)= dc_norm(3,i)
2604 uzder(3,1,2)=-dc_norm(2,i)
2605 uzder(1,2,2)=-dc_norm(3,i)
2607 uzder(3,2,2)= dc_norm(1,i)
2608 uzder(1,3,2)= dc_norm(2,i)
2609 uzder(2,3,2)=-dc_norm(1,i)
2611 C Compute the Y-axis
2614 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2616 C Compute the derivatives of uy
2619 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2620 & -dc_norm(k,i)*dc_norm(j,i+1)
2621 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2623 uyder(j,j,1)=uyder(j,j,1)-costh
2624 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2629 uygrad(l,k,j,i)=uyder(l,k,j)
2630 uzgrad(l,k,j,i)=uzder(l,k,j)
2634 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2635 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2636 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2637 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2641 vbld_inv_temp(1)=vbld_inv(i+1)
2642 if (i.lt.nres-1) then
2643 vbld_inv_temp(2)=vbld_inv(i+2)
2645 vbld_inv_temp(2)=vbld_inv(i)
2650 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2651 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2656 #if defined(PARVEC) && defined(MPI)
2657 if (nfgtasks1.gt.1) then
2659 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2660 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2661 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2662 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2663 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2665 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2666 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2668 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2669 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2670 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2671 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2672 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2673 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2674 time_gather=time_gather+MPI_Wtime()-time00
2676 c if (fg_rank.eq.0) then
2677 c write (iout,*) "Arrays UY and UZ"
2679 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2686 C-----------------------------------------------------------------------------
2687 subroutine check_vecgrad
2688 implicit real*8 (a-h,o-z)
2689 include 'DIMENSIONS'
2690 include 'COMMON.IOUNITS'
2691 include 'COMMON.GEO'
2692 include 'COMMON.VAR'
2693 include 'COMMON.LOCAL'
2694 include 'COMMON.CHAIN'
2695 include 'COMMON.VECTORS'
2696 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2697 dimension uyt(3,maxres),uzt(3,maxres)
2698 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2699 double precision delta /1.0d-7/
2702 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2703 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2704 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2705 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2706 cd & (dc_norm(if90,i),if90=1,3)
2707 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2708 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2709 cd write(iout,'(a)')
2715 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2716 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2729 cd write (iout,*) 'i=',i
2731 erij(k)=dc_norm(k,i)
2735 dc_norm(k,i)=erij(k)
2737 dc_norm(j,i)=dc_norm(j,i)+delta
2738 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2740 c dc_norm(k,i)=dc_norm(k,i)/fac
2742 c write (iout,*) (dc_norm(k,i),k=1,3)
2743 c write (iout,*) (erij(k),k=1,3)
2746 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2747 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2748 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2749 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2751 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2752 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2753 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2756 dc_norm(k,i)=erij(k)
2759 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2760 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2761 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2762 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2763 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2764 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2765 cd write (iout,'(a)')
2770 C--------------------------------------------------------------------------
2771 subroutine set_matrices
2772 implicit real*8 (a-h,o-z)
2773 include 'DIMENSIONS'
2776 include "COMMON.SETUP"
2778 integer status(MPI_STATUS_SIZE)
2780 include 'COMMON.IOUNITS'
2781 include 'COMMON.GEO'
2782 include 'COMMON.VAR'
2783 include 'COMMON.LOCAL'
2784 include 'COMMON.CHAIN'
2785 include 'COMMON.DERIV'
2786 include 'COMMON.INTERACT'
2787 include 'COMMON.CONTACTS'
2788 include 'COMMON.TORSION'
2789 include 'COMMON.VECTORS'
2790 include 'COMMON.FFIELD'
2791 double precision auxvec(2),auxmat(2,2)
2793 C Compute the virtual-bond-torsional-angle dependent quantities needed
2794 C to calculate the el-loc multibody terms of various order.
2796 c write(iout,*) 'nphi=',nphi,nres
2798 do i=ivec_start+2,ivec_end+2
2803 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2804 iti = itype2loc(itype(i-2))
2808 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2809 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2810 iti1 = itype2loc(itype(i-1))
2815 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0d0)
2816 & +bnew1(2,1,iti)*dsin(theta(i-1))
2817 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0d0)
2818 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2819 & +bnew1(2,1,iti)*dcos(theta(i-1))
2820 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2821 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2822 c &*(cos(theta(i)/2.0)
2823 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0d0)
2824 & +bnew2(2,1,iti)*dsin(theta(i-1))
2825 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0d0)
2826 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2827 c &*(cos(theta(i)/2.0)
2828 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2829 & +bnew2(2,1,iti)*dcos(theta(i-1))
2830 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2831 c if (ggb1(1,i).eq.0.0d0) then
2832 c write(iout,*) 'i=',i,ggb1(1,i),
2833 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2834 c &bnew1(2,1,iti)*cos(theta(i)),
2835 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2837 b1(2,i-2)=bnew1(1,2,iti)
2839 b2(2,i-2)=bnew2(1,2,iti)
2841 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2842 EE(1,2,i-2)=eeold(1,2,iti)
2843 EE(2,1,i-2)=eeold(2,1,iti)
2844 EE(2,2,i-2)=eeold(2,2,iti)
2845 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2850 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2851 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2852 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2853 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2854 b1tilde(1,i-2)=b1(1,i-2)
2855 b1tilde(2,i-2)=-b1(2,i-2)
2856 b2tilde(1,i-2)=b2(1,i-2)
2857 b2tilde(2,i-2)=-b2(2,i-2)
2858 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2859 c write(iout,*) 'b1=',b1(1,i-2)
2860 c write (iout,*) 'theta=', theta(i-1)
2863 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2864 iti = itype2loc(itype(i-2))
2868 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2869 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2870 iti1 = itype2loc(itype(i-1))
2878 b1tilde(1,i-2)=b1(1,i-2)
2879 b1tilde(2,i-2)=-b1(2,i-2)
2880 b2tilde(1,i-2)=b2(1,i-2)
2881 b2tilde(2,i-2)=-b2(2,i-2)
2882 EE(1,2,i-2)=eeold(1,2,iti)
2883 EE(2,1,i-2)=eeold(2,1,iti)
2884 EE(2,2,i-2)=eeold(2,2,iti)
2885 EE(1,1,i-2)=eeold(1,1,iti)
2889 do i=ivec_start+2,ivec_end+2
2893 if (i .lt. nres+1) then
2930 if (i .gt. 3 .and. i .lt. nres+1) then
2931 obrot_der(1,i-2)=-sin1
2932 obrot_der(2,i-2)= cos1
2933 Ugder(1,1,i-2)= sin1
2934 Ugder(1,2,i-2)=-cos1
2935 Ugder(2,1,i-2)=-cos1
2936 Ugder(2,2,i-2)=-sin1
2939 obrot2_der(1,i-2)=-dwasin2
2940 obrot2_der(2,i-2)= dwacos2
2941 Ug2der(1,1,i-2)= dwasin2
2942 Ug2der(1,2,i-2)=-dwacos2
2943 Ug2der(2,1,i-2)=-dwacos2
2944 Ug2der(2,2,i-2)=-dwasin2
2946 obrot_der(1,i-2)=0.0d0
2947 obrot_der(2,i-2)=0.0d0
2948 Ugder(1,1,i-2)=0.0d0
2949 Ugder(1,2,i-2)=0.0d0
2950 Ugder(2,1,i-2)=0.0d0
2951 Ugder(2,2,i-2)=0.0d0
2952 obrot2_der(1,i-2)=0.0d0
2953 obrot2_der(2,i-2)=0.0d0
2954 Ug2der(1,1,i-2)=0.0d0
2955 Ug2der(1,2,i-2)=0.0d0
2956 Ug2der(2,1,i-2)=0.0d0
2957 Ug2der(2,2,i-2)=0.0d0
2959 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2960 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2961 iti = itype2loc(itype(i-2))
2965 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2966 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2967 iti1 = itype2loc(itype(i-1))
2971 cd write (iout,*) '*******i',i,' iti1',iti
2972 cd write (iout,*) 'b1',b1(:,iti)
2973 cd write (iout,*) 'b2',b2(:,iti)
2974 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2975 c if (i .gt. iatel_s+2) then
2976 if (i .gt. nnt+2) then
2977 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2979 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2980 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2982 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
2983 c & EE(1,2,iti),EE(2,2,i)
2984 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2985 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2986 c write(iout,*) "Macierz EUG",
2987 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2989 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2991 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2992 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2993 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2994 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2995 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
3006 DtUg2(l,k,i-2)=0.0d0
3010 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
3011 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
3013 muder(k,i-2)=Ub2der(k,i-2)
3015 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3016 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3017 if (itype(i-1).le.ntyp) then
3018 iti1 = itype2loc(itype(i-1))
3026 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
3029 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
3030 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
3031 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
3032 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
3033 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
3034 & ((ee(l,k,i-2),l=1,2),k=1,2),eenew(1,itype2loc(iti))
3036 cd write (iout,*) 'mu1',mu1(:,i-2)
3037 cd write (iout,*) 'mu2',mu2(:,i-2)
3038 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3040 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3041 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
3042 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3043 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
3044 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3045 C Vectors and matrices dependent on a single virtual-bond dihedral.
3046 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
3047 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3048 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3049 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
3050 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
3051 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3052 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3053 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3054 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3057 C Matrices dependent on two consecutive virtual-bond dihedrals.
3058 C The order of matrices is from left to right.
3059 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3061 c do i=max0(ivec_start,2),ivec_end
3063 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3064 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3065 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3066 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3067 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3068 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3069 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3070 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3073 #if defined(MPI) && defined(PARMAT)
3075 c if (fg_rank.eq.0) then
3076 write (iout,*) "Arrays UG and UGDER before GATHER"
3078 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3079 & ((ug(l,k,i),l=1,2),k=1,2),
3080 & ((ugder(l,k,i),l=1,2),k=1,2)
3082 write (iout,*) "Arrays UG2 and UG2DER"
3084 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3085 & ((ug2(l,k,i),l=1,2),k=1,2),
3086 & ((ug2der(l,k,i),l=1,2),k=1,2)
3088 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3090 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3091 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3092 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3094 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3096 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3097 & costab(i),sintab(i),costab2(i),sintab2(i)
3099 write (iout,*) "Array MUDER"
3101 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3105 if (nfgtasks.gt.1) then
3107 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
3108 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
3109 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
3111 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
3112 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3114 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
3115 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3117 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
3118 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3120 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
3121 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3123 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
3124 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3126 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
3127 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3129 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
3130 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
3131 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3132 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
3133 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
3134 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3135 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
3136 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
3137 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3138 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
3139 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
3140 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3141 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3143 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
3144 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3146 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
3147 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3149 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
3150 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3152 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3153 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3155 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3156 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3158 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3159 & ivec_count(fg_rank1),
3160 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3162 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3163 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3165 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3166 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3168 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3169 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3171 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3172 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3174 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3175 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3177 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3178 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3180 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3181 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3183 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3184 & ivec_count(fg_rank1),
3185 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3187 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3188 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3190 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3191 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3193 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3194 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3196 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3197 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3199 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3200 & ivec_count(fg_rank1),
3201 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3203 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3204 & ivec_count(fg_rank1),
3205 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3207 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3208 & ivec_count(fg_rank1),
3209 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3210 & MPI_MAT2,FG_COMM1,IERR)
3211 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3212 & ivec_count(fg_rank1),
3213 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3214 & MPI_MAT2,FG_COMM1,IERR)
3217 c Passes matrix info through the ring
3220 if (irecv.lt.0) irecv=nfgtasks1-1
3223 if (inext.ge.nfgtasks1) inext=0
3225 c write (iout,*) "isend",isend," irecv",irecv
3227 lensend=lentyp(isend)
3228 lenrecv=lentyp(irecv)
3229 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3230 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3231 c & MPI_ROTAT1(lensend),inext,2200+isend,
3232 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3233 c & iprev,2200+irecv,FG_COMM,status,IERR)
3234 c write (iout,*) "Gather ROTAT1"
3236 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3237 c & MPI_ROTAT2(lensend),inext,3300+isend,
3238 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3239 c & iprev,3300+irecv,FG_COMM,status,IERR)
3240 c write (iout,*) "Gather ROTAT2"
3242 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3243 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3244 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3245 & iprev,4400+irecv,FG_COMM,status,IERR)
3246 c write (iout,*) "Gather ROTAT_OLD"
3248 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3249 & MPI_PRECOMP11(lensend),inext,5500+isend,
3250 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3251 & iprev,5500+irecv,FG_COMM,status,IERR)
3252 c write (iout,*) "Gather PRECOMP11"
3254 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3255 & MPI_PRECOMP12(lensend),inext,6600+isend,
3256 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3257 & iprev,6600+irecv,FG_COMM,status,IERR)
3258 c write (iout,*) "Gather PRECOMP12"
3260 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3262 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3263 & MPI_ROTAT2(lensend),inext,7700+isend,
3264 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3265 & iprev,7700+irecv,FG_COMM,status,IERR)
3266 c write (iout,*) "Gather PRECOMP21"
3268 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3269 & MPI_PRECOMP22(lensend),inext,8800+isend,
3270 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3271 & iprev,8800+irecv,FG_COMM,status,IERR)
3272 c write (iout,*) "Gather PRECOMP22"
3274 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3275 & MPI_PRECOMP23(lensend),inext,9900+isend,
3276 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3277 & MPI_PRECOMP23(lenrecv),
3278 & iprev,9900+irecv,FG_COMM,status,IERR)
3279 c write (iout,*) "Gather PRECOMP23"
3284 if (irecv.lt.0) irecv=nfgtasks1-1
3287 time_gather=time_gather+MPI_Wtime()-time00
3290 c if (fg_rank.eq.0) then
3291 write (iout,*) "Arrays UG and UGDER"
3293 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3294 & ((ug(l,k,i),l=1,2),k=1,2),
3295 & ((ugder(l,k,i),l=1,2),k=1,2)
3297 write (iout,*) "Arrays UG2 and UG2DER"
3299 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3300 & ((ug2(l,k,i),l=1,2),k=1,2),
3301 & ((ug2der(l,k,i),l=1,2),k=1,2)
3303 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3305 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3306 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3307 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3309 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3311 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3312 & costab(i),sintab(i),costab2(i),sintab2(i)
3314 write (iout,*) "Array MUDER"
3316 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3322 cd iti = itype2loc(itype(i))
3325 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3326 cd & (EE(j,k,i),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3331 C--------------------------------------------------------------------------
3332 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3334 C This subroutine calculates the average interaction energy and its gradient
3335 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3336 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3337 C The potential depends both on the distance of peptide-group centers and on
3338 C the orientation of the CA-CA virtual bonds.
3340 implicit real*8 (a-h,o-z)
3344 include 'DIMENSIONS'
3345 include 'COMMON.CONTROL'
3346 include 'COMMON.SETUP'
3347 include 'COMMON.IOUNITS'
3348 include 'COMMON.GEO'
3349 include 'COMMON.VAR'
3350 include 'COMMON.LOCAL'
3351 include 'COMMON.CHAIN'
3352 include 'COMMON.DERIV'
3353 include 'COMMON.INTERACT'
3354 include 'COMMON.CONTACTS'
3355 include 'COMMON.TORSION'
3356 include 'COMMON.VECTORS'
3357 include 'COMMON.FFIELD'
3358 include 'COMMON.TIME1'
3359 include 'COMMON.SPLITELE'
3360 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3361 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3362 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3363 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3364 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3365 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3367 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3369 double precision scal_el /1.0d0/
3371 double precision scal_el /0.5d0/
3374 C 13-go grudnia roku pamietnego...
3375 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3376 & 0.0d0,1.0d0,0.0d0,
3377 & 0.0d0,0.0d0,1.0d0/
3378 cd write(iout,*) 'In EELEC'
3380 cd write(iout,*) 'Type',i
3381 cd write(iout,*) 'B1',B1(:,i)
3382 cd write(iout,*) 'B2',B2(:,i)
3383 cd write(iout,*) 'CC',CC(:,:,i)
3384 cd write(iout,*) 'DD',DD(:,:,i)
3385 cd write(iout,*) 'EE',EE(:,:,i)
3387 cd call check_vecgrad
3389 if (icheckgrad.eq.1) then
3391 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3393 dc_norm(k,i)=dc(k,i)*fac
3395 c write (iout,*) 'i',i,' fac',fac
3398 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3399 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3400 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3401 c call vec_and_deriv
3407 time_mat=time_mat+MPI_Wtime()-time01
3411 cd write (iout,*) 'i=',i
3413 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3416 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3417 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3430 cd print '(a)','Enter EELEC'
3431 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3433 gel_loc_loc(i)=0.0d0
3438 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3440 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3442 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3443 do i=iturn3_start,iturn3_end
3445 C write(iout,*) "tu jest i",i
3446 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3447 C changes suggested by Ana to avoid out of bounds
3448 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
3449 c & .or.((i+4).gt.nres)
3450 c & .or.((i-1).le.0)
3451 C end of changes by Ana
3452 & .or. itype(i+2).eq.ntyp1
3453 & .or. itype(i+3).eq.ntyp1) cycle
3454 C Adam: Instructions below will switch off existing interactions
3456 c if(itype(i-1).eq.ntyp1)cycle
3458 c if(i.LT.nres-3)then
3459 c if (itype(i+4).eq.ntyp1) cycle
3464 dx_normi=dc_norm(1,i)
3465 dy_normi=dc_norm(2,i)
3466 dz_normi=dc_norm(3,i)
3467 xmedi=c(1,i)+0.5d0*dxi
3468 ymedi=c(2,i)+0.5d0*dyi
3469 zmedi=c(3,i)+0.5d0*dzi
3470 xmedi=mod(xmedi,boxxsize)
3471 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3472 ymedi=mod(ymedi,boxysize)
3473 if (ymedi.lt.0) ymedi=ymedi+boxysize
3474 zmedi=mod(zmedi,boxzsize)
3475 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3477 call eelecij(i,i+2,ees,evdw1,eel_loc)
3478 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3479 num_cont_hb(i)=num_conti
3481 do i=iturn4_start,iturn4_end
3483 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3484 C changes suggested by Ana to avoid out of bounds
3485 c & .or.((i+5).gt.nres)
3486 c & .or.((i-1).le.0)
3487 C end of changes suggested by Ana
3488 & .or. itype(i+3).eq.ntyp1
3489 & .or. itype(i+4).eq.ntyp1
3490 c & .or. itype(i+5).eq.ntyp1
3491 c & .or. itype(i).eq.ntyp1
3492 c & .or. itype(i-1).eq.ntyp1
3497 dx_normi=dc_norm(1,i)
3498 dy_normi=dc_norm(2,i)
3499 dz_normi=dc_norm(3,i)
3500 xmedi=c(1,i)+0.5d0*dxi
3501 ymedi=c(2,i)+0.5d0*dyi
3502 zmedi=c(3,i)+0.5d0*dzi
3503 C Return atom into box, boxxsize is size of box in x dimension
3505 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3506 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3507 C Condition for being inside the proper box
3508 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3509 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3513 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3514 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3515 C Condition for being inside the proper box
3516 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3517 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3521 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3522 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3523 C Condition for being inside the proper box
3524 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3525 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3528 xmedi=mod(xmedi,boxxsize)
3529 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3530 ymedi=mod(ymedi,boxysize)
3531 if (ymedi.lt.0) ymedi=ymedi+boxysize
3532 zmedi=mod(zmedi,boxzsize)
3533 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3535 num_conti=num_cont_hb(i)
3536 c write(iout,*) "JESTEM W PETLI"
3537 call eelecij(i,i+3,ees,evdw1,eel_loc)
3538 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3539 & call eturn4(i,eello_turn4)
3540 num_cont_hb(i)=num_conti
3542 C Loop over all neighbouring boxes
3547 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3550 do i=iatel_s,iatel_e
3553 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3554 C changes suggested by Ana to avoid out of bounds
3555 c & .or.((i+2).gt.nres)
3556 c & .or.((i-1).le.0)
3557 C end of changes by Ana
3558 c & .or. itype(i+2).eq.ntyp1
3559 c & .or. itype(i-1).eq.ntyp1
3564 dx_normi=dc_norm(1,i)
3565 dy_normi=dc_norm(2,i)
3566 dz_normi=dc_norm(3,i)
3567 xmedi=c(1,i)+0.5d0*dxi
3568 ymedi=c(2,i)+0.5d0*dyi
3569 zmedi=c(3,i)+0.5d0*dzi
3570 xmedi=mod(xmedi,boxxsize)
3571 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3572 ymedi=mod(ymedi,boxysize)
3573 if (ymedi.lt.0) ymedi=ymedi+boxysize
3574 zmedi=mod(zmedi,boxzsize)
3575 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3576 C xmedi=xmedi+xshift*boxxsize
3577 C ymedi=ymedi+yshift*boxysize
3578 C zmedi=zmedi+zshift*boxzsize
3580 C Return tom into box, boxxsize is size of box in x dimension
3582 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3583 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3584 C Condition for being inside the proper box
3585 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3586 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3590 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3591 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3592 C Condition for being inside the proper box
3593 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3594 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3598 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3599 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3600 cC Condition for being inside the proper box
3601 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3602 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3606 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3607 num_conti=num_cont_hb(i)
3609 do j=ielstart(i),ielend(i)
3611 C write (iout,*) i,j
3613 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3614 C changes suggested by Ana to avoid out of bounds
3615 c & .or.((j+2).gt.nres)
3616 c & .or.((j-1).le.0)
3617 C end of changes by Ana
3618 c & .or.itype(j+2).eq.ntyp1
3619 c & .or.itype(j-1).eq.ntyp1
3621 call eelecij(i,j,ees,evdw1,eel_loc)
3623 num_cont_hb(i)=num_conti
3629 c write (iout,*) "Number of loop steps in EELEC:",ind
3631 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3632 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3634 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3635 ccc eel_loc=eel_loc+eello_turn3
3636 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3639 C-------------------------------------------------------------------------------
3640 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3641 implicit real*8 (a-h,o-z)
3642 include 'DIMENSIONS'
3646 include 'COMMON.CONTROL'
3647 include 'COMMON.IOUNITS'
3648 include 'COMMON.GEO'
3649 include 'COMMON.VAR'
3650 include 'COMMON.LOCAL'
3651 include 'COMMON.CHAIN'
3652 include 'COMMON.DERIV'
3653 include 'COMMON.INTERACT'
3654 include 'COMMON.CONTACTS'
3655 include 'COMMON.TORSION'
3656 include 'COMMON.VECTORS'
3657 include 'COMMON.FFIELD'
3658 include 'COMMON.TIME1'
3659 include 'COMMON.SPLITELE'
3660 include 'COMMON.SHIELD'
3661 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3662 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3663 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3664 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3665 & gmuij2(4),gmuji2(4)
3666 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3667 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3669 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3671 double precision scal_el /1.0d0/
3673 double precision scal_el /0.5d0/
3676 C 13-go grudnia roku pamietnego...
3677 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3678 & 0.0d0,1.0d0,0.0d0,
3679 & 0.0d0,0.0d0,1.0d0/
3680 integer xshift,yshift,zshift
3681 c time00=MPI_Wtime()
3682 cd write (iout,*) "eelecij",i,j
3686 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3687 aaa=app(iteli,itelj)
3688 bbb=bpp(iteli,itelj)
3689 ael6i=ael6(iteli,itelj)
3690 ael3i=ael3(iteli,itelj)
3694 dx_normj=dc_norm(1,j)
3695 dy_normj=dc_norm(2,j)
3696 dz_normj=dc_norm(3,j)
3697 C xj=c(1,j)+0.5D0*dxj-xmedi
3698 C yj=c(2,j)+0.5D0*dyj-ymedi
3699 C zj=c(3,j)+0.5D0*dzj-zmedi
3704 if (xj.lt.0) xj=xj+boxxsize
3706 if (yj.lt.0) yj=yj+boxysize
3708 if (zj.lt.0) zj=zj+boxzsize
3709 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3710 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3718 xj=xj_safe+xshift*boxxsize
3719 yj=yj_safe+yshift*boxysize
3720 zj=zj_safe+zshift*boxzsize
3721 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3722 if(dist_temp.lt.dist_init) then
3732 if (isubchap.eq.1) then
3741 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3743 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3744 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3745 C Condition for being inside the proper box
3746 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3747 c & (xj.lt.((-0.5d0)*boxxsize))) then
3751 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3752 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3753 C Condition for being inside the proper box
3754 c if ((yj.gt.((0.5d0)*boxysize)).or.
3755 c & (yj.lt.((-0.5d0)*boxysize))) then
3759 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3760 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3761 C Condition for being inside the proper box
3762 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3763 c & (zj.lt.((-0.5d0)*boxzsize))) then
3766 C endif !endPBC condintion
3770 rij=xj*xj+yj*yj+zj*zj
3772 sss=sscale(sqrt(rij))
3773 sssgrad=sscagrad(sqrt(rij))
3774 c if (sss.gt.0.0d0) then
3780 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3781 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3782 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3783 fac=cosa-3.0D0*cosb*cosg
3785 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3786 if (j.eq.i+2) ev1=scal_el*ev1
3791 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3795 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3796 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3797 if (shield_mode.gt.0) then
3800 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3801 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3810 evdw1=evdw1+evdwij*sss
3811 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3812 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3813 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3814 cd & xmedi,ymedi,zmedi,xj,yj,zj
3816 if (energy_dec) then
3817 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3819 &,iteli,itelj,aaa,evdw1
3821 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
3822 &fac_shield(i),fac_shield(j)
3826 C Calculate contributions to the Cartesian gradient.
3829 facvdw=-6*rrmij*(ev1+evdwij)*sss
3830 facel=-3*rrmij*(el1+eesij)
3837 * Radial derivatives. First process both termini of the fragment (i,j)
3842 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3843 & (shield_mode.gt.0)) then
3845 do ilist=1,ishield_list(i)
3846 iresshield=shield_list(ilist,i)
3848 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
3850 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3852 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
3853 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3854 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3855 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3856 C if (iresshield.gt.i) then
3857 C do ishi=i+1,iresshield-1
3858 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3859 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3863 C do ishi=iresshield,i
3864 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3865 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3871 do ilist=1,ishield_list(j)
3872 iresshield=shield_list(ilist,j)
3874 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
3876 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3878 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
3879 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3881 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3882 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3883 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3884 C if (iresshield.gt.j) then
3885 C do ishi=j+1,iresshield-1
3886 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3887 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3891 C do ishi=iresshield,j
3892 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3893 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3900 gshieldc(k,i)=gshieldc(k,i)+
3901 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
3902 gshieldc(k,j)=gshieldc(k,j)+
3903 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
3904 gshieldc(k,i-1)=gshieldc(k,i-1)+
3905 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
3906 gshieldc(k,j-1)=gshieldc(k,j-1)+
3907 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
3912 c ghalf=0.5D0*ggg(k)
3913 c gelc(k,i)=gelc(k,i)+ghalf
3914 c gelc(k,j)=gelc(k,j)+ghalf
3916 c 9/28/08 AL Gradient compotents will be summed only at the end
3917 C print *,"before", gelc_long(1,i), gelc_long(1,j)
3919 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3920 C & +grad_shield(k,j)*eesij/fac_shield(j)
3921 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3922 C & +grad_shield(k,i)*eesij/fac_shield(i)
3923 C gelc_long(k,i-1)=gelc_long(k,i-1)
3924 C & +grad_shield(k,i)*eesij/fac_shield(i)
3925 C gelc_long(k,j-1)=gelc_long(k,j-1)
3926 C & +grad_shield(k,j)*eesij/fac_shield(j)
3928 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
3931 * Loop over residues i+1 thru j-1.
3935 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3938 if (sss.gt.0.0) then
3939 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3940 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3941 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3948 c ghalf=0.5D0*ggg(k)
3949 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3950 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3952 c 9/28/08 AL Gradient compotents will be summed only at the end
3954 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3955 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3958 * Loop over residues i+1 thru j-1.
3962 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3967 facvdw=(ev1+evdwij)*sss
3970 fac=-3*rrmij*(facvdw+facvdw+facel)
3975 * Radial derivatives. First process both termini of the fragment (i,j)
3978 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
3980 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
3982 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
3984 c ghalf=0.5D0*ggg(k)
3985 c gelc(k,i)=gelc(k,i)+ghalf
3986 c gelc(k,j)=gelc(k,j)+ghalf
3988 c 9/28/08 AL Gradient compotents will be summed only at the end
3990 gelc_long(k,j)=gelc(k,j)+ggg(k)
3991 gelc_long(k,i)=gelc(k,i)-ggg(k)
3994 * Loop over residues i+1 thru j-1.
3998 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4001 c 9/28/08 AL Gradient compotents will be summed only at the end
4002 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
4003 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
4004 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
4006 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4007 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4013 ecosa=2.0D0*fac3*fac1+fac4
4016 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
4017 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
4019 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4020 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4022 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
4023 cd & (dcosg(k),k=1,3)
4025 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
4026 & fac_shield(i)**2*fac_shield(j)**2
4029 c ghalf=0.5D0*ggg(k)
4030 c gelc(k,i)=gelc(k,i)+ghalf
4031 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4032 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4033 c gelc(k,j)=gelc(k,j)+ghalf
4034 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4035 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4039 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4042 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
4045 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4046 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
4047 & *fac_shield(i)**2*fac_shield(j)**2
4049 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4050 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
4051 & *fac_shield(i)**2*fac_shield(j)**2
4052 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4053 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4055 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
4059 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
4060 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
4061 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4063 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
4064 C energy of a peptide unit is assumed in the form of a second-order
4065 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
4066 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
4067 C are computed for EVERY pair of non-contiguous peptide groups.
4070 if (j.lt.nres-1) then
4082 muij(kkk)=mu(k,i)*mu(l,j)
4083 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
4085 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
4086 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
4087 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
4088 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
4089 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
4090 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4094 cd write (iout,*) 'EELEC: i',i,' j',j
4095 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
4096 cd write(iout,*) 'muij',muij
4097 ury=scalar(uy(1,i),erij)
4098 urz=scalar(uz(1,i),erij)
4099 vry=scalar(uy(1,j),erij)
4100 vrz=scalar(uz(1,j),erij)
4101 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4102 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4103 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4104 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4105 fac=dsqrt(-ael6i)*r3ij
4110 cd write (iout,'(4i5,4f10.5)')
4111 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
4112 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4113 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4114 cd & uy(:,j),uz(:,j)
4115 cd write (iout,'(4f10.5)')
4116 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4117 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4118 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
4119 cd write (iout,'(9f10.5/)')
4120 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4121 C Derivatives of the elements of A in virtual-bond vectors
4122 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4124 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4125 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4126 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4127 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4128 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4129 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4130 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4131 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4132 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4133 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4134 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4135 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4137 C Compute radial contributions to the gradient
4155 C Add the contributions coming from er
4158 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4159 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4160 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4161 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4164 C Derivatives in DC(i)
4165 cgrad ghalf1=0.5d0*agg(k,1)
4166 cgrad ghalf2=0.5d0*agg(k,2)
4167 cgrad ghalf3=0.5d0*agg(k,3)
4168 cgrad ghalf4=0.5d0*agg(k,4)
4169 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
4170 & -3.0d0*uryg(k,2)*vry)!+ghalf1
4171 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
4172 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
4173 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
4174 & -3.0d0*urzg(k,2)*vry)!+ghalf3
4175 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
4176 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
4177 C Derivatives in DC(i+1)
4178 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
4179 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4180 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
4181 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4182 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
4183 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4184 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
4185 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4186 C Derivatives in DC(j)
4187 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
4188 & -3.0d0*vryg(k,2)*ury)!+ghalf1
4189 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4190 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4191 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4192 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4193 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4194 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4195 C Derivatives in DC(j+1) or DC(nres-1)
4196 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4197 & -3.0d0*vryg(k,3)*ury)
4198 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4199 & -3.0d0*vrzg(k,3)*ury)
4200 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4201 & -3.0d0*vryg(k,3)*urz)
4202 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4203 & -3.0d0*vrzg(k,3)*urz)
4204 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4206 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4219 aggi(k,l)=-aggi(k,l)
4220 aggi1(k,l)=-aggi1(k,l)
4221 aggj(k,l)=-aggj(k,l)
4222 aggj1(k,l)=-aggj1(k,l)
4225 if (j.lt.nres-1) then
4231 aggi(k,l)=-aggi(k,l)
4232 aggi1(k,l)=-aggi1(k,l)
4233 aggj(k,l)=-aggj(k,l)
4234 aggj1(k,l)=-aggj1(k,l)
4245 aggi(k,l)=-aggi(k,l)
4246 aggi1(k,l)=-aggi1(k,l)
4247 aggj(k,l)=-aggj(k,l)
4248 aggj1(k,l)=-aggj1(k,l)
4253 IF (wel_loc.gt.0.0d0) THEN
4254 C Contribution to the local-electrostatic energy coming from the i-j pair
4255 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4257 if (shield_mode.eq.0) then
4264 eel_loc_ij=eel_loc_ij
4265 & *fac_shield(i)*fac_shield(j)
4266 C Now derivative over eel_loc
4267 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4268 & (shield_mode.gt.0)) then
4271 do ilist=1,ishield_list(i)
4272 iresshield=shield_list(ilist,i)
4274 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
4277 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4279 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
4280 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4284 do ilist=1,ishield_list(j)
4285 iresshield=shield_list(ilist,j)
4287 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
4290 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4292 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
4293 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4300 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
4301 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4302 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
4303 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4304 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
4305 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4306 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
4307 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4312 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4313 c & ' eel_loc_ij',eel_loc_ij
4314 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4315 C Calculate patrial derivative for theta angle
4317 geel_loc_ij=(a22*gmuij1(1)
4321 & *fac_shield(i)*fac_shield(j)
4322 c write(iout,*) "derivative over thatai"
4323 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4325 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4326 & geel_loc_ij*wel_loc
4327 c write(iout,*) "derivative over thatai-1"
4328 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4335 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4336 & geel_loc_ij*wel_loc
4337 & *fac_shield(i)*fac_shield(j)
4339 c Derivative over j residue
4340 geel_loc_ji=a22*gmuji1(1)
4344 c write(iout,*) "derivative over thataj"
4345 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4348 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4349 & geel_loc_ji*wel_loc
4350 & *fac_shield(i)*fac_shield(j)
4357 c write(iout,*) "derivative over thataj-1"
4358 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4360 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4361 & geel_loc_ji*wel_loc
4362 & *fac_shield(i)*fac_shield(j)
4364 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4366 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4367 & 'eelloc',i,j,eel_loc_ij
4368 c if (eel_loc_ij.ne.0)
4369 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4370 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4372 eel_loc=eel_loc+eel_loc_ij
4373 C Partial derivatives in virtual-bond dihedral angles gamma
4375 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4376 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4377 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
4378 & *fac_shield(i)*fac_shield(j)
4380 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4381 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4382 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
4383 & *fac_shield(i)*fac_shield(j)
4384 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4386 ggg(l)=(agg(l,1)*muij(1)+
4387 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
4388 & *fac_shield(i)*fac_shield(j)
4389 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4390 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4391 cgrad ghalf=0.5d0*ggg(l)
4392 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4393 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4397 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4400 C Remaining derivatives of eello
4402 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4403 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4404 & *fac_shield(i)*fac_shield(j)
4406 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4407 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4408 & *fac_shield(i)*fac_shield(j)
4410 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4411 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4412 & *fac_shield(i)*fac_shield(j)
4414 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4415 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4416 & *fac_shield(i)*fac_shield(j)
4420 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4421 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4422 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4423 & .and. num_conti.le.maxconts) then
4424 c write (iout,*) i,j," entered corr"
4426 C Calculate the contact function. The ith column of the array JCONT will
4427 C contain the numbers of atoms that make contacts with the atom I (of numbers
4428 C greater than I). The arrays FACONT and GACONT will contain the values of
4429 C the contact function and its derivative.
4430 c r0ij=1.02D0*rpp(iteli,itelj)
4431 c r0ij=1.11D0*rpp(iteli,itelj)
4432 r0ij=2.20D0*rpp(iteli,itelj)
4433 c r0ij=1.55D0*rpp(iteli,itelj)
4434 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4435 if (fcont.gt.0.0D0) then
4436 num_conti=num_conti+1
4437 if (num_conti.gt.maxconts) then
4438 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4439 & ' will skip next contacts for this conf.'
4441 jcont_hb(num_conti,i)=j
4442 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4443 cd & " jcont_hb",jcont_hb(num_conti,i)
4444 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4445 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4446 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4448 d_cont(num_conti,i)=rij
4449 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4450 C --- Electrostatic-interaction matrix ---
4451 a_chuj(1,1,num_conti,i)=a22
4452 a_chuj(1,2,num_conti,i)=a23
4453 a_chuj(2,1,num_conti,i)=a32
4454 a_chuj(2,2,num_conti,i)=a33
4455 C --- Gradient of rij
4457 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4464 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4465 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4466 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4467 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4468 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4473 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4474 C Calculate contact energies
4476 wij=cosa-3.0D0*cosb*cosg
4479 c fac3=dsqrt(-ael6i)/r0ij**3
4480 fac3=dsqrt(-ael6i)*r3ij
4481 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4482 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4483 if (ees0tmp.gt.0) then
4484 ees0pij=dsqrt(ees0tmp)
4488 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4489 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4490 if (ees0tmp.gt.0) then
4491 ees0mij=dsqrt(ees0tmp)
4496 if (shield_mode.eq.0) then
4500 ees0plist(num_conti,i)=j
4501 C fac_shield(i)=0.4d0
4502 C fac_shield(j)=0.6d0
4504 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4505 & *fac_shield(i)*fac_shield(j)
4506 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4507 & *fac_shield(i)*fac_shield(j)
4508 C Diagnostics. Comment out or remove after debugging!
4509 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4510 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4511 c ees0m(num_conti,i)=0.0D0
4513 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4514 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4515 C Angular derivatives of the contact function
4516 ees0pij1=fac3/ees0pij
4517 ees0mij1=fac3/ees0mij
4518 fac3p=-3.0D0*fac3*rrmij
4519 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4520 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4522 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4523 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4524 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4525 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4526 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4527 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4528 ecosap=ecosa1+ecosa2
4529 ecosbp=ecosb1+ecosb2
4530 ecosgp=ecosg1+ecosg2
4531 ecosam=ecosa1-ecosa2
4532 ecosbm=ecosb1-ecosb2
4533 ecosgm=ecosg1-ecosg2
4542 facont_hb(num_conti,i)=fcont
4543 fprimcont=fprimcont/rij
4544 cd facont_hb(num_conti,i)=1.0D0
4545 C Following line is for diagnostics.
4548 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4549 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4552 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4553 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4555 gggp(1)=gggp(1)+ees0pijp*xj
4556 gggp(2)=gggp(2)+ees0pijp*yj
4557 gggp(3)=gggp(3)+ees0pijp*zj
4558 gggm(1)=gggm(1)+ees0mijp*xj
4559 gggm(2)=gggm(2)+ees0mijp*yj
4560 gggm(3)=gggm(3)+ees0mijp*zj
4561 C Derivatives due to the contact function
4562 gacont_hbr(1,num_conti,i)=fprimcont*xj
4563 gacont_hbr(2,num_conti,i)=fprimcont*yj
4564 gacont_hbr(3,num_conti,i)=fprimcont*zj
4567 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4568 c following the change of gradient-summation algorithm.
4570 cgrad ghalfp=0.5D0*gggp(k)
4571 cgrad ghalfm=0.5D0*gggm(k)
4572 gacontp_hb1(k,num_conti,i)=!ghalfp
4573 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4574 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4575 & *fac_shield(i)*fac_shield(j)
4577 gacontp_hb2(k,num_conti,i)=!ghalfp
4578 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4579 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4580 & *fac_shield(i)*fac_shield(j)
4582 gacontp_hb3(k,num_conti,i)=gggp(k)
4583 & *fac_shield(i)*fac_shield(j)
4585 gacontm_hb1(k,num_conti,i)=!ghalfm
4586 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4587 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4588 & *fac_shield(i)*fac_shield(j)
4590 gacontm_hb2(k,num_conti,i)=!ghalfm
4591 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4592 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4593 & *fac_shield(i)*fac_shield(j)
4595 gacontm_hb3(k,num_conti,i)=gggm(k)
4596 & *fac_shield(i)*fac_shield(j)
4599 C Diagnostics. Comment out or remove after debugging!
4601 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4602 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4603 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4604 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4605 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4606 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4609 endif ! num_conti.le.maxconts
4612 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4615 ghalf=0.5d0*agg(l,k)
4616 aggi(l,k)=aggi(l,k)+ghalf
4617 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4618 aggj(l,k)=aggj(l,k)+ghalf
4621 if (j.eq.nres-1 .and. i.lt.j-2) then
4624 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4629 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4632 C-----------------------------------------------------------------------------
4633 subroutine eturn3(i,eello_turn3)
4634 C Third- and fourth-order contributions from turns
4635 implicit real*8 (a-h,o-z)
4636 include 'DIMENSIONS'
4637 include 'COMMON.IOUNITS'
4638 include 'COMMON.GEO'
4639 include 'COMMON.VAR'
4640 include 'COMMON.LOCAL'
4641 include 'COMMON.CHAIN'
4642 include 'COMMON.DERIV'
4643 include 'COMMON.INTERACT'
4644 include 'COMMON.CONTACTS'
4645 include 'COMMON.TORSION'
4646 include 'COMMON.VECTORS'
4647 include 'COMMON.FFIELD'
4648 include 'COMMON.CONTROL'
4649 include 'COMMON.SHIELD'
4651 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4652 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4653 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4654 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4655 & auxgmat2(2,2),auxgmatt2(2,2)
4656 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4657 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4658 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4659 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4662 c write (iout,*) "eturn3",i,j,j1,j2
4667 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4669 C Third-order contributions
4676 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4677 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4678 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4679 c auxalary matices for theta gradient
4680 c auxalary matrix for i+1 and constant i+2
4681 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4682 c auxalary matrix for i+2 and constant i+1
4683 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4684 call transpose2(auxmat(1,1),auxmat1(1,1))
4685 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4686 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4687 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4688 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4689 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4690 if (shield_mode.eq.0) then
4697 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4698 & *fac_shield(i)*fac_shield(j)
4699 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
4700 & *fac_shield(i)*fac_shield(j)
4702 C Derivatives in theta
4703 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4704 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4705 & *fac_shield(i)*fac_shield(j)
4706 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4707 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4708 & *fac_shield(i)*fac_shield(j)
4711 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4712 C Derivatives in shield mode
4713 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4714 & (shield_mode.gt.0)) then
4717 do ilist=1,ishield_list(i)
4718 iresshield=shield_list(ilist,i)
4720 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4722 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4724 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4725 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4729 do ilist=1,ishield_list(j)
4730 iresshield=shield_list(ilist,j)
4732 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4734 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4736 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4737 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4744 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
4745 & grad_shield(k,i)*eello_t3/fac_shield(i)
4746 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
4747 & grad_shield(k,j)*eello_t3/fac_shield(j)
4748 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
4749 & grad_shield(k,i)*eello_t3/fac_shield(i)
4750 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
4751 & grad_shield(k,j)*eello_t3/fac_shield(j)
4755 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4756 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4757 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4758 cd & ' eello_turn3_num',4*eello_turn3_num
4759 C Derivatives in gamma(i)
4760 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4761 call transpose2(auxmat2(1,1),auxmat3(1,1))
4762 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4763 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4764 & *fac_shield(i)*fac_shield(j)
4765 C Derivatives in gamma(i+1)
4766 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4767 call transpose2(auxmat2(1,1),auxmat3(1,1))
4768 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4769 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4770 & +0.5d0*(pizda(1,1)+pizda(2,2))
4771 & *fac_shield(i)*fac_shield(j)
4772 C Cartesian derivatives
4774 c ghalf1=0.5d0*agg(l,1)
4775 c ghalf2=0.5d0*agg(l,2)
4776 c ghalf3=0.5d0*agg(l,3)
4777 c ghalf4=0.5d0*agg(l,4)
4778 a_temp(1,1)=aggi(l,1)!+ghalf1
4779 a_temp(1,2)=aggi(l,2)!+ghalf2
4780 a_temp(2,1)=aggi(l,3)!+ghalf3
4781 a_temp(2,2)=aggi(l,4)!+ghalf4
4782 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4783 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4784 & +0.5d0*(pizda(1,1)+pizda(2,2))
4785 & *fac_shield(i)*fac_shield(j)
4787 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4788 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4789 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4790 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4791 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4792 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4793 & +0.5d0*(pizda(1,1)+pizda(2,2))
4794 & *fac_shield(i)*fac_shield(j)
4795 a_temp(1,1)=aggj(l,1)!+ghalf1
4796 a_temp(1,2)=aggj(l,2)!+ghalf2
4797 a_temp(2,1)=aggj(l,3)!+ghalf3
4798 a_temp(2,2)=aggj(l,4)!+ghalf4
4799 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4800 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4801 & +0.5d0*(pizda(1,1)+pizda(2,2))
4802 & *fac_shield(i)*fac_shield(j)
4803 a_temp(1,1)=aggj1(l,1)
4804 a_temp(1,2)=aggj1(l,2)
4805 a_temp(2,1)=aggj1(l,3)
4806 a_temp(2,2)=aggj1(l,4)
4807 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4808 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4809 & +0.5d0*(pizda(1,1)+pizda(2,2))
4810 & *fac_shield(i)*fac_shield(j)
4814 C-------------------------------------------------------------------------------
4815 subroutine eturn4(i,eello_turn4)
4816 C Third- and fourth-order contributions from turns
4817 implicit real*8 (a-h,o-z)
4818 include 'DIMENSIONS'
4819 include 'COMMON.IOUNITS'
4820 include 'COMMON.GEO'
4821 include 'COMMON.VAR'
4822 include 'COMMON.LOCAL'
4823 include 'COMMON.CHAIN'
4824 include 'COMMON.DERIV'
4825 include 'COMMON.INTERACT'
4826 include 'COMMON.CONTACTS'
4827 include 'COMMON.TORSION'
4828 include 'COMMON.VECTORS'
4829 include 'COMMON.FFIELD'
4830 include 'COMMON.CONTROL'
4831 include 'COMMON.SHIELD'
4833 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4834 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4835 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4836 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4837 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4838 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4839 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4840 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4841 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4842 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4843 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4846 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4848 C Fourth-order contributions
4856 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4857 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4858 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4859 c write(iout,*)"WCHODZE W PROGRAM"
4864 iti1=itype2loc(itype(i+1))
4865 iti2=itype2loc(itype(i+2))
4866 iti3=itype2loc(itype(i+3))
4867 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4868 call transpose2(EUg(1,1,i+1),e1t(1,1))
4869 call transpose2(Eug(1,1,i+2),e2t(1,1))
4870 call transpose2(Eug(1,1,i+3),e3t(1,1))
4871 C Ematrix derivative in theta
4872 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4873 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4874 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4875 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4876 c eta1 in derivative theta
4877 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4878 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4879 c auxgvec is derivative of Ub2 so i+3 theta
4880 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4881 c auxalary matrix of E i+1
4882 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4885 s1=scalar2(b1(1,i+2),auxvec(1))
4886 c derivative of theta i+2 with constant i+3
4887 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4888 c derivative of theta i+2 with constant i+2
4889 gs32=scalar2(b1(1,i+2),auxgvec(1))
4890 c derivative of E matix in theta of i+1
4891 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4893 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4894 c ea31 in derivative theta
4895 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4896 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4897 c auxilary matrix auxgvec of Ub2 with constant E matirx
4898 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4899 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4900 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4904 s2=scalar2(b1(1,i+1),auxvec(1))
4905 c derivative of theta i+1 with constant i+3
4906 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4907 c derivative of theta i+2 with constant i+1
4908 gs21=scalar2(b1(1,i+1),auxgvec(1))
4909 c derivative of theta i+3 with constant i+1
4910 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4911 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4913 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4914 c two derivatives over diffetent matrices
4915 c gtae3e2 is derivative over i+3
4916 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4917 c ae3gte2 is derivative over i+2
4918 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4919 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4920 c three possible derivative over theta E matices
4922 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4924 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4926 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4927 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4929 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4930 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4931 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4932 if (shield_mode.eq.0) then
4939 eello_turn4=eello_turn4-(s1+s2+s3)
4940 & *fac_shield(i)*fac_shield(j)
4941 eello_t4=-(s1+s2+s3)
4942 & *fac_shield(i)*fac_shield(j)
4943 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4944 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4945 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4946 C Now derivative over shield:
4947 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4948 & (shield_mode.gt.0)) then
4951 do ilist=1,ishield_list(i)
4952 iresshield=shield_list(ilist,i)
4954 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
4956 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
4958 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
4959 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
4963 do ilist=1,ishield_list(j)
4964 iresshield=shield_list(ilist,j)
4966 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
4968 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
4970 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
4971 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
4978 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
4979 & grad_shield(k,i)*eello_t4/fac_shield(i)
4980 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
4981 & grad_shield(k,j)*eello_t4/fac_shield(j)
4982 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
4983 & grad_shield(k,i)*eello_t4/fac_shield(i)
4984 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
4985 & grad_shield(k,j)*eello_t4/fac_shield(j)
4994 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4995 cd & ' eello_turn4_num',8*eello_turn4_num
4997 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4998 & -(gs13+gsE13+gsEE1)*wturn4
4999 & *fac_shield(i)*fac_shield(j)
5000 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
5001 & -(gs23+gs21+gsEE2)*wturn4
5002 & *fac_shield(i)*fac_shield(j)
5004 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
5005 & -(gs32+gsE31+gsEE3)*wturn4
5006 & *fac_shield(i)*fac_shield(j)
5008 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
5011 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5012 & 'eturn4',i,j,-(s1+s2+s3)
5013 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5014 c & ' eello_turn4_num',8*eello_turn4_num
5015 C Derivatives in gamma(i)
5016 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
5017 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
5018 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
5019 s1=scalar2(b1(1,i+2),auxvec(1))
5020 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
5021 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5022 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
5023 & *fac_shield(i)*fac_shield(j)
5024 C Derivatives in gamma(i+1)
5025 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
5026 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
5027 s2=scalar2(b1(1,i+1),auxvec(1))
5028 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5029 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5030 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5031 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
5032 & *fac_shield(i)*fac_shield(j)
5033 C Derivatives in gamma(i+2)
5034 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5035 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5036 s1=scalar2(b1(1,i+2),auxvec(1))
5037 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5038 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5039 s2=scalar2(b1(1,i+1),auxvec(1))
5040 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5041 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5042 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5043 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
5044 & *fac_shield(i)*fac_shield(j)
5045 C Cartesian derivatives
5046 C Derivatives of this turn contributions in DC(i+2)
5047 if (j.lt.nres-1) then
5049 a_temp(1,1)=agg(l,1)
5050 a_temp(1,2)=agg(l,2)
5051 a_temp(2,1)=agg(l,3)
5052 a_temp(2,2)=agg(l,4)
5053 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5054 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5055 s1=scalar2(b1(1,i+2),auxvec(1))
5056 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5057 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5058 s2=scalar2(b1(1,i+1),auxvec(1))
5059 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5060 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5061 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5063 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
5064 & *fac_shield(i)*fac_shield(j)
5067 C Remaining derivatives of this turn contribution
5069 a_temp(1,1)=aggi(l,1)
5070 a_temp(1,2)=aggi(l,2)
5071 a_temp(2,1)=aggi(l,3)
5072 a_temp(2,2)=aggi(l,4)
5073 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5074 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5075 s1=scalar2(b1(1,i+2),auxvec(1))
5076 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5077 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5078 s2=scalar2(b1(1,i+1),auxvec(1))
5079 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5080 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5081 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5082 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
5083 & *fac_shield(i)*fac_shield(j)
5084 a_temp(1,1)=aggi1(l,1)
5085 a_temp(1,2)=aggi1(l,2)
5086 a_temp(2,1)=aggi1(l,3)
5087 a_temp(2,2)=aggi1(l,4)
5088 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5089 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5090 s1=scalar2(b1(1,i+2),auxvec(1))
5091 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5092 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5093 s2=scalar2(b1(1,i+1),auxvec(1))
5094 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5095 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5096 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5097 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
5098 & *fac_shield(i)*fac_shield(j)
5099 a_temp(1,1)=aggj(l,1)
5100 a_temp(1,2)=aggj(l,2)
5101 a_temp(2,1)=aggj(l,3)
5102 a_temp(2,2)=aggj(l,4)
5103 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5104 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5105 s1=scalar2(b1(1,i+2),auxvec(1))
5106 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5107 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5108 s2=scalar2(b1(1,i+1),auxvec(1))
5109 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5110 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5111 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5112 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
5113 & *fac_shield(i)*fac_shield(j)
5114 a_temp(1,1)=aggj1(l,1)
5115 a_temp(1,2)=aggj1(l,2)
5116 a_temp(2,1)=aggj1(l,3)
5117 a_temp(2,2)=aggj1(l,4)
5118 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5119 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5120 s1=scalar2(b1(1,i+2),auxvec(1))
5121 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5122 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5123 s2=scalar2(b1(1,i+1),auxvec(1))
5124 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5125 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5126 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5127 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5128 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
5129 & *fac_shield(i)*fac_shield(j)
5133 C-----------------------------------------------------------------------------
5134 subroutine vecpr(u,v,w)
5135 implicit real*8(a-h,o-z)
5136 dimension u(3),v(3),w(3)
5137 w(1)=u(2)*v(3)-u(3)*v(2)
5138 w(2)=-u(1)*v(3)+u(3)*v(1)
5139 w(3)=u(1)*v(2)-u(2)*v(1)
5142 C-----------------------------------------------------------------------------
5143 subroutine unormderiv(u,ugrad,unorm,ungrad)
5144 C This subroutine computes the derivatives of a normalized vector u, given
5145 C the derivatives computed without normalization conditions, ugrad. Returns
5148 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
5149 double precision vec(3)
5150 double precision scalar
5152 c write (2,*) 'ugrad',ugrad
5155 vec(i)=scalar(ugrad(1,i),u(1))
5157 c write (2,*) 'vec',vec
5160 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5163 c write (2,*) 'ungrad',ungrad
5166 C-----------------------------------------------------------------------------
5167 subroutine escp_soft_sphere(evdw2,evdw2_14)
5169 C This subroutine calculates the excluded-volume interaction energy between
5170 C peptide-group centers and side chains and its gradient in virtual-bond and
5171 C side-chain vectors.
5173 implicit real*8 (a-h,o-z)
5174 include 'DIMENSIONS'
5175 include 'COMMON.GEO'
5176 include 'COMMON.VAR'
5177 include 'COMMON.LOCAL'
5178 include 'COMMON.CHAIN'
5179 include 'COMMON.DERIV'
5180 include 'COMMON.INTERACT'
5181 include 'COMMON.FFIELD'
5182 include 'COMMON.IOUNITS'
5183 include 'COMMON.CONTROL'
5188 cd print '(a)','Enter ESCP'
5189 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5193 do i=iatscp_s,iatscp_e
5194 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5196 xi=0.5D0*(c(1,i)+c(1,i+1))
5197 yi=0.5D0*(c(2,i)+c(2,i+1))
5198 zi=0.5D0*(c(3,i)+c(3,i+1))
5199 C Return atom into box, boxxsize is size of box in x dimension
5201 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5202 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5203 C Condition for being inside the proper box
5204 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5205 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5209 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5210 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5211 C Condition for being inside the proper box
5212 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5213 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5217 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5218 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5219 cC Condition for being inside the proper box
5220 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5221 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5225 if (xi.lt.0) xi=xi+boxxsize
5227 if (yi.lt.0) yi=yi+boxysize
5229 if (zi.lt.0) zi=zi+boxzsize
5230 C xi=xi+xshift*boxxsize
5231 C yi=yi+yshift*boxysize
5232 C zi=zi+zshift*boxzsize
5233 do iint=1,nscp_gr(i)
5235 do j=iscpstart(i,iint),iscpend(i,iint)
5236 if (itype(j).eq.ntyp1) cycle
5237 itypj=iabs(itype(j))
5238 C Uncomment following three lines for SC-p interactions
5242 C Uncomment following three lines for Ca-p interactions
5247 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5248 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5249 C Condition for being inside the proper box
5250 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5251 c & (xj.lt.((-0.5d0)*boxxsize))) then
5255 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5256 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5257 cC Condition for being inside the proper box
5258 c if ((yj.gt.((0.5d0)*boxysize)).or.
5259 c & (yj.lt.((-0.5d0)*boxysize))) then
5263 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5264 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5265 C Condition for being inside the proper box
5266 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5267 c & (zj.lt.((-0.5d0)*boxzsize))) then
5270 if (xj.lt.0) xj=xj+boxxsize
5272 if (yj.lt.0) yj=yj+boxysize
5274 if (zj.lt.0) zj=zj+boxzsize
5275 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5283 xj=xj_safe+xshift*boxxsize
5284 yj=yj_safe+yshift*boxysize
5285 zj=zj_safe+zshift*boxzsize
5286 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5287 if(dist_temp.lt.dist_init) then
5297 if (subchap.eq.1) then
5310 rij=xj*xj+yj*yj+zj*zj
5314 if (rij.lt.r0ijsq) then
5315 evdwij=0.25d0*(rij-r0ijsq)**2
5323 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5328 cgrad if (j.lt.i) then
5329 cd write (iout,*) 'j<i'
5330 C Uncomment following three lines for SC-p interactions
5332 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5335 cd write (iout,*) 'j>i'
5337 cgrad ggg(k)=-ggg(k)
5338 C Uncomment following line for SC-p interactions
5339 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5343 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5345 cgrad kstart=min0(i+1,j)
5346 cgrad kend=max0(i-1,j-1)
5347 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5348 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5349 cgrad do k=kstart,kend
5351 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5355 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5356 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5367 C-----------------------------------------------------------------------------
5368 subroutine escp(evdw2,evdw2_14)
5370 C This subroutine calculates the excluded-volume interaction energy between
5371 C peptide-group centers and side chains and its gradient in virtual-bond and
5372 C side-chain vectors.
5374 implicit real*8 (a-h,o-z)
5375 include 'DIMENSIONS'
5376 include 'COMMON.GEO'
5377 include 'COMMON.VAR'
5378 include 'COMMON.LOCAL'
5379 include 'COMMON.CHAIN'
5380 include 'COMMON.DERIV'
5381 include 'COMMON.INTERACT'
5382 include 'COMMON.FFIELD'
5383 include 'COMMON.IOUNITS'
5384 include 'COMMON.CONTROL'
5385 include 'COMMON.SPLITELE'
5389 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
5390 cd print '(a)','Enter ESCP'
5391 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5395 do i=iatscp_s,iatscp_e
5396 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5398 xi=0.5D0*(c(1,i)+c(1,i+1))
5399 yi=0.5D0*(c(2,i)+c(2,i+1))
5400 zi=0.5D0*(c(3,i)+c(3,i+1))
5402 if (xi.lt.0) xi=xi+boxxsize
5404 if (yi.lt.0) yi=yi+boxysize
5406 if (zi.lt.0) zi=zi+boxzsize
5407 c xi=xi+xshift*boxxsize
5408 c yi=yi+yshift*boxysize
5409 c zi=zi+zshift*boxzsize
5410 c print *,xi,yi,zi,'polozenie i'
5411 C Return atom into box, boxxsize is size of box in x dimension
5413 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5414 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5415 C Condition for being inside the proper box
5416 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5417 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5421 c print *,xi,boxxsize,"pierwszy"
5423 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5424 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5425 C Condition for being inside the proper box
5426 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5427 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5431 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5432 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5433 C Condition for being inside the proper box
5434 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5435 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5438 do iint=1,nscp_gr(i)
5440 do j=iscpstart(i,iint),iscpend(i,iint)
5441 itypj=iabs(itype(j))
5442 if (itypj.eq.ntyp1) cycle
5443 C Uncomment following three lines for SC-p interactions
5447 C Uncomment following three lines for Ca-p interactions
5452 if (xj.lt.0) xj=xj+boxxsize
5454 if (yj.lt.0) yj=yj+boxysize
5456 if (zj.lt.0) zj=zj+boxzsize
5458 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5459 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5460 C Condition for being inside the proper box
5461 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5462 c & (xj.lt.((-0.5d0)*boxxsize))) then
5466 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5467 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5468 cC Condition for being inside the proper box
5469 c if ((yj.gt.((0.5d0)*boxysize)).or.
5470 c & (yj.lt.((-0.5d0)*boxysize))) then
5474 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5475 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5476 C Condition for being inside the proper box
5477 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5478 c & (zj.lt.((-0.5d0)*boxzsize))) then
5481 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5482 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5490 xj=xj_safe+xshift*boxxsize
5491 yj=yj_safe+yshift*boxysize
5492 zj=zj_safe+zshift*boxzsize
5493 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5494 if(dist_temp.lt.dist_init) then
5504 if (subchap.eq.1) then
5513 c print *,xj,yj,zj,'polozenie j'
5514 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5516 sss=sscale(1.0d0/(dsqrt(rrij)))
5517 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5518 c if (sss.eq.0) print *,'czasem jest OK'
5519 if (sss.le.0.0d0) cycle
5520 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5522 e1=fac*fac*aad(itypj,iteli)
5523 e2=fac*bad(itypj,iteli)
5524 if (iabs(j-i) .le. 2) then
5527 evdw2_14=evdw2_14+(e1+e2)*sss
5530 evdw2=evdw2+evdwij*sss
5531 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5532 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5535 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5537 fac=-(evdwij+e1)*rrij*sss
5538 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5542 cgrad if (j.lt.i) then
5543 cd write (iout,*) 'j<i'
5544 C Uncomment following three lines for SC-p interactions
5546 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5549 cd write (iout,*) 'j>i'
5551 cgrad ggg(k)=-ggg(k)
5552 C Uncomment following line for SC-p interactions
5553 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5554 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5558 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5560 cgrad kstart=min0(i+1,j)
5561 cgrad kend=max0(i-1,j-1)
5562 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5563 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5564 cgrad do k=kstart,kend
5566 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5570 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5571 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5573 c endif !endif for sscale cutoff
5583 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5584 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5585 gradx_scp(j,i)=expon*gradx_scp(j,i)
5588 C******************************************************************************
5592 C To save time the factor EXPON has been extracted from ALL components
5593 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5596 C******************************************************************************
5599 C--------------------------------------------------------------------------
5600 subroutine edis(ehpb)
5602 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5604 implicit real*8 (a-h,o-z)
5605 include 'DIMENSIONS'
5606 include 'COMMON.SBRIDGE'
5607 include 'COMMON.CHAIN'
5608 include 'COMMON.DERIV'
5609 include 'COMMON.VAR'
5610 include 'COMMON.INTERACT'
5611 include 'COMMON.IOUNITS'
5612 include 'COMMON.CONTROL'
5618 C write (iout,*) ,"link_end",link_end,constr_dist
5619 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5620 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5621 if (link_end.eq.0) return
5622 do i=link_start,link_end
5623 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5624 C CA-CA distance used in regularization of structure.
5627 C iii and jjj point to the residues for which the distance is assigned.
5628 if (ii.gt.nres) then
5635 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5636 c & dhpb(i),dhpb1(i),forcon(i)
5637 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5638 C distance and angle dependent SS bond potential.
5639 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5640 C & iabs(itype(jjj)).eq.1) then
5641 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5642 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5643 if (.not.dyn_ss .and. i.le.nss) then
5644 C 15/02/13 CC dynamic SSbond - additional check
5645 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5646 & iabs(itype(jjj)).eq.1) then
5647 call ssbond_ene(iii,jjj,eij)
5650 cd write (iout,*) "eij",eij
5651 cd & ' waga=',waga,' fac=',fac
5652 else if (ii.gt.nres .and. jj.gt.nres) then
5653 c Restraints from contact prediction
5655 if (constr_dist.eq.11) then
5656 ehpb=ehpb+fordepth(i)**4.0d0
5657 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5658 fac=fordepth(i)**4.0d0
5659 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5660 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5661 & ehpb,fordepth(i),dd
5663 if (dhpb1(i).gt.0.0d0) then
5664 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5665 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5666 c write (iout,*) "beta nmr",
5667 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5671 C Get the force constant corresponding to this distance.
5673 C Calculate the contribution to energy.
5674 ehpb=ehpb+waga*rdis*rdis
5675 c write (iout,*) "beta reg",dd,waga*rdis*rdis
5677 C Evaluate gradient.
5683 ggg(j)=fac*(c(j,jj)-c(j,ii))
5686 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5687 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5690 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5691 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5694 C Calculate the distance between the two points and its difference from the
5697 if (constr_dist.eq.11) then
5698 ehpb=ehpb+fordepth(i)**4.0d0
5699 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5700 fac=fordepth(i)**4.0d0
5701 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5702 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5703 & ehpb,fordepth(i),dd
5705 if (dhpb1(i).gt.0.0d0) then
5706 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5707 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5708 c write (iout,*) "alph nmr",
5709 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5712 C Get the force constant corresponding to this distance.
5714 C Calculate the contribution to energy.
5715 ehpb=ehpb+waga*rdis*rdis
5716 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5718 C Evaluate gradient.
5724 ggg(j)=fac*(c(j,jj)-c(j,ii))
5726 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5727 C If this is a SC-SC distance, we need to calculate the contributions to the
5728 C Cartesian gradient in the SC vectors (ghpbx).
5731 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5732 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5735 cgrad do j=iii,jjj-1
5737 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5741 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5742 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5746 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5749 C--------------------------------------------------------------------------
5750 subroutine ssbond_ene(i,j,eij)
5752 C Calculate the distance and angle dependent SS-bond potential energy
5753 C using a free-energy function derived based on RHF/6-31G** ab initio
5754 C calculations of diethyl disulfide.
5756 C A. Liwo and U. Kozlowska, 11/24/03
5758 implicit real*8 (a-h,o-z)
5759 include 'DIMENSIONS'
5760 include 'COMMON.SBRIDGE'
5761 include 'COMMON.CHAIN'
5762 include 'COMMON.DERIV'
5763 include 'COMMON.LOCAL'
5764 include 'COMMON.INTERACT'
5765 include 'COMMON.VAR'
5766 include 'COMMON.IOUNITS'
5767 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5768 itypi=iabs(itype(i))
5772 dxi=dc_norm(1,nres+i)
5773 dyi=dc_norm(2,nres+i)
5774 dzi=dc_norm(3,nres+i)
5775 c dsci_inv=dsc_inv(itypi)
5776 dsci_inv=vbld_inv(nres+i)
5777 itypj=iabs(itype(j))
5778 c dscj_inv=dsc_inv(itypj)
5779 dscj_inv=vbld_inv(nres+j)
5783 dxj=dc_norm(1,nres+j)
5784 dyj=dc_norm(2,nres+j)
5785 dzj=dc_norm(3,nres+j)
5786 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5791 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5792 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5793 om12=dxi*dxj+dyi*dyj+dzi*dzj
5795 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5796 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5802 deltat12=om2-om1+2.0d0
5804 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5805 & +akct*deltad*deltat12
5806 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5807 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5808 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5809 c & " deltat12",deltat12," eij",eij
5810 ed=2*akcm*deltad+akct*deltat12
5812 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5813 eom1=-2*akth*deltat1-pom1-om2*pom2
5814 eom2= 2*akth*deltat2+pom1-om1*pom2
5817 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5818 ghpbx(k,i)=ghpbx(k,i)-ggk
5819 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5820 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5821 ghpbx(k,j)=ghpbx(k,j)+ggk
5822 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5823 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5824 ghpbc(k,i)=ghpbc(k,i)-ggk
5825 ghpbc(k,j)=ghpbc(k,j)+ggk
5828 C Calculate the components of the gradient in DC and X
5832 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5837 C--------------------------------------------------------------------------
5838 subroutine ebond(estr)
5840 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5842 implicit real*8 (a-h,o-z)
5843 include 'DIMENSIONS'
5844 include 'COMMON.LOCAL'
5845 include 'COMMON.GEO'
5846 include 'COMMON.INTERACT'
5847 include 'COMMON.DERIV'
5848 include 'COMMON.VAR'
5849 include 'COMMON.CHAIN'
5850 include 'COMMON.IOUNITS'
5851 include 'COMMON.NAMES'
5852 include 'COMMON.FFIELD'
5853 include 'COMMON.CONTROL'
5854 include 'COMMON.SETUP'
5855 double precision u(3),ud(3)
5858 do i=ibondp_start,ibondp_end
5859 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5860 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5862 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5863 c & *dc(j,i-1)/vbld(i)
5865 c if (energy_dec) write(iout,*)
5866 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5868 C Checking if it involves dummy (NH3+ or COO-) group
5869 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5870 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5871 diff = vbld(i)-vbldpDUM
5872 if (energy_dec) write(iout,*) "dum_bond",i,diff
5874 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5875 diff = vbld(i)-vbldp0
5877 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5878 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5881 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5883 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5887 estr=0.5d0*AKP*estr+estr1
5889 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5891 do i=ibond_start,ibond_end
5893 if (iti.ne.10 .and. iti.ne.ntyp1) then
5896 diff=vbld(i+nres)-vbldsc0(1,iti)
5897 if (energy_dec) write (iout,*)
5898 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5899 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5900 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5902 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5906 diff=vbld(i+nres)-vbldsc0(j,iti)
5907 ud(j)=aksc(j,iti)*diff
5908 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5922 uprod2=uprod2*u(k)*u(k)
5926 usumsqder=usumsqder+ud(j)*uprod2
5928 estr=estr+uprod/usum
5930 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5938 C--------------------------------------------------------------------------
5939 subroutine ebend(etheta,ethetacnstr)
5941 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5942 C angles gamma and its derivatives in consecutive thetas and gammas.
5944 implicit real*8 (a-h,o-z)
5945 include 'DIMENSIONS'
5946 include 'COMMON.LOCAL'
5947 include 'COMMON.GEO'
5948 include 'COMMON.INTERACT'
5949 include 'COMMON.DERIV'
5950 include 'COMMON.VAR'
5951 include 'COMMON.CHAIN'
5952 include 'COMMON.IOUNITS'
5953 include 'COMMON.NAMES'
5954 include 'COMMON.FFIELD'
5955 include 'COMMON.CONTROL'
5956 include 'COMMON.TORCNSTR'
5957 common /calcthet/ term1,term2,termm,diffak,ratak,
5958 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5959 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5960 double precision y(2),z(2)
5962 c time11=dexp(-2*time)
5965 c write (*,'(a,i2)') 'EBEND ICG=',icg
5966 do i=ithet_start,ithet_end
5967 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5968 & .or.itype(i).eq.ntyp1) cycle
5969 C Zero the energy function and its derivative at 0 or pi.
5970 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5972 ichir1=isign(1,itype(i-2))
5973 ichir2=isign(1,itype(i))
5974 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5975 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5976 if (itype(i-1).eq.10) then
5977 itype1=isign(10,itype(i-2))
5978 ichir11=isign(1,itype(i-2))
5979 ichir12=isign(1,itype(i-2))
5980 itype2=isign(10,itype(i))
5981 ichir21=isign(1,itype(i))
5982 ichir22=isign(1,itype(i))
5985 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5988 if (phii.ne.phii) phii=150.0
5998 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6001 if (phii1.ne.phii1) phii1=150.0
6013 C Calculate the "mean" value of theta from the part of the distribution
6014 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
6015 C In following comments this theta will be referred to as t_c.
6016 thet_pred_mean=0.0d0
6018 athetk=athet(k,it,ichir1,ichir2)
6019 bthetk=bthet(k,it,ichir1,ichir2)
6021 athetk=athet(k,itype1,ichir11,ichir12)
6022 bthetk=bthet(k,itype2,ichir21,ichir22)
6024 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
6025 c write(iout,*) 'chuj tu', y(k),z(k)
6027 dthett=thet_pred_mean*ssd
6028 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
6029 C Derivatives of the "mean" values in gamma1 and gamma2.
6030 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
6031 &+athet(2,it,ichir1,ichir2)*y(1))*ss
6032 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
6033 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
6035 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
6036 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
6037 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
6038 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
6040 if (theta(i).gt.pi-delta) then
6041 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
6043 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
6044 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6045 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
6047 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
6049 else if (theta(i).lt.delta) then
6050 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
6051 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6052 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
6054 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
6055 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
6058 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
6061 etheta=etheta+ethetai
6062 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
6063 & 'ebend',i,ethetai,theta(i),itype(i)
6064 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
6065 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
6066 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
6069 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6070 do i=ithetaconstr_start,ithetaconstr_end
6071 itheta=itheta_constr(i)
6072 thetiii=theta(itheta)
6073 difi=pinorm(thetiii-theta_constr0(i))
6074 if (difi.gt.theta_drange(i)) then
6075 difi=difi-theta_drange(i)
6076 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6077 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6078 & +for_thet_constr(i)*difi**3
6079 else if (difi.lt.-drange(i)) then
6081 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6082 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6083 & +for_thet_constr(i)*difi**3
6087 if (energy_dec) then
6088 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6089 & i,itheta,rad2deg*thetiii,
6090 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6091 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6092 & gloc(itheta+nphi-2,icg)
6096 C Ufff.... We've done all this!!!
6099 C---------------------------------------------------------------------------
6100 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
6102 implicit real*8 (a-h,o-z)
6103 include 'DIMENSIONS'
6104 include 'COMMON.LOCAL'
6105 include 'COMMON.IOUNITS'
6106 common /calcthet/ term1,term2,termm,diffak,ratak,
6107 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6108 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6109 C Calculate the contributions to both Gaussian lobes.
6110 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6111 C The "polynomial part" of the "standard deviation" of this part of
6112 C the distributioni.
6113 ccc write (iout,*) thetai,thet_pred_mean
6116 sig=sig*thet_pred_mean+polthet(j,it)
6118 C Derivative of the "interior part" of the "standard deviation of the"
6119 C gamma-dependent Gaussian lobe in t_c.
6120 sigtc=3*polthet(3,it)
6122 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6125 C Set the parameters of both Gaussian lobes of the distribution.
6126 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6127 fac=sig*sig+sigc0(it)
6130 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6131 sigsqtc=-4.0D0*sigcsq*sigtc
6132 c print *,i,sig,sigtc,sigsqtc
6133 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
6134 sigtc=-sigtc/(fac*fac)
6135 C Following variable is sigma(t_c)**(-2)
6136 sigcsq=sigcsq*sigcsq
6138 sig0inv=1.0D0/sig0i**2
6139 delthec=thetai-thet_pred_mean
6140 delthe0=thetai-theta0i
6141 term1=-0.5D0*sigcsq*delthec*delthec
6142 term2=-0.5D0*sig0inv*delthe0*delthe0
6143 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
6144 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6145 C NaNs in taking the logarithm. We extract the largest exponent which is added
6146 C to the energy (this being the log of the distribution) at the end of energy
6147 C term evaluation for this virtual-bond angle.
6148 if (term1.gt.term2) then
6150 term2=dexp(term2-termm)
6154 term1=dexp(term1-termm)
6157 C The ratio between the gamma-independent and gamma-dependent lobes of
6158 C the distribution is a Gaussian function of thet_pred_mean too.
6159 diffak=gthet(2,it)-thet_pred_mean
6160 ratak=diffak/gthet(3,it)**2
6161 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6162 C Let's differentiate it in thet_pred_mean NOW.
6164 C Now put together the distribution terms to make complete distribution.
6165 termexp=term1+ak*term2
6166 termpre=sigc+ak*sig0i
6167 C Contribution of the bending energy from this theta is just the -log of
6168 C the sum of the contributions from the two lobes and the pre-exponential
6169 C factor. Simple enough, isn't it?
6170 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6171 C write (iout,*) 'termexp',termexp,termm,termpre,i
6172 C NOW the derivatives!!!
6173 C 6/6/97 Take into account the deformation.
6174 E_theta=(delthec*sigcsq*term1
6175 & +ak*delthe0*sig0inv*term2)/termexp
6176 E_tc=((sigtc+aktc*sig0i)/termpre
6177 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
6178 & aktc*term2)/termexp)
6181 c-----------------------------------------------------------------------------
6182 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
6183 implicit real*8 (a-h,o-z)
6184 include 'DIMENSIONS'
6185 include 'COMMON.LOCAL'
6186 include 'COMMON.IOUNITS'
6187 common /calcthet/ term1,term2,termm,diffak,ratak,
6188 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6189 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6190 delthec=thetai-thet_pred_mean
6191 delthe0=thetai-theta0i
6192 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
6193 t3 = thetai-thet_pred_mean
6197 t14 = t12+t6*sigsqtc
6199 t21 = thetai-theta0i
6205 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
6206 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
6207 & *(-t12*t9-ak*sig0inv*t27)
6211 C--------------------------------------------------------------------------
6212 subroutine ebend(etheta,ethetacnstr)
6214 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6215 C angles gamma and its derivatives in consecutive thetas and gammas.
6216 C ab initio-derived potentials from
6217 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6219 implicit real*8 (a-h,o-z)
6220 include 'DIMENSIONS'
6221 include 'COMMON.LOCAL'
6222 include 'COMMON.GEO'
6223 include 'COMMON.INTERACT'
6224 include 'COMMON.DERIV'
6225 include 'COMMON.VAR'
6226 include 'COMMON.CHAIN'
6227 include 'COMMON.IOUNITS'
6228 include 'COMMON.NAMES'
6229 include 'COMMON.FFIELD'
6230 include 'COMMON.CONTROL'
6231 include 'COMMON.TORCNSTR'
6232 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
6233 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
6234 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
6235 & sinph1ph2(maxdouble,maxdouble)
6236 logical lprn /.false./, lprn1 /.false./
6238 do i=ithet_start,ithet_end
6239 c print *,i,itype(i-1),itype(i),itype(i-2)
6240 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6241 & .or.itype(i).eq.ntyp1) cycle
6242 C print *,i,theta(i)
6243 if (iabs(itype(i+1)).eq.20) iblock=2
6244 if (iabs(itype(i+1)).ne.20) iblock=1
6248 theti2=0.5d0*theta(i)
6249 ityp2=ithetyp((itype(i-1)))
6251 coskt(k)=dcos(k*theti2)
6252 sinkt(k)=dsin(k*theti2)
6255 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
6258 if (phii.ne.phii) phii=150.0
6262 ityp1=ithetyp((itype(i-2)))
6263 C propagation of chirality for glycine type
6265 cosph1(k)=dcos(k*phii)
6266 sinph1(k)=dsin(k*phii)
6271 ityp1=ithetyp((itype(i-2)))
6276 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6279 if (phii1.ne.phii1) phii1=150.0
6284 ityp3=ithetyp((itype(i)))
6286 cosph2(k)=dcos(k*phii1)
6287 sinph2(k)=dsin(k*phii1)
6291 ityp3=ithetyp((itype(i)))
6297 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
6300 ccl=cosph1(l)*cosph2(k-l)
6301 ssl=sinph1(l)*sinph2(k-l)
6302 scl=sinph1(l)*cosph2(k-l)
6303 csl=cosph1(l)*sinph2(k-l)
6304 cosph1ph2(l,k)=ccl-ssl
6305 cosph1ph2(k,l)=ccl+ssl
6306 sinph1ph2(l,k)=scl+csl
6307 sinph1ph2(k,l)=scl-csl
6311 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
6312 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6313 write (iout,*) "coskt and sinkt"
6315 write (iout,*) k,coskt(k),sinkt(k)
6319 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6320 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
6323 & write (iout,*) "k",k,"
6324 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
6325 & " ethetai",ethetai
6328 write (iout,*) "cosph and sinph"
6330 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6332 write (iout,*) "cosph1ph2 and sinph2ph2"
6335 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6336 & sinph1ph2(l,k),sinph1ph2(k,l)
6339 write(iout,*) "ethetai",ethetai
6344 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
6345 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
6346 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
6347 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6348 ethetai=ethetai+sinkt(m)*aux
6349 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6350 dephii=dephii+k*sinkt(m)*(
6351 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
6352 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6353 dephii1=dephii1+k*sinkt(m)*(
6354 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
6355 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6357 & write (iout,*) "m",m," k",k," bbthet",
6358 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
6359 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
6360 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
6361 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6362 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6365 C print *,"cosph1", (cosph1(k), k=1,nsingle)
6366 C print *,"cosph2", (cosph2(k), k=1,nsingle)
6367 C print *,"sinph1", (sinph1(k), k=1,nsingle)
6368 C print *,"sinph2", (sinph2(k), k=1,nsingle)
6370 & write(iout,*) "ethetai",ethetai
6371 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6375 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6376 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
6377 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6378 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6379 ethetai=ethetai+sinkt(m)*aux
6380 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6381 dephii=dephii+l*sinkt(m)*(
6382 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
6383 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6384 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6385 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6386 dephii1=dephii1+(k-l)*sinkt(m)*(
6387 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6388 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6389 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
6390 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6392 write (iout,*) "m",m," k",k," l",l," ffthet",
6393 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6394 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
6395 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6396 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
6397 & " ethetai",ethetai
6398 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6399 & cosph1ph2(k,l)*sinkt(m),
6400 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6409 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6410 & i,theta(i)*rad2deg,phii*rad2deg,
6411 & phii1*rad2deg,ethetai
6413 etheta=etheta+ethetai
6414 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6415 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6416 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
6420 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6421 do i=ithetaconstr_start,ithetaconstr_end
6422 itheta=itheta_constr(i)
6423 thetiii=theta(itheta)
6424 difi=pinorm(thetiii-theta_constr0(i))
6425 if (difi.gt.theta_drange(i)) then
6426 difi=difi-theta_drange(i)
6427 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6428 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6429 & +for_thet_constr(i)*difi**3
6430 else if (difi.lt.-drange(i)) then
6432 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6433 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6434 & +for_thet_constr(i)*difi**3
6438 if (energy_dec) then
6439 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6440 & i,itheta,rad2deg*thetiii,
6441 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6442 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6443 & gloc(itheta+nphi-2,icg)
6451 c-----------------------------------------------------------------------------
6452 subroutine esc(escloc)
6453 C Calculate the local energy of a side chain and its derivatives in the
6454 C corresponding virtual-bond valence angles THETA and the spherical angles
6456 implicit real*8 (a-h,o-z)
6457 include 'DIMENSIONS'
6458 include 'COMMON.GEO'
6459 include 'COMMON.LOCAL'
6460 include 'COMMON.VAR'
6461 include 'COMMON.INTERACT'
6462 include 'COMMON.DERIV'
6463 include 'COMMON.CHAIN'
6464 include 'COMMON.IOUNITS'
6465 include 'COMMON.NAMES'
6466 include 'COMMON.FFIELD'
6467 include 'COMMON.CONTROL'
6468 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6469 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6470 common /sccalc/ time11,time12,time112,theti,it,nlobit
6473 c write (iout,'(a)') 'ESC'
6474 do i=loc_start,loc_end
6476 if (it.eq.ntyp1) cycle
6477 if (it.eq.10) goto 1
6478 nlobit=nlob(iabs(it))
6479 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6480 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6481 theti=theta(i+1)-pipol
6486 if (x(2).gt.pi-delta) then
6490 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6492 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6493 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6495 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6496 & ddersc0(1),dersc(1))
6497 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6498 & ddersc0(3),dersc(3))
6500 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6502 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6503 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6504 & dersc0(2),esclocbi,dersc02)
6505 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6507 call splinthet(x(2),0.5d0*delta,ss,ssd)
6512 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6514 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6515 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6517 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6519 c write (iout,*) escloci
6520 else if (x(2).lt.delta) then
6524 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6526 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6527 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6529 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6530 & ddersc0(1),dersc(1))
6531 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6532 & ddersc0(3),dersc(3))
6534 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6536 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6537 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6538 & dersc0(2),esclocbi,dersc02)
6539 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6544 call splinthet(x(2),0.5d0*delta,ss,ssd)
6546 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6548 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6549 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6551 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6552 c write (iout,*) escloci
6554 call enesc(x,escloci,dersc,ddummy,.false.)
6557 escloc=escloc+escloci
6558 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6559 & 'escloc',i,escloci
6560 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6562 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6564 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6565 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6570 C---------------------------------------------------------------------------
6571 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6572 implicit real*8 (a-h,o-z)
6573 include 'DIMENSIONS'
6574 include 'COMMON.GEO'
6575 include 'COMMON.LOCAL'
6576 include 'COMMON.IOUNITS'
6577 common /sccalc/ time11,time12,time112,theti,it,nlobit
6578 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6579 double precision contr(maxlob,-1:1)
6581 c write (iout,*) 'it=',it,' nlobit=',nlobit
6585 if (mixed) ddersc(j)=0.0d0
6589 C Because of periodicity of the dependence of the SC energy in omega we have
6590 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6591 C To avoid underflows, first compute & store the exponents.
6599 z(k)=x(k)-censc(k,j,it)
6604 Axk=Axk+gaussc(l,k,j,it)*z(l)
6610 expfac=expfac+Ax(k,j,iii)*z(k)
6618 C As in the case of ebend, we want to avoid underflows in exponentiation and
6619 C subsequent NaNs and INFs in energy calculation.
6620 C Find the largest exponent
6624 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6628 cd print *,'it=',it,' emin=',emin
6630 C Compute the contribution to SC energy and derivatives
6635 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6636 if(adexp.ne.adexp) adexp=1.0
6639 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6641 cd print *,'j=',j,' expfac=',expfac
6642 escloc_i=escloc_i+expfac
6644 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6648 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6649 & +gaussc(k,2,j,it))*expfac
6656 dersc(1)=dersc(1)/cos(theti)**2
6657 ddersc(1)=ddersc(1)/cos(theti)**2
6660 escloci=-(dlog(escloc_i)-emin)
6662 dersc(j)=dersc(j)/escloc_i
6666 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6671 C------------------------------------------------------------------------------
6672 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6673 implicit real*8 (a-h,o-z)
6674 include 'DIMENSIONS'
6675 include 'COMMON.GEO'
6676 include 'COMMON.LOCAL'
6677 include 'COMMON.IOUNITS'
6678 common /sccalc/ time11,time12,time112,theti,it,nlobit
6679 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6680 double precision contr(maxlob)
6691 z(k)=x(k)-censc(k,j,it)
6697 Axk=Axk+gaussc(l,k,j,it)*z(l)
6703 expfac=expfac+Ax(k,j)*z(k)
6708 C As in the case of ebend, we want to avoid underflows in exponentiation and
6709 C subsequent NaNs and INFs in energy calculation.
6710 C Find the largest exponent
6713 if (emin.gt.contr(j)) emin=contr(j)
6717 C Compute the contribution to SC energy and derivatives
6721 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6722 escloc_i=escloc_i+expfac
6724 dersc(k)=dersc(k)+Ax(k,j)*expfac
6726 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6727 & +gaussc(1,2,j,it))*expfac
6731 dersc(1)=dersc(1)/cos(theti)**2
6732 dersc12=dersc12/cos(theti)**2
6733 escloci=-(dlog(escloc_i)-emin)
6735 dersc(j)=dersc(j)/escloc_i
6737 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6741 c----------------------------------------------------------------------------------
6742 subroutine esc(escloc)
6743 C Calculate the local energy of a side chain and its derivatives in the
6744 C corresponding virtual-bond valence angles THETA and the spherical angles
6745 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6746 C added by Urszula Kozlowska. 07/11/2007
6748 implicit real*8 (a-h,o-z)
6749 include 'DIMENSIONS'
6750 include 'COMMON.GEO'
6751 include 'COMMON.LOCAL'
6752 include 'COMMON.VAR'
6753 include 'COMMON.SCROT'
6754 include 'COMMON.INTERACT'
6755 include 'COMMON.DERIV'
6756 include 'COMMON.CHAIN'
6757 include 'COMMON.IOUNITS'
6758 include 'COMMON.NAMES'
6759 include 'COMMON.FFIELD'
6760 include 'COMMON.CONTROL'
6761 include 'COMMON.VECTORS'
6762 double precision x_prime(3),y_prime(3),z_prime(3)
6763 & , sumene,dsc_i,dp2_i,x(65),
6764 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6765 & de_dxx,de_dyy,de_dzz,de_dt
6766 double precision s1_t,s1_6_t,s2_t,s2_6_t
6768 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6769 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6770 & dt_dCi(3),dt_dCi1(3)
6771 common /sccalc/ time11,time12,time112,theti,it,nlobit
6774 do i=loc_start,loc_end
6775 if (itype(i).eq.ntyp1) cycle
6776 costtab(i+1) =dcos(theta(i+1))
6777 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6778 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6779 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6780 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6781 cosfac=dsqrt(cosfac2)
6782 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6783 sinfac=dsqrt(sinfac2)
6785 if (it.eq.10) goto 1
6787 C Compute the axes of tghe local cartesian coordinates system; store in
6788 c x_prime, y_prime and z_prime
6795 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6796 C & dc_norm(3,i+nres)
6798 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6799 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6802 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6805 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6806 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6807 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6808 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6809 c & " xy",scalar(x_prime(1),y_prime(1)),
6810 c & " xz",scalar(x_prime(1),z_prime(1)),
6811 c & " yy",scalar(y_prime(1),y_prime(1)),
6812 c & " yz",scalar(y_prime(1),z_prime(1)),
6813 c & " zz",scalar(z_prime(1),z_prime(1))
6815 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6816 C to local coordinate system. Store in xx, yy, zz.
6822 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6823 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6824 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6831 C Compute the energy of the ith side cbain
6833 c write (2,*) "xx",xx," yy",yy," zz",zz
6836 x(j) = sc_parmin(j,it)
6839 Cc diagnostics - remove later
6841 yy1 = dsin(alph(2))*dcos(omeg(2))
6842 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6843 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6844 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6846 C," --- ", xx_w,yy_w,zz_w
6849 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6850 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6852 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6853 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6855 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6856 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6857 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6858 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6859 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6861 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6862 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6863 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6864 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6865 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6867 dsc_i = 0.743d0+x(61)
6869 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6870 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6871 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6872 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6873 s1=(1+x(63))/(0.1d0 + dscp1)
6874 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6875 s2=(1+x(65))/(0.1d0 + dscp2)
6876 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6877 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6878 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6879 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6881 c & dscp1,dscp2,sumene
6882 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6883 escloc = escloc + sumene
6884 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6889 C This section to check the numerical derivatives of the energy of ith side
6890 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6891 C #define DEBUG in the code to turn it on.
6893 write (2,*) "sumene =",sumene
6897 write (2,*) xx,yy,zz
6898 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6899 de_dxx_num=(sumenep-sumene)/aincr
6901 write (2,*) "xx+ sumene from enesc=",sumenep
6904 write (2,*) xx,yy,zz
6905 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6906 de_dyy_num=(sumenep-sumene)/aincr
6908 write (2,*) "yy+ sumene from enesc=",sumenep
6911 write (2,*) xx,yy,zz
6912 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6913 de_dzz_num=(sumenep-sumene)/aincr
6915 write (2,*) "zz+ sumene from enesc=",sumenep
6916 costsave=cost2tab(i+1)
6917 sintsave=sint2tab(i+1)
6918 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6919 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6920 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6921 de_dt_num=(sumenep-sumene)/aincr
6922 write (2,*) " t+ sumene from enesc=",sumenep
6923 cost2tab(i+1)=costsave
6924 sint2tab(i+1)=sintsave
6925 C End of diagnostics section.
6928 C Compute the gradient of esc
6930 c zz=zz*dsign(1.0,dfloat(itype(i)))
6931 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6932 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6933 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6934 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6935 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6936 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6937 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6938 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6939 pom1=(sumene3*sint2tab(i+1)+sumene1)
6940 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6941 pom2=(sumene4*cost2tab(i+1)+sumene2)
6942 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6943 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6944 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6945 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6947 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6948 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6949 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6951 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6952 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6953 & +(pom1+pom2)*pom_dx
6955 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6958 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6959 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6960 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6962 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6963 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6964 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6965 & +x(59)*zz**2 +x(60)*xx*zz
6966 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6967 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6968 & +(pom1-pom2)*pom_dy
6970 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6973 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6974 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6975 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6976 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6977 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6978 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6979 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6980 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6982 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6985 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6986 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6987 & +pom1*pom_dt1+pom2*pom_dt2
6989 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6994 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6995 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6996 cosfac2xx=cosfac2*xx
6997 sinfac2yy=sinfac2*yy
6999 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
7001 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
7003 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
7004 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
7005 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
7006 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
7007 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
7008 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
7009 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
7010 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
7011 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
7012 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
7016 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
7017 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
7018 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
7019 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
7022 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
7023 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
7024 dZZ_XYZ(k)=vbld_inv(i+nres)*
7025 & (z_prime(k)-zz*dC_norm(k,i+nres))
7027 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
7028 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
7032 dXX_Ctab(k,i)=dXX_Ci(k)
7033 dXX_C1tab(k,i)=dXX_Ci1(k)
7034 dYY_Ctab(k,i)=dYY_Ci(k)
7035 dYY_C1tab(k,i)=dYY_Ci1(k)
7036 dZZ_Ctab(k,i)=dZZ_Ci(k)
7037 dZZ_C1tab(k,i)=dZZ_Ci1(k)
7038 dXX_XYZtab(k,i)=dXX_XYZ(k)
7039 dYY_XYZtab(k,i)=dYY_XYZ(k)
7040 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
7044 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
7045 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
7046 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
7047 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
7048 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
7050 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
7051 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
7052 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
7053 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
7054 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
7055 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
7056 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
7057 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
7059 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
7060 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
7062 C to check gradient call subroutine check_grad
7068 c------------------------------------------------------------------------------
7069 double precision function enesc(x,xx,yy,zz,cost2,sint2)
7071 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
7072 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
7073 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7074 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7076 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7077 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7079 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7080 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7081 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7082 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7083 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7085 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7086 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7087 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7088 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7089 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7091 dsc_i = 0.743d0+x(61)
7093 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7094 & *(xx*cost2+yy*sint2))
7095 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7096 & *(xx*cost2-yy*sint2))
7097 s1=(1+x(63))/(0.1d0 + dscp1)
7098 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7099 s2=(1+x(65))/(0.1d0 + dscp2)
7100 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7101 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
7102 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
7107 c------------------------------------------------------------------------------
7108 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
7110 C This procedure calculates two-body contact function g(rij) and its derivative:
7113 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
7116 C where x=(rij-r0ij)/delta
7118 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
7121 double precision rij,r0ij,eps0ij,fcont,fprimcont
7122 double precision x,x2,x4,delta
7126 if (x.lt.-1.0D0) then
7129 else if (x.le.1.0D0) then
7132 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
7133 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7140 c------------------------------------------------------------------------------
7141 subroutine splinthet(theti,delta,ss,ssder)
7142 implicit real*8 (a-h,o-z)
7143 include 'DIMENSIONS'
7144 include 'COMMON.VAR'
7145 include 'COMMON.GEO'
7148 if (theti.gt.pipol) then
7149 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7151 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7156 c------------------------------------------------------------------------------
7157 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7159 double precision x,x0,delta,f0,f1,fprim0,f,fprim
7160 double precision ksi,ksi2,ksi3,a1,a2,a3
7161 a1=fprim0*delta/(f1-f0)
7167 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7168 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7171 c------------------------------------------------------------------------------
7172 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7174 double precision x,x0,delta,f0x,f1x,fprim0x,fx
7175 double precision ksi,ksi2,ksi3,a1,a2,a3
7180 a2=3*(f1x-f0x)-2*fprim0x*delta
7181 a3=fprim0x*delta-2*(f1x-f0x)
7182 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7185 C-----------------------------------------------------------------------------
7187 C-----------------------------------------------------------------------------
7188 subroutine etor(etors,edihcnstr)
7189 implicit real*8 (a-h,o-z)
7190 include 'DIMENSIONS'
7191 include 'COMMON.VAR'
7192 include 'COMMON.GEO'
7193 include 'COMMON.LOCAL'
7194 include 'COMMON.TORSION'
7195 include 'COMMON.INTERACT'
7196 include 'COMMON.DERIV'
7197 include 'COMMON.CHAIN'
7198 include 'COMMON.NAMES'
7199 include 'COMMON.IOUNITS'
7200 include 'COMMON.FFIELD'
7201 include 'COMMON.TORCNSTR'
7202 include 'COMMON.CONTROL'
7204 C Set lprn=.true. for debugging
7208 do i=iphi_start,iphi_end
7210 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7211 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7212 itori=itortyp(itype(i-2))
7213 itori1=itortyp(itype(i-1))
7216 C Proline-Proline pair is a special case...
7217 if (itori.eq.3 .and. itori1.eq.3) then
7218 if (phii.gt.-dwapi3) then
7220 fac=1.0D0/(1.0D0-cosphi)
7221 etorsi=v1(1,3,3)*fac
7222 etorsi=etorsi+etorsi
7223 etors=etors+etorsi-v1(1,3,3)
7224 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
7225 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7228 v1ij=v1(j+1,itori,itori1)
7229 v2ij=v2(j+1,itori,itori1)
7232 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7233 if (energy_dec) etors_ii=etors_ii+
7234 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7235 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7239 v1ij=v1(j,itori,itori1)
7240 v2ij=v2(j,itori,itori1)
7243 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7244 if (energy_dec) etors_ii=etors_ii+
7245 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7246 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7249 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7252 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7253 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7254 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7255 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7256 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7258 ! 6/20/98 - dihedral angle constraints
7261 itori=idih_constr(i)
7264 if (difi.gt.drange(i)) then
7266 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7267 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7268 else if (difi.lt.-drange(i)) then
7270 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
7271 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7273 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
7274 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7276 ! write (iout,*) 'edihcnstr',edihcnstr
7279 c------------------------------------------------------------------------------
7280 subroutine etor_d(etors_d)
7284 c----------------------------------------------------------------------------
7286 subroutine etor(etors,edihcnstr)
7287 implicit real*8 (a-h,o-z)
7288 include 'DIMENSIONS'
7289 include 'COMMON.VAR'
7290 include 'COMMON.GEO'
7291 include 'COMMON.LOCAL'
7292 include 'COMMON.TORSION'
7293 include 'COMMON.INTERACT'
7294 include 'COMMON.DERIV'
7295 include 'COMMON.CHAIN'
7296 include 'COMMON.NAMES'
7297 include 'COMMON.IOUNITS'
7298 include 'COMMON.FFIELD'
7299 include 'COMMON.TORCNSTR'
7300 include 'COMMON.CONTROL'
7302 C Set lprn=.true. for debugging
7306 do i=iphi_start,iphi_end
7307 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7308 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7309 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7310 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7311 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7312 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7313 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7314 C For introducing the NH3+ and COO- group please check the etor_d for reference
7317 if (iabs(itype(i)).eq.20) then
7322 itori=itortyp(itype(i-2))
7323 itori1=itortyp(itype(i-1))
7326 C Regular cosine and sine terms
7327 do j=1,nterm(itori,itori1,iblock)
7328 v1ij=v1(j,itori,itori1,iblock)
7329 v2ij=v2(j,itori,itori1,iblock)
7332 etors=etors+v1ij*cosphi+v2ij*sinphi
7333 if (energy_dec) etors_ii=etors_ii+
7334 & v1ij*cosphi+v2ij*sinphi
7335 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7339 C E = SUM ----------------------------------- - v1
7340 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7342 cosphi=dcos(0.5d0*phii)
7343 sinphi=dsin(0.5d0*phii)
7344 do j=1,nlor(itori,itori1,iblock)
7345 vl1ij=vlor1(j,itori,itori1)
7346 vl2ij=vlor2(j,itori,itori1)
7347 vl3ij=vlor3(j,itori,itori1)
7348 pom=vl2ij*cosphi+vl3ij*sinphi
7349 pom1=1.0d0/(pom*pom+1.0d0)
7350 etors=etors+vl1ij*pom1
7351 if (energy_dec) etors_ii=etors_ii+
7354 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7356 C Subtract the constant term
7357 etors=etors-v0(itori,itori1,iblock)
7358 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7359 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
7361 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7362 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7363 & (v1(j,itori,itori1,iblock),j=1,6),
7364 & (v2(j,itori,itori1,iblock),j=1,6)
7365 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7366 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7368 ! 6/20/98 - dihedral angle constraints
7370 c do i=1,ndih_constr
7371 do i=idihconstr_start,idihconstr_end
7372 itori=idih_constr(i)
7374 difi=pinorm(phii-phi0(i))
7375 if (difi.gt.drange(i)) then
7377 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7378 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7379 else if (difi.lt.-drange(i)) then
7381 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7382 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7386 if (energy_dec) then
7387 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
7388 & i,itori,rad2deg*phii,
7389 & rad2deg*phi0(i), rad2deg*drange(i),
7390 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
7393 cd write (iout,*) 'edihcnstr',edihcnstr
7396 c----------------------------------------------------------------------------
7397 subroutine etor_d(etors_d)
7398 C 6/23/01 Compute double torsional energy
7399 implicit real*8 (a-h,o-z)
7400 include 'DIMENSIONS'
7401 include 'COMMON.VAR'
7402 include 'COMMON.GEO'
7403 include 'COMMON.LOCAL'
7404 include 'COMMON.TORSION'
7405 include 'COMMON.INTERACT'
7406 include 'COMMON.DERIV'
7407 include 'COMMON.CHAIN'
7408 include 'COMMON.NAMES'
7409 include 'COMMON.IOUNITS'
7410 include 'COMMON.FFIELD'
7411 include 'COMMON.TORCNSTR'
7413 C Set lprn=.true. for debugging
7417 c write(iout,*) "a tu??"
7418 do i=iphid_start,iphid_end
7419 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7420 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7421 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7422 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7423 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7424 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7425 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7426 & (itype(i+1).eq.ntyp1)) cycle
7427 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7428 itori=itortyp(itype(i-2))
7429 itori1=itortyp(itype(i-1))
7430 itori2=itortyp(itype(i))
7436 if (iabs(itype(i+1)).eq.20) iblock=2
7437 C Iblock=2 Proline type
7438 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7439 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7440 C if (itype(i+1).eq.ntyp1) iblock=3
7441 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7442 C IS or IS NOT need for this
7443 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7444 C is (itype(i-3).eq.ntyp1) ntblock=2
7445 C ntblock is N-terminal blocking group
7447 C Regular cosine and sine terms
7448 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7449 C Example of changes for NH3+ blocking group
7450 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7451 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7452 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7453 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7454 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7455 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7456 cosphi1=dcos(j*phii)
7457 sinphi1=dsin(j*phii)
7458 cosphi2=dcos(j*phii1)
7459 sinphi2=dsin(j*phii1)
7460 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7461 & v2cij*cosphi2+v2sij*sinphi2
7462 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7463 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7465 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7467 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7468 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7469 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7470 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7471 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7472 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7473 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7474 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7475 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7476 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7477 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7478 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7479 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7480 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7483 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7484 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7489 C----------------------------------------------------------------------------------
7490 C The rigorous attempt to derive energy function
7491 subroutine etor_kcc(etors,edihcnstr)
7492 implicit real*8 (a-h,o-z)
7493 include 'DIMENSIONS'
7494 include 'COMMON.VAR'
7495 include 'COMMON.GEO'
7496 include 'COMMON.LOCAL'
7497 include 'COMMON.TORSION'
7498 include 'COMMON.INTERACT'
7499 include 'COMMON.DERIV'
7500 include 'COMMON.CHAIN'
7501 include 'COMMON.NAMES'
7502 include 'COMMON.IOUNITS'
7503 include 'COMMON.FFIELD'
7504 include 'COMMON.TORCNSTR'
7505 include 'COMMON.CONTROL'
7507 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
7508 C Set lprn=.true. for debugging
7511 C print *,"wchodze kcc"
7512 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
7513 if (tor_mode.ne.2) then
7516 do i=iphi_start,iphi_end
7517 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7518 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7519 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7520 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7521 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7522 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7523 itori=itortyp_kcc(itype(i-2))
7524 itori1=itortyp_kcc(itype(i-1))
7529 sumnonchebyshev=0.0d0
7531 C to avoid multiple devision by 2
7532 c theti22=0.5d0*theta(i)
7533 C theta 12 is the theta_1 /2
7534 C theta 22 is theta_2 /2
7535 c theti12=0.5d0*theta(i-1)
7536 C and appropriate sinus function
7537 sinthet1=dsin(theta(i-1))
7538 sinthet2=dsin(theta(i))
7539 costhet1=dcos(theta(i-1))
7540 costhet2=dcos(theta(i))
7541 c Cosines of halves thetas
7542 costheti12=0.5d0*(1.0d0+costhet1)
7543 costheti22=0.5d0*(1.0d0+costhet2)
7544 C to speed up lets store its mutliplication
7545 sint1t2=sinthet2*sinthet1
7547 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
7548 C +d_n*sin(n*gamma)) *
7549 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
7550 C we have two sum 1) Non-Chebyshev which is with n and gamma
7552 do j=1,nterm_kcc(itori,itori1)
7554 nval=nterm_kcc_Tb(itori,itori1)
7555 v1ij=v1_kcc(j,itori,itori1)
7556 v2ij=v2_kcc(j,itori,itori1)
7557 c write (iout,*) "i",i," j",j," v1",v1ij," v2",v2ij
7558 C v1ij is c_n and d_n in euation above
7562 sint1t2n=sint1t2n*sint1t2
7563 sumth1tyb1=tschebyshev(1,nval,v11_chyb(1,j,itori,itori1),
7565 gradth1tyb1=-0.5d0*sinthet1*gradtschebyshev(0,nval-1,
7566 & v11_chyb(1,j,itori,itori1),costheti12)
7567 c write (iout,*) "v11",(v11_chyb(k,j,itori,itori1),k=1,nval),
7568 c & " sumth1tyb1",sumth1tyb1," gradth1tyb1",gradth1tyb1
7569 sumth2tyb1=tschebyshev(1,nval,v21_chyb(1,j,itori,itori1),
7571 gradth2tyb1=-0.5d0*sinthet2*gradtschebyshev(0,nval-1,
7572 & v21_chyb(1,j,itori,itori1),costheti22)
7573 c write (iout,*) "v21",(v21_chyb(k,j,itori,itori1),k=1,nval),
7574 c & " sumth2tyb1",sumth2tyb1," gradth2tyb1",gradth2tyb1
7575 sumth1tyb2=tschebyshev(1,nval,v12_chyb(1,j,itori,itori1),
7577 gradth1tyb2=-0.5d0*sinthet1*gradtschebyshev(0,nval-1,
7578 & v12_chyb(1,j,itori,itori1),costheti12)
7579 c write (iout,*) "v12",(v12_chyb(k,j,itori,itori1),k=1,nval),
7580 c & " sumth1tyb2",sumth1tyb2," gradth1tyb2",gradth1tyb2
7581 sumth2tyb2=tschebyshev(1,nval,v22_chyb(1,j,itori,itori1),
7583 gradth2tyb2=-0.5d0*sinthet2*gradtschebyshev(0,nval-1,
7584 & v22_chyb(1,j,itori,itori1),costheti22)
7585 c write (iout,*) "v22",(v22_chyb(k,j,itori,itori1),k=1,nval),
7586 c & " sumth2tyb2",sumth2tyb2," gradth2tyb2",gradth2tyb2
7587 C etors=etors+sint1t2n*(v1ij*cosphi+v2ij*sinphi)
7588 C if (energy_dec) etors_ii=etors_ii+
7589 C & v1ij*cosphi+v2ij*sinphi
7590 C glocig is the gradient local i site in gamma
7591 actval1=v1ij*cosphi*(1.0d0+sumth1tyb1+sumth2tyb1)
7592 actval2=v2ij*sinphi*(1.0d0+sumth1tyb2+sumth2tyb2)
7593 etori=etori+sint1t2n*(actval1+actval2)
7595 & j*sint1t2n*(v2ij*cosphi*(1.0d0+sumth1tyb2+sumth2tyb2)
7596 & -v1ij*sinphi*(1.0d0+sumth1tyb1+sumth2tyb1))
7597 C now gradient over theta_1
7599 & j*sint1t2n1*costhet1*sinthet2*(actval1+actval2)+
7600 & sint1t2n*(v1ij*cosphi*gradth1tyb1+v2ij*sinphi*gradth1tyb2)
7602 & j*sint1t2n1*sinthet1*costhet2*(actval1+actval2)+
7603 & sint1t2n*(v1ij*cosphi*gradth2tyb1+v2ij*sinphi*gradth2tyb2)
7605 C now the Czebyshev polinominal sum
7606 c do k=1,nterm_kcc_Tb(itori,itori1)
7607 c thybt1(k)=v1_chyb(k,j,itori,itori1)
7608 c thybt2(k)=v2_chyb(k,j,itori,itori1)
7612 C print *, sumth1thyb, gradthybt1, sumth2thyb, gradthybt2,
7614 C & (0,nterm_kcc_Tb(itori,itori1)-1,thybt2(1),
7615 C & dcos(theti22)**2),
7618 C now overal sumation
7619 C print *,"sumnon", sumnonchebyshev,sumth1thyb+sumth2thyb
7622 C derivative over gamma
7623 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
7624 C derivative over theta1
7625 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
7626 C now derivative over theta2
7627 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
7629 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
7630 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
7632 C gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7633 ! 6/20/98 - dihedral angle constraints
7634 if (tor_mode.ne.2) then
7636 c do i=1,ndih_constr
7637 do i=idihconstr_start,idihconstr_end
7638 itori=idih_constr(i)
7640 difi=pinorm(phii-phi0(i))
7641 if (difi.gt.drange(i)) then
7643 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7644 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7645 else if (difi.lt.-drange(i)) then
7647 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7648 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7657 C The rigorous attempt to derive energy function
7658 subroutine ebend_kcc(etheta,ethetacnstr)
7660 implicit real*8 (a-h,o-z)
7661 include 'DIMENSIONS'
7662 include 'COMMON.VAR'
7663 include 'COMMON.GEO'
7664 include 'COMMON.LOCAL'
7665 include 'COMMON.TORSION'
7666 include 'COMMON.INTERACT'
7667 include 'COMMON.DERIV'
7668 include 'COMMON.CHAIN'
7669 include 'COMMON.NAMES'
7670 include 'COMMON.IOUNITS'
7671 include 'COMMON.FFIELD'
7672 include 'COMMON.TORCNSTR'
7673 include 'COMMON.CONTROL'
7675 double precision thybt1(maxtermkcc)
7676 C Set lprn=.true. for debugging
7679 C print *,"wchodze kcc"
7680 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
7681 if (tor_mode.ne.2) etheta=0.0D0
7682 do i=ithet_start,ithet_end
7683 c print *,i,itype(i-1),itype(i),itype(i-2)
7684 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
7685 & .or.itype(i).eq.ntyp1) cycle
7686 iti=itortyp_kcc(itype(i-1))
7687 sinthet=dsin(theta(i)/2.0d0)
7688 costhet=dcos(theta(i)/2.0d0)
7689 do j=1,nbend_kcc_Tb(iti)
7690 thybt1(j)=v1bend_chyb(j,iti)
7692 sumth1thyb=tschebyshev
7693 & (1,nbend_kcc_Tb(iti),thybt1(1),costhet)
7694 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
7696 ihelp=nbend_kcc_Tb(iti)-1
7697 gradthybt1=gradtschebyshev
7698 & (0,ihelp,thybt1(1),costhet)
7699 etheta=etheta+sumth1thyb
7700 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
7701 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*
7702 & gradthybt1*sinthet*(-0.5d0)
7704 if (tor_mode.ne.2) then
7706 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
7707 do i=ithetaconstr_start,ithetaconstr_end
7708 itheta=itheta_constr(i)
7709 thetiii=theta(itheta)
7710 difi=pinorm(thetiii-theta_constr0(i))
7711 if (difi.gt.theta_drange(i)) then
7712 difi=difi-theta_drange(i)
7713 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7714 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7715 & +for_thet_constr(i)*difi**3
7716 else if (difi.lt.-drange(i)) then
7718 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7719 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7720 & +for_thet_constr(i)*difi**3
7724 if (energy_dec) then
7725 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
7726 & i,itheta,rad2deg*thetiii,
7727 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
7728 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
7729 & gloc(itheta+nphi-2,icg)
7735 c------------------------------------------------------------------------------
7736 subroutine eback_sc_corr(esccor)
7737 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7738 c conformational states; temporarily implemented as differences
7739 c between UNRES torsional potentials (dependent on three types of
7740 c residues) and the torsional potentials dependent on all 20 types
7741 c of residues computed from AM1 energy surfaces of terminally-blocked
7742 c amino-acid residues.
7743 implicit real*8 (a-h,o-z)
7744 include 'DIMENSIONS'
7745 include 'COMMON.VAR'
7746 include 'COMMON.GEO'
7747 include 'COMMON.LOCAL'
7748 include 'COMMON.TORSION'
7749 include 'COMMON.SCCOR'
7750 include 'COMMON.INTERACT'
7751 include 'COMMON.DERIV'
7752 include 'COMMON.CHAIN'
7753 include 'COMMON.NAMES'
7754 include 'COMMON.IOUNITS'
7755 include 'COMMON.FFIELD'
7756 include 'COMMON.CONTROL'
7758 C Set lprn=.true. for debugging
7761 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7763 do i=itau_start,itau_end
7764 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7766 isccori=isccortyp(itype(i-2))
7767 isccori1=isccortyp(itype(i-1))
7768 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7770 do intertyp=1,3 !intertyp
7771 cc Added 09 May 2012 (Adasko)
7772 cc Intertyp means interaction type of backbone mainchain correlation:
7773 c 1 = SC...Ca...Ca...Ca
7774 c 2 = Ca...Ca...Ca...SC
7775 c 3 = SC...Ca...Ca...SCi
7777 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7778 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7779 & (itype(i-1).eq.ntyp1)))
7780 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7781 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7782 & .or.(itype(i).eq.ntyp1)))
7783 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7784 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7785 & (itype(i-3).eq.ntyp1)))) cycle
7786 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7787 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7789 do j=1,nterm_sccor(isccori,isccori1)
7790 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7791 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7792 cosphi=dcos(j*tauangle(intertyp,i))
7793 sinphi=dsin(j*tauangle(intertyp,i))
7794 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7795 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7797 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7798 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7800 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7801 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
7802 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
7803 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7804 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7810 c----------------------------------------------------------------------------
7811 subroutine multibody(ecorr)
7812 C This subroutine calculates multi-body contributions to energy following
7813 C the idea of Skolnick et al. If side chains I and J make a contact and
7814 C at the same time side chains I+1 and J+1 make a contact, an extra
7815 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7816 implicit real*8 (a-h,o-z)
7817 include 'DIMENSIONS'
7818 include 'COMMON.IOUNITS'
7819 include 'COMMON.DERIV'
7820 include 'COMMON.INTERACT'
7821 include 'COMMON.CONTACTS'
7822 double precision gx(3),gx1(3)
7825 C Set lprn=.true. for debugging
7829 write (iout,'(a)') 'Contact function values:'
7831 write (iout,'(i2,20(1x,i2,f10.5))')
7832 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7847 num_conti=num_cont(i)
7848 num_conti1=num_cont(i1)
7853 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7854 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7855 cd & ' ishift=',ishift
7856 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7857 C The system gains extra energy.
7858 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7859 endif ! j1==j+-ishift
7868 c------------------------------------------------------------------------------
7869 double precision function esccorr(i,j,k,l,jj,kk)
7870 implicit real*8 (a-h,o-z)
7871 include 'DIMENSIONS'
7872 include 'COMMON.IOUNITS'
7873 include 'COMMON.DERIV'
7874 include 'COMMON.INTERACT'
7875 include 'COMMON.CONTACTS'
7876 include 'COMMON.SHIELD'
7877 double precision gx(3),gx1(3)
7882 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7883 C Calculate the multi-body contribution to energy.
7884 C Calculate multi-body contributions to the gradient.
7885 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7886 cd & k,l,(gacont(m,kk,k),m=1,3)
7888 gx(m) =ekl*gacont(m,jj,i)
7889 gx1(m)=eij*gacont(m,kk,k)
7890 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7891 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7892 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7893 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7897 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7902 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7908 c------------------------------------------------------------------------------
7909 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7910 C This subroutine calculates multi-body contributions to hydrogen-bonding
7911 implicit real*8 (a-h,o-z)
7912 include 'DIMENSIONS'
7913 include 'COMMON.IOUNITS'
7916 parameter (max_cont=maxconts)
7917 parameter (max_dim=26)
7918 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7919 double precision zapas(max_dim,maxconts,max_fg_procs),
7920 & zapas_recv(max_dim,maxconts,max_fg_procs)
7921 common /przechowalnia/ zapas
7922 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7923 & status_array(MPI_STATUS_SIZE,maxconts*2)
7925 include 'COMMON.SETUP'
7926 include 'COMMON.FFIELD'
7927 include 'COMMON.DERIV'
7928 include 'COMMON.INTERACT'
7929 include 'COMMON.CONTACTS'
7930 include 'COMMON.CONTROL'
7931 include 'COMMON.LOCAL'
7932 double precision gx(3),gx1(3),time00
7935 C Set lprn=.true. for debugging
7940 if (nfgtasks.le.1) goto 30
7942 write (iout,'(a)') 'Contact function values before RECEIVE:'
7944 write (iout,'(2i3,50(1x,i2,f5.2))')
7945 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7946 & j=1,num_cont_hb(i))
7950 do i=1,ntask_cont_from
7953 do i=1,ntask_cont_to
7956 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7958 C Make the list of contacts to send to send to other procesors
7959 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7961 do i=iturn3_start,iturn3_end
7962 c write (iout,*) "make contact list turn3",i," num_cont",
7964 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7966 do i=iturn4_start,iturn4_end
7967 c write (iout,*) "make contact list turn4",i," num_cont",
7969 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7973 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7975 do j=1,num_cont_hb(i)
7978 iproc=iint_sent_local(k,jjc,ii)
7979 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7980 if (iproc.gt.0) then
7981 ncont_sent(iproc)=ncont_sent(iproc)+1
7982 nn=ncont_sent(iproc)
7984 zapas(2,nn,iproc)=jjc
7985 zapas(3,nn,iproc)=facont_hb(j,i)
7986 zapas(4,nn,iproc)=ees0p(j,i)
7987 zapas(5,nn,iproc)=ees0m(j,i)
7988 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7989 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7990 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7991 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7992 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7993 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7994 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7995 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7996 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7997 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7998 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7999 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
8000 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
8001 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
8002 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
8003 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
8004 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
8005 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
8006 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
8007 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
8008 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
8015 & "Numbers of contacts to be sent to other processors",
8016 & (ncont_sent(i),i=1,ntask_cont_to)
8017 write (iout,*) "Contacts sent"
8018 do ii=1,ntask_cont_to
8020 iproc=itask_cont_to(ii)
8021 write (iout,*) nn," contacts to processor",iproc,
8022 & " of CONT_TO_COMM group"
8024 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8032 CorrelID1=nfgtasks+fg_rank+1
8034 C Receive the numbers of needed contacts from other processors
8035 do ii=1,ntask_cont_from
8036 iproc=itask_cont_from(ii)
8038 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8039 & FG_COMM,req(ireq),IERR)
8041 c write (iout,*) "IRECV ended"
8043 C Send the number of contacts needed by other processors
8044 do ii=1,ntask_cont_to
8045 iproc=itask_cont_to(ii)
8047 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8048 & FG_COMM,req(ireq),IERR)
8050 c write (iout,*) "ISEND ended"
8051 c write (iout,*) "number of requests (nn)",ireq
8054 & call MPI_Waitall(ireq,req,status_array,ierr)
8056 c & "Numbers of contacts to be received from other processors",
8057 c & (ncont_recv(i),i=1,ntask_cont_from)
8061 do ii=1,ntask_cont_from
8062 iproc=itask_cont_from(ii)
8064 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8065 c & " of CONT_TO_COMM group"
8069 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8070 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8071 c write (iout,*) "ireq,req",ireq,req(ireq)
8074 C Send the contacts to processors that need them
8075 do ii=1,ntask_cont_to
8076 iproc=itask_cont_to(ii)
8078 c write (iout,*) nn," contacts to processor",iproc,
8079 c & " of CONT_TO_COMM group"
8082 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8083 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8084 c write (iout,*) "ireq,req",ireq,req(ireq)
8086 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8090 c write (iout,*) "number of requests (contacts)",ireq
8091 c write (iout,*) "req",(req(i),i=1,4)
8094 & call MPI_Waitall(ireq,req,status_array,ierr)
8095 do iii=1,ntask_cont_from
8096 iproc=itask_cont_from(iii)
8099 write (iout,*) "Received",nn," contacts from processor",iproc,
8100 & " of CONT_FROM_COMM group"
8103 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8108 ii=zapas_recv(1,i,iii)
8109 c Flag the received contacts to prevent double-counting
8110 jj=-zapas_recv(2,i,iii)
8111 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8113 nnn=num_cont_hb(ii)+1
8116 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8117 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8118 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8119 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8120 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8121 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8122 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8123 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8124 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8125 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8126 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8127 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8128 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8129 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8130 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8131 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8132 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8133 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8134 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8135 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8136 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8137 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8138 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8139 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8144 write (iout,'(a)') 'Contact function values after receive:'
8146 write (iout,'(2i3,50(1x,i3,f5.2))')
8147 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8148 & j=1,num_cont_hb(i))
8155 write (iout,'(a)') 'Contact function values:'
8157 write (iout,'(2i3,50(1x,i3,f5.2))')
8158 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8159 & j=1,num_cont_hb(i))
8163 C Remove the loop below after debugging !!!
8170 C Calculate the local-electrostatic correlation terms
8171 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8173 num_conti=num_cont_hb(i)
8174 num_conti1=num_cont_hb(i+1)
8181 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8182 c & ' jj=',jj,' kk=',kk
8183 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8184 & .or. j.lt.0 .and. j1.gt.0) .and.
8185 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8186 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8187 C The system gains extra energy.
8188 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8189 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
8190 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
8192 else if (j1.eq.j) then
8193 C Contacts I-J and I-(J+1) occur simultaneously.
8194 C The system loses extra energy.
8195 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8200 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8201 c & ' jj=',jj,' kk=',kk
8203 C Contacts I-J and (I+1)-J occur simultaneously.
8204 C The system loses extra energy.
8205 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8212 c------------------------------------------------------------------------------
8213 subroutine add_hb_contact(ii,jj,itask)
8214 implicit real*8 (a-h,o-z)
8215 include "DIMENSIONS"
8216 include "COMMON.IOUNITS"
8219 parameter (max_cont=maxconts)
8220 parameter (max_dim=26)
8221 include "COMMON.CONTACTS"
8222 double precision zapas(max_dim,maxconts,max_fg_procs),
8223 & zapas_recv(max_dim,maxconts,max_fg_procs)
8224 common /przechowalnia/ zapas
8225 integer i,j,ii,jj,iproc,itask(4),nn
8226 c write (iout,*) "itask",itask
8229 if (iproc.gt.0) then
8230 do j=1,num_cont_hb(ii)
8232 c write (iout,*) "i",ii," j",jj," jjc",jjc
8234 ncont_sent(iproc)=ncont_sent(iproc)+1
8235 nn=ncont_sent(iproc)
8236 zapas(1,nn,iproc)=ii
8237 zapas(2,nn,iproc)=jjc
8238 zapas(3,nn,iproc)=facont_hb(j,ii)
8239 zapas(4,nn,iproc)=ees0p(j,ii)
8240 zapas(5,nn,iproc)=ees0m(j,ii)
8241 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8242 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8243 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8244 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8245 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8246 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8247 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8248 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8249 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8250 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8251 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8252 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8253 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8254 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8255 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8256 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8257 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8258 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8259 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8260 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8261 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8269 c------------------------------------------------------------------------------
8270 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8272 C This subroutine calculates multi-body contributions to hydrogen-bonding
8273 implicit real*8 (a-h,o-z)
8274 include 'DIMENSIONS'
8275 include 'COMMON.IOUNITS'
8278 parameter (max_cont=maxconts)
8279 parameter (max_dim=70)
8280 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8281 double precision zapas(max_dim,maxconts,max_fg_procs),
8282 & zapas_recv(max_dim,maxconts,max_fg_procs)
8283 common /przechowalnia/ zapas
8284 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8285 & status_array(MPI_STATUS_SIZE,maxconts*2)
8287 include 'COMMON.SETUP'
8288 include 'COMMON.FFIELD'
8289 include 'COMMON.DERIV'
8290 include 'COMMON.LOCAL'
8291 include 'COMMON.INTERACT'
8292 include 'COMMON.CONTACTS'
8293 include 'COMMON.CHAIN'
8294 include 'COMMON.CONTROL'
8295 include 'COMMON.SHIELD'
8296 double precision gx(3),gx1(3)
8297 integer num_cont_hb_old(maxres)
8299 double precision eello4,eello5,eelo6,eello_turn6
8300 external eello4,eello5,eello6,eello_turn6
8301 C Set lprn=.true. for debugging
8306 num_cont_hb_old(i)=num_cont_hb(i)
8310 if (nfgtasks.le.1) goto 30
8312 write (iout,'(a)') 'Contact function values before RECEIVE:'
8314 write (iout,'(2i3,50(1x,i2,f5.2))')
8315 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8316 & j=1,num_cont_hb(i))
8320 do i=1,ntask_cont_from
8323 do i=1,ntask_cont_to
8326 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8328 C Make the list of contacts to send to send to other procesors
8329 do i=iturn3_start,iturn3_end
8330 c write (iout,*) "make contact list turn3",i," num_cont",
8332 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8334 do i=iturn4_start,iturn4_end
8335 c write (iout,*) "make contact list turn4",i," num_cont",
8337 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8341 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8343 do j=1,num_cont_hb(i)
8346 iproc=iint_sent_local(k,jjc,ii)
8347 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8348 if (iproc.ne.0) then
8349 ncont_sent(iproc)=ncont_sent(iproc)+1
8350 nn=ncont_sent(iproc)
8352 zapas(2,nn,iproc)=jjc
8353 zapas(3,nn,iproc)=d_cont(j,i)
8357 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8362 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8370 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8381 & "Numbers of contacts to be sent to other processors",
8382 & (ncont_sent(i),i=1,ntask_cont_to)
8383 write (iout,*) "Contacts sent"
8384 do ii=1,ntask_cont_to
8386 iproc=itask_cont_to(ii)
8387 write (iout,*) nn," contacts to processor",iproc,
8388 & " of CONT_TO_COMM group"
8390 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8398 CorrelID1=nfgtasks+fg_rank+1
8400 C Receive the numbers of needed contacts from other processors
8401 do ii=1,ntask_cont_from
8402 iproc=itask_cont_from(ii)
8404 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8405 & FG_COMM,req(ireq),IERR)
8407 c write (iout,*) "IRECV ended"
8409 C Send the number of contacts needed by other processors
8410 do ii=1,ntask_cont_to
8411 iproc=itask_cont_to(ii)
8413 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8414 & FG_COMM,req(ireq),IERR)
8416 c write (iout,*) "ISEND ended"
8417 c write (iout,*) "number of requests (nn)",ireq
8420 & call MPI_Waitall(ireq,req,status_array,ierr)
8422 c & "Numbers of contacts to be received from other processors",
8423 c & (ncont_recv(i),i=1,ntask_cont_from)
8427 do ii=1,ntask_cont_from
8428 iproc=itask_cont_from(ii)
8430 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8431 c & " of CONT_TO_COMM group"
8435 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8436 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8437 c write (iout,*) "ireq,req",ireq,req(ireq)
8440 C Send the contacts to processors that need them
8441 do ii=1,ntask_cont_to
8442 iproc=itask_cont_to(ii)
8444 c write (iout,*) nn," contacts to processor",iproc,
8445 c & " of CONT_TO_COMM group"
8448 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8449 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8450 c write (iout,*) "ireq,req",ireq,req(ireq)
8452 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8456 c write (iout,*) "number of requests (contacts)",ireq
8457 c write (iout,*) "req",(req(i),i=1,4)
8460 & call MPI_Waitall(ireq,req,status_array,ierr)
8461 do iii=1,ntask_cont_from
8462 iproc=itask_cont_from(iii)
8465 write (iout,*) "Received",nn," contacts from processor",iproc,
8466 & " of CONT_FROM_COMM group"
8469 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8474 ii=zapas_recv(1,i,iii)
8475 c Flag the received contacts to prevent double-counting
8476 jj=-zapas_recv(2,i,iii)
8477 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8479 nnn=num_cont_hb(ii)+1
8482 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8486 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8491 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8499 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8508 write (iout,'(a)') 'Contact function values after receive:'
8510 write (iout,'(2i3,50(1x,i3,5f6.3))')
8511 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8512 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8519 write (iout,'(a)') 'Contact function values:'
8521 write (iout,'(2i3,50(1x,i2,5f6.3))')
8522 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8523 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8529 C Remove the loop below after debugging !!!
8536 C Calculate the dipole-dipole interaction energies
8537 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8538 do i=iatel_s,iatel_e+1
8539 num_conti=num_cont_hb(i)
8548 C Calculate the local-electrostatic correlation terms
8549 c write (iout,*) "gradcorr5 in eello5 before loop"
8551 c write (iout,'(i5,3f10.5)')
8552 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8554 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8555 c write (iout,*) "corr loop i",i
8557 num_conti=num_cont_hb(i)
8558 num_conti1=num_cont_hb(i+1)
8565 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8566 c & ' jj=',jj,' kk=',kk
8567 c if (j1.eq.j+1 .or. j1.eq.j-1) then
8568 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8569 & .or. j.lt.0 .and. j1.gt.0) .and.
8570 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8571 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8572 C The system gains extra energy.
8574 sqd1=dsqrt(d_cont(jj,i))
8575 sqd2=dsqrt(d_cont(kk,i1))
8576 sred_geom = sqd1*sqd2
8577 IF (sred_geom.lt.cutoff_corr) THEN
8578 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
8580 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8581 cd & ' jj=',jj,' kk=',kk
8582 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8583 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8585 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8586 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8589 cd write (iout,*) 'sred_geom=',sred_geom,
8590 cd & ' ekont=',ekont,' fprim=',fprimcont,
8591 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8592 cd write (iout,*) "g_contij",g_contij
8593 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8594 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8595 call calc_eello(i,jp,i+1,jp1,jj,kk)
8596 if (wcorr4.gt.0.0d0)
8597 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8598 CC & *fac_shield(i)**2*fac_shield(j)**2
8599 if (energy_dec.and.wcorr4.gt.0.0d0)
8600 1 write (iout,'(a6,4i5,0pf7.3)')
8601 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8602 c write (iout,*) "gradcorr5 before eello5"
8604 c write (iout,'(i5,3f10.5)')
8605 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8607 if (wcorr5.gt.0.0d0)
8608 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8609 c write (iout,*) "gradcorr5 after eello5"
8611 c write (iout,'(i5,3f10.5)')
8612 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8614 if (energy_dec.and.wcorr5.gt.0.0d0)
8615 1 write (iout,'(a6,4i5,0pf7.3)')
8616 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8617 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8618 cd write(2,*)'ijkl',i,jp,i+1,jp1
8619 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
8620 & .or. wturn6.eq.0.0d0))then
8621 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8622 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8623 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8624 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8625 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8626 cd & 'ecorr6=',ecorr6
8627 cd write (iout,'(4e15.5)') sred_geom,
8628 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8629 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8630 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8631 else if (wturn6.gt.0.0d0
8632 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8633 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8634 eturn6=eturn6+eello_turn6(i,jj,kk)
8635 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8636 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8637 cd write (2,*) 'multibody_eello:eturn6',eturn6
8646 num_cont_hb(i)=num_cont_hb_old(i)
8648 c write (iout,*) "gradcorr5 in eello5"
8650 c write (iout,'(i5,3f10.5)')
8651 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8655 c------------------------------------------------------------------------------
8656 subroutine add_hb_contact_eello(ii,jj,itask)
8657 implicit real*8 (a-h,o-z)
8658 include "DIMENSIONS"
8659 include "COMMON.IOUNITS"
8662 parameter (max_cont=maxconts)
8663 parameter (max_dim=70)
8664 include "COMMON.CONTACTS"
8665 double precision zapas(max_dim,maxconts,max_fg_procs),
8666 & zapas_recv(max_dim,maxconts,max_fg_procs)
8667 common /przechowalnia/ zapas
8668 integer i,j,ii,jj,iproc,itask(4),nn
8669 c write (iout,*) "itask",itask
8672 if (iproc.gt.0) then
8673 do j=1,num_cont_hb(ii)
8675 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8677 ncont_sent(iproc)=ncont_sent(iproc)+1
8678 nn=ncont_sent(iproc)
8679 zapas(1,nn,iproc)=ii
8680 zapas(2,nn,iproc)=jjc
8681 zapas(3,nn,iproc)=d_cont(j,ii)
8685 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8690 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8698 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8710 c------------------------------------------------------------------------------
8711 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8712 implicit real*8 (a-h,o-z)
8713 include 'DIMENSIONS'
8714 include 'COMMON.IOUNITS'
8715 include 'COMMON.DERIV'
8716 include 'COMMON.INTERACT'
8717 include 'COMMON.CONTACTS'
8718 include 'COMMON.SHIELD'
8719 include 'COMMON.CONTROL'
8720 double precision gx(3),gx1(3)
8723 C print *,"wchodze",fac_shield(i),shield_mode
8731 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8733 C & fac_shield(i)**2*fac_shield(j)**2
8734 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8735 C Following 4 lines for diagnostics.
8740 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8741 c & 'Contacts ',i,j,
8742 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8743 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8745 C Calculate the multi-body contribution to energy.
8746 C ecorr=ecorr+ekont*ees
8747 C Calculate multi-body contributions to the gradient.
8748 coeffpees0pij=coeffp*ees0pij
8749 coeffmees0mij=coeffm*ees0mij
8750 coeffpees0pkl=coeffp*ees0pkl
8751 coeffmees0mkl=coeffm*ees0mkl
8753 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8754 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8755 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8756 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8757 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8758 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8759 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8760 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8761 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8762 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8763 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8764 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8765 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8766 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8767 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8768 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8769 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8770 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8771 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8772 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8773 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8774 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8775 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8776 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8777 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8782 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8783 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8784 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8785 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8790 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8791 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8792 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8793 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8796 c write (iout,*) "ehbcorr",ekont*ees
8797 C print *,ekont,ees,i,k
8799 C now gradient over shielding
8801 if (shield_mode.gt.0) then
8804 C print *,i,j,fac_shield(i),fac_shield(j),
8805 C &fac_shield(k),fac_shield(l)
8806 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
8807 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8808 do ilist=1,ishield_list(i)
8809 iresshield=shield_list(ilist,i)
8811 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8813 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8815 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8816 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8820 do ilist=1,ishield_list(j)
8821 iresshield=shield_list(ilist,j)
8823 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8825 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8827 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8828 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8833 do ilist=1,ishield_list(k)
8834 iresshield=shield_list(ilist,k)
8836 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8838 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8840 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8841 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8845 do ilist=1,ishield_list(l)
8846 iresshield=shield_list(ilist,l)
8848 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8850 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8852 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8853 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8857 C print *,gshieldx(m,iresshield)
8859 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
8860 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8861 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
8862 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8863 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
8864 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8865 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
8866 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8868 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
8869 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8870 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
8871 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8872 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
8873 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8874 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
8875 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8883 C---------------------------------------------------------------------------
8884 subroutine dipole(i,j,jj)
8885 implicit real*8 (a-h,o-z)
8886 include 'DIMENSIONS'
8887 include 'COMMON.IOUNITS'
8888 include 'COMMON.CHAIN'
8889 include 'COMMON.FFIELD'
8890 include 'COMMON.DERIV'
8891 include 'COMMON.INTERACT'
8892 include 'COMMON.CONTACTS'
8893 include 'COMMON.TORSION'
8894 include 'COMMON.VAR'
8895 include 'COMMON.GEO'
8896 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8898 iti1 = itortyp(itype(i+1))
8899 if (j.lt.nres-1) then
8900 itj1 = itype2loc(itype(j+1))
8905 dipi(iii,1)=Ub2(iii,i)
8906 dipderi(iii)=Ub2der(iii,i)
8907 dipi(iii,2)=b1(iii,i+1)
8908 dipj(iii,1)=Ub2(iii,j)
8909 dipderj(iii)=Ub2der(iii,j)
8910 dipj(iii,2)=b1(iii,j+1)
8914 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8917 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8924 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8928 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8933 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8934 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8936 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8938 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8940 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8945 C---------------------------------------------------------------------------
8946 subroutine calc_eello(i,j,k,l,jj,kk)
8948 C This subroutine computes matrices and vectors needed to calculate
8949 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8951 implicit real*8 (a-h,o-z)
8952 include 'DIMENSIONS'
8953 include 'COMMON.IOUNITS'
8954 include 'COMMON.CHAIN'
8955 include 'COMMON.DERIV'
8956 include 'COMMON.INTERACT'
8957 include 'COMMON.CONTACTS'
8958 include 'COMMON.TORSION'
8959 include 'COMMON.VAR'
8960 include 'COMMON.GEO'
8961 include 'COMMON.FFIELD'
8962 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8963 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8966 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8967 cd & ' jj=',jj,' kk=',kk
8968 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8969 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8970 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8973 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8974 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8977 call transpose2(aa1(1,1),aa1t(1,1))
8978 call transpose2(aa2(1,1),aa2t(1,1))
8981 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8982 & aa1tder(1,1,lll,kkk))
8983 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8984 & aa2tder(1,1,lll,kkk))
8988 C parallel orientation of the two CA-CA-CA frames.
8990 iti=itype2loc(itype(i))
8994 itk1=itype2loc(itype(k+1))
8995 itj=itype2loc(itype(j))
8996 if (l.lt.nres-1) then
8997 itl1=itype2loc(itype(l+1))
9001 C A1 kernel(j+1) A2T
9003 cd write (iout,'(3f10.5,5x,3f10.5)')
9004 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
9006 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9007 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
9008 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9009 C Following matrices are needed only for 6-th order cumulants
9010 IF (wcorr6.gt.0.0d0) THEN
9011 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9012 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
9013 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9014 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9015 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
9016 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9017 & ADtEAderx(1,1,1,1,1,1))
9019 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9020 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
9021 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9022 & ADtEA1derx(1,1,1,1,1,1))
9024 C End 6-th order cumulants
9027 cd write (2,*) 'In calc_eello6'
9029 cd write (2,*) 'iii=',iii
9031 cd write (2,*) 'kkk=',kkk
9033 cd write (2,'(3(2f10.5),5x)')
9034 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9039 call transpose2(EUgder(1,1,k),auxmat(1,1))
9040 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9041 call transpose2(EUg(1,1,k),auxmat(1,1))
9042 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9043 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9047 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9048 & EAEAderx(1,1,lll,kkk,iii,1))
9052 C A1T kernel(i+1) A2
9053 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9054 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
9055 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9056 C Following matrices are needed only for 6-th order cumulants
9057 IF (wcorr6.gt.0.0d0) THEN
9058 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9059 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
9060 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9061 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9062 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
9063 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9064 & ADtEAderx(1,1,1,1,1,2))
9065 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9066 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
9067 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9068 & ADtEA1derx(1,1,1,1,1,2))
9070 C End 6-th order cumulants
9071 call transpose2(EUgder(1,1,l),auxmat(1,1))
9072 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
9073 call transpose2(EUg(1,1,l),auxmat(1,1))
9074 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9075 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9079 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9080 & EAEAderx(1,1,lll,kkk,iii,2))
9085 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9086 C They are needed only when the fifth- or the sixth-order cumulants are
9088 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
9089 call transpose2(AEA(1,1,1),auxmat(1,1))
9090 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9091 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9092 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9093 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9094 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9095 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9096 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9097 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9098 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9099 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9100 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9101 call transpose2(AEA(1,1,2),auxmat(1,1))
9102 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
9103 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
9104 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
9105 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9106 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
9107 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
9108 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
9109 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
9110 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
9111 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
9112 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
9113 C Calculate the Cartesian derivatives of the vectors.
9117 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9118 call matvec2(auxmat(1,1),b1(1,i),
9119 & AEAb1derx(1,lll,kkk,iii,1,1))
9120 call matvec2(auxmat(1,1),Ub2(1,i),
9121 & AEAb2derx(1,lll,kkk,iii,1,1))
9122 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9123 & AEAb1derx(1,lll,kkk,iii,2,1))
9124 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9125 & AEAb2derx(1,lll,kkk,iii,2,1))
9126 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9127 call matvec2(auxmat(1,1),b1(1,j),
9128 & AEAb1derx(1,lll,kkk,iii,1,2))
9129 call matvec2(auxmat(1,1),Ub2(1,j),
9130 & AEAb2derx(1,lll,kkk,iii,1,2))
9131 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9132 & AEAb1derx(1,lll,kkk,iii,2,2))
9133 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
9134 & AEAb2derx(1,lll,kkk,iii,2,2))
9141 C Antiparallel orientation of the two CA-CA-CA frames.
9143 iti=itype2loc(itype(i))
9147 itk1=itype2loc(itype(k+1))
9148 itl=itype2loc(itype(l))
9149 itj=itype2loc(itype(j))
9150 if (j.lt.nres-1) then
9151 itj1=itype2loc(itype(j+1))
9155 C A2 kernel(j-1)T A1T
9156 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9157 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
9158 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9159 C Following matrices are needed only for 6-th order cumulants
9160 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9161 & j.eq.i+4 .and. l.eq.i+3)) THEN
9162 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9163 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
9164 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9165 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9166 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
9167 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9168 & ADtEAderx(1,1,1,1,1,1))
9169 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9170 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
9171 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9172 & ADtEA1derx(1,1,1,1,1,1))
9174 C End 6-th order cumulants
9175 call transpose2(EUgder(1,1,k),auxmat(1,1))
9176 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9177 call transpose2(EUg(1,1,k),auxmat(1,1))
9178 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9179 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9183 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9184 & EAEAderx(1,1,lll,kkk,iii,1))
9188 C A2T kernel(i+1)T A1
9189 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9190 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
9191 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9192 C Following matrices are needed only for 6-th order cumulants
9193 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9194 & j.eq.i+4 .and. l.eq.i+3)) THEN
9195 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9196 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
9197 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9198 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9199 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
9200 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9201 & ADtEAderx(1,1,1,1,1,2))
9202 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9203 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
9204 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9205 & ADtEA1derx(1,1,1,1,1,2))
9207 C End 6-th order cumulants
9208 call transpose2(EUgder(1,1,j),auxmat(1,1))
9209 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9210 call transpose2(EUg(1,1,j),auxmat(1,1))
9211 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9212 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9216 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9217 & EAEAderx(1,1,lll,kkk,iii,2))
9222 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9223 C They are needed only when the fifth- or the sixth-order cumulants are
9225 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
9226 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9227 call transpose2(AEA(1,1,1),auxmat(1,1))
9228 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9229 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9230 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9231 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9232 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9233 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9234 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9235 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9236 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9237 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9238 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9239 call transpose2(AEA(1,1,2),auxmat(1,1))
9240 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
9241 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9242 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9243 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9244 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
9245 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9246 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
9247 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
9248 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9249 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9250 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9251 C Calculate the Cartesian derivatives of the vectors.
9255 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9256 call matvec2(auxmat(1,1),b1(1,i),
9257 & AEAb1derx(1,lll,kkk,iii,1,1))
9258 call matvec2(auxmat(1,1),Ub2(1,i),
9259 & AEAb2derx(1,lll,kkk,iii,1,1))
9260 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9261 & AEAb1derx(1,lll,kkk,iii,2,1))
9262 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9263 & AEAb2derx(1,lll,kkk,iii,2,1))
9264 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9265 call matvec2(auxmat(1,1),b1(1,l),
9266 & AEAb1derx(1,lll,kkk,iii,1,2))
9267 call matvec2(auxmat(1,1),Ub2(1,l),
9268 & AEAb2derx(1,lll,kkk,iii,1,2))
9269 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
9270 & AEAb1derx(1,lll,kkk,iii,2,2))
9271 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
9272 & AEAb2derx(1,lll,kkk,iii,2,2))
9281 C---------------------------------------------------------------------------
9282 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
9283 & KK,KKderg,AKA,AKAderg,AKAderx)
9287 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
9288 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
9289 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
9294 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9296 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
9299 cd if (lprn) write (2,*) 'In kernel'
9301 cd if (lprn) write (2,*) 'kkk=',kkk
9303 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
9304 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9306 cd write (2,*) 'lll=',lll
9307 cd write (2,*) 'iii=1'
9309 cd write (2,'(3(2f10.5),5x)')
9310 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9313 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
9314 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9316 cd write (2,*) 'lll=',lll
9317 cd write (2,*) 'iii=2'
9319 cd write (2,'(3(2f10.5),5x)')
9320 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9327 C---------------------------------------------------------------------------
9328 double precision function eello4(i,j,k,l,jj,kk)
9329 implicit real*8 (a-h,o-z)
9330 include 'DIMENSIONS'
9331 include 'COMMON.IOUNITS'
9332 include 'COMMON.CHAIN'
9333 include 'COMMON.DERIV'
9334 include 'COMMON.INTERACT'
9335 include 'COMMON.CONTACTS'
9336 include 'COMMON.TORSION'
9337 include 'COMMON.VAR'
9338 include 'COMMON.GEO'
9339 double precision pizda(2,2),ggg1(3),ggg2(3)
9340 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9344 cd print *,'eello4:',i,j,k,l,jj,kk
9345 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9346 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9347 cold eij=facont_hb(jj,i)
9348 cold ekl=facont_hb(kk,k)
9350 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9351 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9352 gcorr_loc(k-1)=gcorr_loc(k-1)
9353 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9355 gcorr_loc(l-1)=gcorr_loc(l-1)
9356 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9358 gcorr_loc(j-1)=gcorr_loc(j-1)
9359 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9364 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9365 & -EAEAderx(2,2,lll,kkk,iii,1)
9366 cd derx(lll,kkk,iii)=0.0d0
9370 cd gcorr_loc(l-1)=0.0d0
9371 cd gcorr_loc(j-1)=0.0d0
9372 cd gcorr_loc(k-1)=0.0d0
9374 cd write (iout,*)'Contacts have occurred for peptide groups',
9375 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9376 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9377 if (j.lt.nres-1) then
9384 if (l.lt.nres-1) then
9392 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9393 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9394 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9395 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9396 cgrad ghalf=0.5d0*ggg1(ll)
9397 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9398 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9399 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9400 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9401 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9402 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9403 cgrad ghalf=0.5d0*ggg2(ll)
9404 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9405 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9406 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9407 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9408 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9409 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9413 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9418 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9423 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9428 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9432 cd write (2,*) iii,gcorr_loc(iii)
9435 cd write (2,*) 'ekont',ekont
9436 cd write (iout,*) 'eello4',ekont*eel4
9439 C---------------------------------------------------------------------------
9440 double precision function eello5(i,j,k,l,jj,kk)
9441 implicit real*8 (a-h,o-z)
9442 include 'DIMENSIONS'
9443 include 'COMMON.IOUNITS'
9444 include 'COMMON.CHAIN'
9445 include 'COMMON.DERIV'
9446 include 'COMMON.INTERACT'
9447 include 'COMMON.CONTACTS'
9448 include 'COMMON.TORSION'
9449 include 'COMMON.VAR'
9450 include 'COMMON.GEO'
9451 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9452 double precision ggg1(3),ggg2(3)
9453 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9458 C /l\ / \ \ / \ / \ / C
9459 C / \ / \ \ / \ / \ / C
9460 C j| o |l1 | o | o| o | | o |o C
9461 C \ |/k\| |/ \| / |/ \| |/ \| C
9462 C \i/ \ / \ / / \ / \ C
9464 C (I) (II) (III) (IV) C
9466 C eello5_1 eello5_2 eello5_3 eello5_4 C
9468 C Antiparallel chains C
9471 C /j\ / \ \ / \ / \ / C
9472 C / \ / \ \ / \ / \ / C
9473 C j1| o |l | o | o| o | | o |o C
9474 C \ |/k\| |/ \| / |/ \| |/ \| C
9475 C \i/ \ / \ / / \ / \ C
9477 C (I) (II) (III) (IV) C
9479 C eello5_1 eello5_2 eello5_3 eello5_4 C
9481 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9483 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9484 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9489 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9491 itk=itype2loc(itype(k))
9492 itl=itype2loc(itype(l))
9493 itj=itype2loc(itype(j))
9498 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9499 cd & eel5_3_num,eel5_4_num)
9503 derx(lll,kkk,iii)=0.0d0
9507 cd eij=facont_hb(jj,i)
9508 cd ekl=facont_hb(kk,k)
9510 cd write (iout,*)'Contacts have occurred for peptide groups',
9511 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9513 C Contribution from the graph I.
9514 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9515 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9516 call transpose2(EUg(1,1,k),auxmat(1,1))
9517 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9518 vv(1)=pizda(1,1)-pizda(2,2)
9519 vv(2)=pizda(1,2)+pizda(2,1)
9520 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9521 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9522 C Explicit gradient in virtual-dihedral angles.
9523 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9524 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9525 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9526 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9527 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9528 vv(1)=pizda(1,1)-pizda(2,2)
9529 vv(2)=pizda(1,2)+pizda(2,1)
9530 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9531 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9532 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9533 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9534 vv(1)=pizda(1,1)-pizda(2,2)
9535 vv(2)=pizda(1,2)+pizda(2,1)
9537 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9538 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9539 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9541 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9542 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9543 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9545 C Cartesian gradient
9549 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
9551 vv(1)=pizda(1,1)-pizda(2,2)
9552 vv(2)=pizda(1,2)+pizda(2,1)
9553 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9554 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
9555 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9561 C Contribution from graph II
9562 call transpose2(EE(1,1,k),auxmat(1,1))
9563 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9564 vv(1)=pizda(1,1)+pizda(2,2)
9565 vv(2)=pizda(2,1)-pizda(1,2)
9566 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
9567 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9568 C Explicit gradient in virtual-dihedral angles.
9569 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9570 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9571 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9572 vv(1)=pizda(1,1)+pizda(2,2)
9573 vv(2)=pizda(2,1)-pizda(1,2)
9575 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9576 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9577 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9579 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9580 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9581 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9583 C Cartesian gradient
9587 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9589 vv(1)=pizda(1,1)+pizda(2,2)
9590 vv(2)=pizda(2,1)-pizda(1,2)
9591 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9592 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
9593 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9601 C Parallel orientation
9602 C Contribution from graph III
9603 call transpose2(EUg(1,1,l),auxmat(1,1))
9604 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9605 vv(1)=pizda(1,1)-pizda(2,2)
9606 vv(2)=pizda(1,2)+pizda(2,1)
9607 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
9608 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9609 C Explicit gradient in virtual-dihedral angles.
9610 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9611 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
9612 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9613 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9614 vv(1)=pizda(1,1)-pizda(2,2)
9615 vv(2)=pizda(1,2)+pizda(2,1)
9616 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9617 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
9618 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9619 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9620 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9621 vv(1)=pizda(1,1)-pizda(2,2)
9622 vv(2)=pizda(1,2)+pizda(2,1)
9623 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9624 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
9625 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9626 C Cartesian gradient
9630 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9632 vv(1)=pizda(1,1)-pizda(2,2)
9633 vv(2)=pizda(1,2)+pizda(2,1)
9634 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9635 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
9636 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9641 C Contribution from graph IV
9643 call transpose2(EE(1,1,l),auxmat(1,1))
9644 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9645 vv(1)=pizda(1,1)+pizda(2,2)
9646 vv(2)=pizda(2,1)-pizda(1,2)
9647 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
9648 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9649 C Explicit gradient in virtual-dihedral angles.
9650 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9651 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9652 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9653 vv(1)=pizda(1,1)+pizda(2,2)
9654 vv(2)=pizda(2,1)-pizda(1,2)
9655 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9656 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
9657 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9658 C Cartesian gradient
9662 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9664 vv(1)=pizda(1,1)+pizda(2,2)
9665 vv(2)=pizda(2,1)-pizda(1,2)
9666 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9667 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
9668 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9673 C Antiparallel orientation
9674 C Contribution from graph III
9676 call transpose2(EUg(1,1,j),auxmat(1,1))
9677 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9678 vv(1)=pizda(1,1)-pizda(2,2)
9679 vv(2)=pizda(1,2)+pizda(2,1)
9680 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9681 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9682 C Explicit gradient in virtual-dihedral angles.
9683 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9684 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9685 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9686 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9687 vv(1)=pizda(1,1)-pizda(2,2)
9688 vv(2)=pizda(1,2)+pizda(2,1)
9689 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9690 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9691 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9692 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9693 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9694 vv(1)=pizda(1,1)-pizda(2,2)
9695 vv(2)=pizda(1,2)+pizda(2,1)
9696 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9697 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9698 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9699 C Cartesian gradient
9703 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9705 vv(1)=pizda(1,1)-pizda(2,2)
9706 vv(2)=pizda(1,2)+pizda(2,1)
9707 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9708 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9709 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9714 C Contribution from graph IV
9716 call transpose2(EE(1,1,j),auxmat(1,1))
9717 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9718 vv(1)=pizda(1,1)+pizda(2,2)
9719 vv(2)=pizda(2,1)-pizda(1,2)
9720 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9721 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9722 C Explicit gradient in virtual-dihedral angles.
9723 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9724 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9725 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9726 vv(1)=pizda(1,1)+pizda(2,2)
9727 vv(2)=pizda(2,1)-pizda(1,2)
9728 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9729 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9730 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9731 C Cartesian gradient
9735 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9737 vv(1)=pizda(1,1)+pizda(2,2)
9738 vv(2)=pizda(2,1)-pizda(1,2)
9739 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9740 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9741 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9747 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9748 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9749 cd write (2,*) 'ijkl',i,j,k,l
9750 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9751 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9753 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9754 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9755 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9756 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9757 if (j.lt.nres-1) then
9764 if (l.lt.nres-1) then
9774 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9775 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9776 C summed up outside the subrouine as for the other subroutines
9777 C handling long-range interactions. The old code is commented out
9778 C with "cgrad" to keep track of changes.
9780 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9781 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9782 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9783 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9784 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9785 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9786 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9787 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9788 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9789 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9791 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9792 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9793 cgrad ghalf=0.5d0*ggg1(ll)
9795 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9796 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9797 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9798 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9799 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9800 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9801 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9802 cgrad ghalf=0.5d0*ggg2(ll)
9804 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
9805 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9806 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
9807 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9808 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9809 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9814 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9815 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9820 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9821 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9827 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9832 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9836 cd write (2,*) iii,g_corr5_loc(iii)
9839 cd write (2,*) 'ekont',ekont
9840 cd write (iout,*) 'eello5',ekont*eel5
9843 c--------------------------------------------------------------------------
9844 double precision function eello6(i,j,k,l,jj,kk)
9845 implicit real*8 (a-h,o-z)
9846 include 'DIMENSIONS'
9847 include 'COMMON.IOUNITS'
9848 include 'COMMON.CHAIN'
9849 include 'COMMON.DERIV'
9850 include 'COMMON.INTERACT'
9851 include 'COMMON.CONTACTS'
9852 include 'COMMON.TORSION'
9853 include 'COMMON.VAR'
9854 include 'COMMON.GEO'
9855 include 'COMMON.FFIELD'
9856 double precision ggg1(3),ggg2(3)
9857 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9862 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9870 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9871 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9875 derx(lll,kkk,iii)=0.0d0
9879 cd eij=facont_hb(jj,i)
9880 cd ekl=facont_hb(kk,k)
9886 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9887 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9888 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9889 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9890 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9891 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9893 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9894 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9895 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9896 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9897 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9898 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9902 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9904 C If turn contributions are considered, they will be handled separately.
9905 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9906 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9907 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9908 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9909 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9910 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9911 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9913 if (j.lt.nres-1) then
9920 if (l.lt.nres-1) then
9928 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9929 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9930 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9931 cgrad ghalf=0.5d0*ggg1(ll)
9933 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9934 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9935 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9936 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9937 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9938 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9939 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9940 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9941 cgrad ghalf=0.5d0*ggg2(ll)
9942 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9944 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9945 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9946 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9947 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9948 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9949 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9954 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9955 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9960 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9961 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9967 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9972 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9976 cd write (2,*) iii,g_corr6_loc(iii)
9979 cd write (2,*) 'ekont',ekont
9980 cd write (iout,*) 'eello6',ekont*eel6
9983 c--------------------------------------------------------------------------
9984 double precision function eello6_graph1(i,j,k,l,imat,swap)
9985 implicit real*8 (a-h,o-z)
9986 include 'DIMENSIONS'
9987 include 'COMMON.IOUNITS'
9988 include 'COMMON.CHAIN'
9989 include 'COMMON.DERIV'
9990 include 'COMMON.INTERACT'
9991 include 'COMMON.CONTACTS'
9992 include 'COMMON.TORSION'
9993 include 'COMMON.VAR'
9994 include 'COMMON.GEO'
9995 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9999 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10001 C Parallel Antiparallel C
10007 C \ j|/k\| / \ |/k\|l / C
10008 C \ / \ / \ / \ / C
10012 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10013 itk=itype2loc(itype(k))
10014 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
10015 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
10016 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
10017 call transpose2(EUgC(1,1,k),auxmat(1,1))
10018 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10019 vv1(1)=pizda1(1,1)-pizda1(2,2)
10020 vv1(2)=pizda1(1,2)+pizda1(2,1)
10021 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10022 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
10023 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
10024 s5=scalar2(vv(1),Dtobr2(1,i))
10025 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
10026 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
10027 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
10028 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
10029 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
10030 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
10031 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
10032 & +scalar2(vv(1),Dtobr2der(1,i)))
10033 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
10034 vv1(1)=pizda1(1,1)-pizda1(2,2)
10035 vv1(2)=pizda1(1,2)+pizda1(2,1)
10036 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
10037 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
10039 g_corr6_loc(l-1)=g_corr6_loc(l-1)
10040 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
10041 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
10042 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
10043 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10045 g_corr6_loc(j-1)=g_corr6_loc(j-1)
10046 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
10047 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
10048 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
10049 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10051 call transpose2(EUgCder(1,1,k),auxmat(1,1))
10052 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10053 vv1(1)=pizda1(1,1)-pizda1(2,2)
10054 vv1(2)=pizda1(1,2)+pizda1(2,1)
10055 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
10056 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
10057 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
10058 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
10067 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
10068 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
10069 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
10070 call transpose2(EUgC(1,1,k),auxmat(1,1))
10071 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10073 vv1(1)=pizda1(1,1)-pizda1(2,2)
10074 vv1(2)=pizda1(1,2)+pizda1(2,1)
10075 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10076 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
10077 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
10078 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
10079 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
10080 s5=scalar2(vv(1),Dtobr2(1,i))
10081 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
10087 c----------------------------------------------------------------------------
10088 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
10089 implicit real*8 (a-h,o-z)
10090 include 'DIMENSIONS'
10091 include 'COMMON.IOUNITS'
10092 include 'COMMON.CHAIN'
10093 include 'COMMON.DERIV'
10094 include 'COMMON.INTERACT'
10095 include 'COMMON.CONTACTS'
10096 include 'COMMON.TORSION'
10097 include 'COMMON.VAR'
10098 include 'COMMON.GEO'
10100 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10101 & auxvec1(2),auxvec2(2),auxmat1(2,2)
10103 common /kutas/ lprn
10104 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10106 C Parallel Antiparallel C
10112 C \ j|/k\| \ |/k\|l C
10117 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10118 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
10119 C AL 7/4/01 s1 would occur in the sixth-order moment,
10120 C but not in a cluster cumulant
10122 s1=dip(1,jj,i)*dip(1,kk,k)
10124 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
10125 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10126 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
10127 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
10128 call transpose2(EUg(1,1,k),auxmat(1,1))
10129 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
10130 vv(1)=pizda(1,1)-pizda(2,2)
10131 vv(2)=pizda(1,2)+pizda(2,1)
10132 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10133 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10135 eello6_graph2=-(s1+s2+s3+s4)
10137 eello6_graph2=-(s2+s3+s4)
10139 c eello6_graph2=-s3
10140 C Derivatives in gamma(i-1)
10143 s1=dipderg(1,jj,i)*dip(1,kk,k)
10145 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10146 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
10147 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10148 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10150 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10152 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10154 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
10156 C Derivatives in gamma(k-1)
10158 s1=dip(1,jj,i)*dipderg(1,kk,k)
10160 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
10161 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10162 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
10163 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10164 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10165 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
10166 vv(1)=pizda(1,1)-pizda(2,2)
10167 vv(2)=pizda(1,2)+pizda(2,1)
10168 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10170 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10172 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10174 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
10175 C Derivatives in gamma(j-1) or gamma(l-1)
10178 s1=dipderg(3,jj,i)*dip(1,kk,k)
10180 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
10181 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10182 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
10183 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
10184 vv(1)=pizda(1,1)-pizda(2,2)
10185 vv(2)=pizda(1,2)+pizda(2,1)
10186 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10189 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10191 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10194 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10195 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10197 C Derivatives in gamma(l-1) or gamma(j-1)
10200 s1=dip(1,jj,i)*dipderg(3,kk,k)
10202 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10203 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10204 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10205 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10206 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10207 vv(1)=pizda(1,1)-pizda(2,2)
10208 vv(2)=pizda(1,2)+pizda(2,1)
10209 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10212 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10214 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10217 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10218 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10220 C Cartesian derivatives.
10222 write (2,*) 'In eello6_graph2'
10224 write (2,*) 'iii=',iii
10226 write (2,*) 'kkk=',kkk
10228 write (2,'(3(2f10.5),5x)')
10229 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10239 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10241 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10244 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
10246 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10247 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
10249 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10250 call transpose2(EUg(1,1,k),auxmat(1,1))
10251 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
10253 vv(1)=pizda(1,1)-pizda(2,2)
10254 vv(2)=pizda(1,2)+pizda(2,1)
10255 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10256 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10258 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10260 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10263 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10265 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10272 c----------------------------------------------------------------------------
10273 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
10274 implicit real*8 (a-h,o-z)
10275 include 'DIMENSIONS'
10276 include 'COMMON.IOUNITS'
10277 include 'COMMON.CHAIN'
10278 include 'COMMON.DERIV'
10279 include 'COMMON.INTERACT'
10280 include 'COMMON.CONTACTS'
10281 include 'COMMON.TORSION'
10282 include 'COMMON.VAR'
10283 include 'COMMON.GEO'
10284 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
10286 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10288 C Parallel Antiparallel C
10293 C /| o |o o| o |\ C
10294 C j|/k\| / |/k\|l / C
10299 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10301 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10302 C energy moment and not to the cluster cumulant.
10303 iti=itortyp(itype(i))
10304 if (j.lt.nres-1) then
10305 itj1=itype2loc(itype(j+1))
10309 itk=itype2loc(itype(k))
10310 itk1=itype2loc(itype(k+1))
10311 if (l.lt.nres-1) then
10312 itl1=itype2loc(itype(l+1))
10317 s1=dip(4,jj,i)*dip(4,kk,k)
10319 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
10320 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10321 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
10322 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10323 call transpose2(EE(1,1,k),auxmat(1,1))
10324 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10325 vv(1)=pizda(1,1)+pizda(2,2)
10326 vv(2)=pizda(2,1)-pizda(1,2)
10327 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10328 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10329 cd & "sum",-(s2+s3+s4)
10331 eello6_graph3=-(s1+s2+s3+s4)
10333 eello6_graph3=-(s2+s3+s4)
10335 c eello6_graph3=-s4
10336 C Derivatives in gamma(k-1)
10337 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
10338 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10339 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10340 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10341 C Derivatives in gamma(l-1)
10342 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
10343 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10344 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10345 vv(1)=pizda(1,1)+pizda(2,2)
10346 vv(2)=pizda(2,1)-pizda(1,2)
10347 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10348 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10349 C Cartesian derivatives.
10355 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10357 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10360 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
10362 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10363 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
10365 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10366 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
10368 vv(1)=pizda(1,1)+pizda(2,2)
10369 vv(2)=pizda(2,1)-pizda(1,2)
10370 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10372 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10374 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10377 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10379 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10381 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10387 c----------------------------------------------------------------------------
10388 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10389 implicit real*8 (a-h,o-z)
10390 include 'DIMENSIONS'
10391 include 'COMMON.IOUNITS'
10392 include 'COMMON.CHAIN'
10393 include 'COMMON.DERIV'
10394 include 'COMMON.INTERACT'
10395 include 'COMMON.CONTACTS'
10396 include 'COMMON.TORSION'
10397 include 'COMMON.VAR'
10398 include 'COMMON.GEO'
10399 include 'COMMON.FFIELD'
10400 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10401 & auxvec1(2),auxmat1(2,2)
10403 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10405 C Parallel Antiparallel C
10410 C /| o |o o| o |\ C
10411 C \ j|/k\| \ |/k\|l C
10416 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10418 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10419 C energy moment and not to the cluster cumulant.
10420 cd write (2,*) 'eello_graph4: wturn6',wturn6
10421 iti=itype2loc(itype(i))
10422 itj=itype2loc(itype(j))
10423 if (j.lt.nres-1) then
10424 itj1=itype2loc(itype(j+1))
10428 itk=itype2loc(itype(k))
10429 if (k.lt.nres-1) then
10430 itk1=itype2loc(itype(k+1))
10434 itl=itype2loc(itype(l))
10435 if (l.lt.nres-1) then
10436 itl1=itype2loc(itype(l+1))
10440 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10441 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10442 cd & ' itl',itl,' itl1',itl1
10444 if (imat.eq.1) then
10445 s1=dip(3,jj,i)*dip(3,kk,k)
10447 s1=dip(2,jj,j)*dip(2,kk,l)
10450 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10451 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10453 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
10454 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10456 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
10457 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10459 call transpose2(EUg(1,1,k),auxmat(1,1))
10460 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10461 vv(1)=pizda(1,1)-pizda(2,2)
10462 vv(2)=pizda(2,1)+pizda(1,2)
10463 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10464 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10466 eello6_graph4=-(s1+s2+s3+s4)
10468 eello6_graph4=-(s2+s3+s4)
10470 C Derivatives in gamma(i-1)
10473 if (imat.eq.1) then
10474 s1=dipderg(2,jj,i)*dip(3,kk,k)
10476 s1=dipderg(4,jj,j)*dip(2,kk,l)
10479 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10481 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
10482 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10484 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
10485 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10487 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10488 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10489 cd write (2,*) 'turn6 derivatives'
10491 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10493 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10497 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10499 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10503 C Derivatives in gamma(k-1)
10505 if (imat.eq.1) then
10506 s1=dip(3,jj,i)*dipderg(2,kk,k)
10508 s1=dip(2,jj,j)*dipderg(4,kk,l)
10511 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10512 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10514 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
10515 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10517 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
10518 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10520 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10521 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10522 vv(1)=pizda(1,1)-pizda(2,2)
10523 vv(2)=pizda(2,1)+pizda(1,2)
10524 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10525 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10527 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10529 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10533 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10535 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10538 C Derivatives in gamma(j-1) or gamma(l-1)
10539 if (l.eq.j+1 .and. l.gt.1) then
10540 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10541 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10542 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10543 vv(1)=pizda(1,1)-pizda(2,2)
10544 vv(2)=pizda(2,1)+pizda(1,2)
10545 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10546 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10547 else if (j.gt.1) then
10548 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10549 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10550 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10551 vv(1)=pizda(1,1)-pizda(2,2)
10552 vv(2)=pizda(2,1)+pizda(1,2)
10553 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10554 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10555 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10557 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10560 C Cartesian derivatives.
10566 if (imat.eq.1) then
10567 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10569 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10572 if (imat.eq.1) then
10573 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10575 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10579 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
10581 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10583 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10584 & b1(1,j+1),auxvec(1))
10585 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
10587 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10588 & b1(1,l+1),auxvec(1))
10589 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
10591 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10593 vv(1)=pizda(1,1)-pizda(2,2)
10594 vv(2)=pizda(2,1)+pizda(1,2)
10595 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10597 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10599 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10602 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10605 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10608 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10610 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10612 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10616 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10618 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10621 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10623 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10631 c----------------------------------------------------------------------------
10632 double precision function eello_turn6(i,jj,kk)
10633 implicit real*8 (a-h,o-z)
10634 include 'DIMENSIONS'
10635 include 'COMMON.IOUNITS'
10636 include 'COMMON.CHAIN'
10637 include 'COMMON.DERIV'
10638 include 'COMMON.INTERACT'
10639 include 'COMMON.CONTACTS'
10640 include 'COMMON.TORSION'
10641 include 'COMMON.VAR'
10642 include 'COMMON.GEO'
10643 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
10644 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
10646 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
10647 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
10648 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10649 C the respective energy moment and not to the cluster cumulant.
10658 iti=itype2loc(itype(i))
10659 itk=itype2loc(itype(k))
10660 itk1=itype2loc(itype(k+1))
10661 itl=itype2loc(itype(l))
10662 itj=itype2loc(itype(j))
10663 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10664 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
10665 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10670 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10672 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10676 derx_turn(lll,kkk,iii)=0.0d0
10683 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10685 cd write (2,*) 'eello6_5',eello6_5
10687 call transpose2(AEA(1,1,1),auxmat(1,1))
10688 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10689 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10690 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10692 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10693 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10694 s2 = scalar2(b1(1,k),vtemp1(1))
10696 call transpose2(AEA(1,1,2),atemp(1,1))
10697 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10698 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10699 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10701 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10702 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10703 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10705 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10706 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10707 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10708 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10709 ss13 = scalar2(b1(1,k),vtemp4(1))
10710 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10712 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10718 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10719 C Derivatives in gamma(i+2)
10723 call transpose2(AEA(1,1,1),auxmatd(1,1))
10724 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10725 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10726 call transpose2(AEAderg(1,1,2),atempd(1,1))
10727 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10728 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10730 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10731 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10732 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10738 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10739 C Derivatives in gamma(i+3)
10741 call transpose2(AEA(1,1,1),auxmatd(1,1))
10742 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10743 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10744 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10746 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10747 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10748 s2d = scalar2(b1(1,k),vtemp1d(1))
10750 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10751 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10753 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10755 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10756 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10757 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10765 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10766 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10768 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10769 & -0.5d0*ekont*(s2d+s12d)
10771 C Derivatives in gamma(i+4)
10772 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10773 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10774 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10776 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10777 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10778 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10786 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10788 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10790 C Derivatives in gamma(i+5)
10792 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10793 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10794 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10796 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10797 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10798 s2d = scalar2(b1(1,k),vtemp1d(1))
10800 call transpose2(AEA(1,1,2),atempd(1,1))
10801 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10802 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10804 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10805 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10807 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10808 ss13d = scalar2(b1(1,k),vtemp4d(1))
10809 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10817 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10818 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10820 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10821 & -0.5d0*ekont*(s2d+s12d)
10823 C Cartesian derivatives
10828 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10829 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10830 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10832 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10833 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10835 s2d = scalar2(b1(1,k),vtemp1d(1))
10837 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10838 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10839 s8d = -(atempd(1,1)+atempd(2,2))*
10840 & scalar2(cc(1,1,itl),vtemp2(1))
10842 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10844 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10845 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10852 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10853 & - 0.5d0*(s1d+s2d)
10855 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10859 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10860 & - 0.5d0*(s8d+s12d)
10862 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10871 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10872 & achuj_tempd(1,1))
10873 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10874 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10875 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10876 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10877 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10879 ss13d = scalar2(b1(1,k),vtemp4d(1))
10880 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10881 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10885 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10886 cd & 16*eel_turn6_num
10888 if (j.lt.nres-1) then
10895 if (l.lt.nres-1) then
10903 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10904 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10905 cgrad ghalf=0.5d0*ggg1(ll)
10907 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10908 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10909 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10910 & +ekont*derx_turn(ll,2,1)
10911 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10912 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10913 & +ekont*derx_turn(ll,4,1)
10914 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10915 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10916 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10917 cgrad ghalf=0.5d0*ggg2(ll)
10919 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10920 & +ekont*derx_turn(ll,2,2)
10921 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10922 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10923 & +ekont*derx_turn(ll,4,2)
10924 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10925 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10926 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10931 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10936 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10942 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10947 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10951 cd write (2,*) iii,g_corr6_loc(iii)
10953 eello_turn6=ekont*eel_turn6
10954 cd write (2,*) 'ekont',ekont
10955 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10959 C-----------------------------------------------------------------------------
10960 double precision function scalar(u,v)
10961 !DIR$ INLINEALWAYS scalar
10963 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10966 double precision u(3),v(3)
10967 cd double precision sc
10975 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10978 crc-------------------------------------------------
10979 SUBROUTINE MATVEC2(A1,V1,V2)
10980 !DIR$ INLINEALWAYS MATVEC2
10982 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10984 implicit real*8 (a-h,o-z)
10985 include 'DIMENSIONS'
10986 DIMENSION A1(2,2),V1(2),V2(2)
10990 c 3 VI=VI+A1(I,K)*V1(K)
10994 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10995 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
11000 C---------------------------------------
11001 SUBROUTINE MATMAT2(A1,A2,A3)
11003 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
11005 implicit real*8 (a-h,o-z)
11006 include 'DIMENSIONS'
11007 DIMENSION A1(2,2),A2(2,2),A3(2,2)
11008 c DIMENSION AI3(2,2)
11012 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
11018 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
11019 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
11020 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
11021 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
11029 c-------------------------------------------------------------------------
11030 double precision function scalar2(u,v)
11031 !DIR$ INLINEALWAYS scalar2
11033 double precision u(2),v(2)
11034 double precision sc
11036 scalar2=u(1)*v(1)+u(2)*v(2)
11040 C-----------------------------------------------------------------------------
11042 subroutine transpose2(a,at)
11043 !DIR$ INLINEALWAYS transpose2
11045 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
11048 double precision a(2,2),at(2,2)
11055 c--------------------------------------------------------------------------
11056 subroutine transpose(n,a,at)
11059 double precision a(n,n),at(n,n)
11067 C---------------------------------------------------------------------------
11068 subroutine prodmat3(a1,a2,kk,transp,prod)
11069 !DIR$ INLINEALWAYS prodmat3
11071 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
11075 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
11077 crc double precision auxmat(2,2),prod_(2,2)
11080 crc call transpose2(kk(1,1),auxmat(1,1))
11081 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
11082 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11084 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
11085 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
11086 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
11087 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
11088 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
11089 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
11090 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
11091 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
11094 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
11095 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11097 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
11098 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
11099 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
11100 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
11101 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
11102 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
11103 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
11104 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
11107 c call transpose2(a2(1,1),a2t(1,1))
11110 crc print *,((prod_(i,j),i=1,2),j=1,2)
11111 crc print *,((prod(i,j),i=1,2),j=1,2)
11115 CCC----------------------------------------------
11116 subroutine Eliptransfer(eliptran)
11117 implicit real*8 (a-h,o-z)
11118 include 'DIMENSIONS'
11119 include 'COMMON.GEO'
11120 include 'COMMON.VAR'
11121 include 'COMMON.LOCAL'
11122 include 'COMMON.CHAIN'
11123 include 'COMMON.DERIV'
11124 include 'COMMON.NAMES'
11125 include 'COMMON.INTERACT'
11126 include 'COMMON.IOUNITS'
11127 include 'COMMON.CALC'
11128 include 'COMMON.CONTROL'
11129 include 'COMMON.SPLITELE'
11130 include 'COMMON.SBRIDGE'
11131 C this is done by Adasko
11132 C print *,"wchodze"
11133 C structure of box:
11135 C--bordliptop-- buffore starts
11136 C--bufliptop--- here true lipid starts
11138 C--buflipbot--- lipid ends buffore starts
11139 C--bordlipbot--buffore ends
11141 do i=ilip_start,ilip_end
11143 if (itype(i).eq.ntyp1) cycle
11145 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
11146 if (positi.le.0.0) positi=positi+boxzsize
11148 C first for peptide groups
11149 c for each residue check if it is in lipid or lipid water border area
11150 if ((positi.gt.bordlipbot)
11151 &.and.(positi.lt.bordliptop)) then
11152 C the energy transfer exist
11153 if (positi.lt.buflipbot) then
11154 C what fraction I am in
11156 & ((positi-bordlipbot)/lipbufthick)
11157 C lipbufthick is thickenes of lipid buffore
11158 sslip=sscalelip(fracinbuf)
11159 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11160 eliptran=eliptran+sslip*pepliptran
11161 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11162 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11163 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11165 C print *,"doing sccale for lower part"
11166 C print *,i,sslip,fracinbuf,ssgradlip
11167 elseif (positi.gt.bufliptop) then
11168 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
11169 sslip=sscalelip(fracinbuf)
11170 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11171 eliptran=eliptran+sslip*pepliptran
11172 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11173 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11174 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11175 C print *, "doing sscalefor top part"
11176 C print *,i,sslip,fracinbuf,ssgradlip
11178 eliptran=eliptran+pepliptran
11179 C print *,"I am in true lipid"
11182 C eliptran=elpitran+0.0 ! I am in water
11185 C print *, "nic nie bylo w lipidzie?"
11186 C now multiply all by the peptide group transfer factor
11187 C eliptran=eliptran*pepliptran
11188 C now the same for side chains
11190 do i=ilip_start,ilip_end
11191 if (itype(i).eq.ntyp1) cycle
11192 positi=(mod(c(3,i+nres),boxzsize))
11193 if (positi.le.0) positi=positi+boxzsize
11194 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
11195 c for each residue check if it is in lipid or lipid water border area
11196 C respos=mod(c(3,i+nres),boxzsize)
11197 C print *,positi,bordlipbot,buflipbot
11198 if ((positi.gt.bordlipbot)
11199 & .and.(positi.lt.bordliptop)) then
11200 C the energy transfer exist
11201 if (positi.lt.buflipbot) then
11203 & ((positi-bordlipbot)/lipbufthick)
11204 C lipbufthick is thickenes of lipid buffore
11205 sslip=sscalelip(fracinbuf)
11206 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11207 eliptran=eliptran+sslip*liptranene(itype(i))
11208 gliptranx(3,i)=gliptranx(3,i)
11209 &+ssgradlip*liptranene(itype(i))
11210 gliptranc(3,i-1)= gliptranc(3,i-1)
11211 &+ssgradlip*liptranene(itype(i))
11212 C print *,"doing sccale for lower part"
11213 elseif (positi.gt.bufliptop) then
11215 &((bordliptop-positi)/lipbufthick)
11216 sslip=sscalelip(fracinbuf)
11217 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11218 eliptran=eliptran+sslip*liptranene(itype(i))
11219 gliptranx(3,i)=gliptranx(3,i)
11220 &+ssgradlip*liptranene(itype(i))
11221 gliptranc(3,i-1)= gliptranc(3,i-1)
11222 &+ssgradlip*liptranene(itype(i))
11223 C print *, "doing sscalefor top part",sslip,fracinbuf
11225 eliptran=eliptran+liptranene(itype(i))
11226 C print *,"I am in true lipid"
11228 endif ! if in lipid or buffor
11230 C eliptran=elpitran+0.0 ! I am in water
11234 C---------------------------------------------------------
11235 C AFM soubroutine for constant force
11236 subroutine AFMforce(Eafmforce)
11237 implicit real*8 (a-h,o-z)
11238 include 'DIMENSIONS'
11239 include 'COMMON.GEO'
11240 include 'COMMON.VAR'
11241 include 'COMMON.LOCAL'
11242 include 'COMMON.CHAIN'
11243 include 'COMMON.DERIV'
11244 include 'COMMON.NAMES'
11245 include 'COMMON.INTERACT'
11246 include 'COMMON.IOUNITS'
11247 include 'COMMON.CALC'
11248 include 'COMMON.CONTROL'
11249 include 'COMMON.SPLITELE'
11250 include 'COMMON.SBRIDGE'
11255 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11256 dist=dist+diffafm(i)**2
11259 Eafmforce=-forceAFMconst*(dist-distafminit)
11261 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
11262 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
11264 C print *,'AFM',Eafmforce
11267 C---------------------------------------------------------
11268 C AFM subroutine with pseudoconstant velocity
11269 subroutine AFMvel(Eafmforce)
11270 implicit real*8 (a-h,o-z)
11271 include 'DIMENSIONS'
11272 include 'COMMON.GEO'
11273 include 'COMMON.VAR'
11274 include 'COMMON.LOCAL'
11275 include 'COMMON.CHAIN'
11276 include 'COMMON.DERIV'
11277 include 'COMMON.NAMES'
11278 include 'COMMON.INTERACT'
11279 include 'COMMON.IOUNITS'
11280 include 'COMMON.CALC'
11281 include 'COMMON.CONTROL'
11282 include 'COMMON.SPLITELE'
11283 include 'COMMON.SBRIDGE'
11285 C Only for check grad COMMENT if not used for checkgrad
11287 C--------------------------------------------------------
11288 C print *,"wchodze"
11292 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11293 dist=dist+diffafm(i)**2
11296 Eafmforce=0.5d0*forceAFMconst
11297 & *(distafminit+totTafm*velAFMconst-dist)**2
11298 C Eafmforce=-forceAFMconst*(dist-distafminit)
11300 gradafm(i,afmend-1)=-forceAFMconst*
11301 &(distafminit+totTafm*velAFMconst-dist)
11303 gradafm(i,afmbeg-1)=forceAFMconst*
11304 &(distafminit+totTafm*velAFMconst-dist)
11307 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
11310 C-----------------------------------------------------------
11311 C first for shielding is setting of function of side-chains
11312 subroutine set_shield_fac
11313 implicit real*8 (a-h,o-z)
11314 include 'DIMENSIONS'
11315 include 'COMMON.CHAIN'
11316 include 'COMMON.DERIV'
11317 include 'COMMON.IOUNITS'
11318 include 'COMMON.SHIELD'
11319 include 'COMMON.INTERACT'
11320 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11321 double precision div77_81/0.974996043d0/,
11322 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11324 C the vector between center of side_chain and peptide group
11325 double precision pep_side(3),long,side_calf(3),
11326 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11327 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11328 C the line belowe needs to be changed for FGPROC>1
11330 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11332 Cif there two consequtive dummy atoms there is no peptide group between them
11333 C the line below has to be changed for FGPROC>1
11336 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11340 C first lets set vector conecting the ithe side-chain with kth side-chain
11341 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11342 C pep_side(j)=2.0d0
11343 C and vector conecting the side-chain with its proper calfa
11344 side_calf(j)=c(j,k+nres)-c(j,k)
11345 C side_calf(j)=2.0d0
11346 pept_group(j)=c(j,i)-c(j,i+1)
11347 C lets have their lenght
11348 dist_pep_side=pep_side(j)**2+dist_pep_side
11349 dist_side_calf=dist_side_calf+side_calf(j)**2
11350 dist_pept_group=dist_pept_group+pept_group(j)**2
11352 dist_pep_side=dsqrt(dist_pep_side)
11353 dist_pept_group=dsqrt(dist_pept_group)
11354 dist_side_calf=dsqrt(dist_side_calf)
11356 pep_side_norm(j)=pep_side(j)/dist_pep_side
11357 side_calf_norm(j)=dist_side_calf
11359 C now sscale fraction
11360 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
11361 C print *,buff_shield,"buff"
11363 if (sh_frac_dist.le.0.0) cycle
11364 C If we reach here it means that this side chain reaches the shielding sphere
11365 C Lets add him to the list for gradient
11366 ishield_list(i)=ishield_list(i)+1
11367 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
11368 C this list is essential otherwise problem would be O3
11369 shield_list(ishield_list(i),i)=k
11370 C Lets have the sscale value
11371 if (sh_frac_dist.gt.1.0) then
11372 scale_fac_dist=1.0d0
11374 sh_frac_dist_grad(j)=0.0d0
11377 scale_fac_dist=-sh_frac_dist*sh_frac_dist
11378 & *(2.0*sh_frac_dist-3.0d0)
11379 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
11380 & /dist_pep_side/buff_shield*0.5
11381 C remember for the final gradient multiply sh_frac_dist_grad(j)
11382 C for side_chain by factor -2 !
11384 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
11385 C print *,"jestem",scale_fac_dist,fac_help_scale,
11386 C & sh_frac_dist_grad(j)
11389 C if ((i.eq.3).and.(k.eq.2)) then
11390 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
11394 C this is what is now we have the distance scaling now volume...
11395 short=short_r_sidechain(itype(k))
11396 long=long_r_sidechain(itype(k))
11397 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
11400 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
11401 C costhet_fac=0.0d0
11403 costhet_grad(j)=costhet_fac*pep_side(j)
11405 C remember for the final gradient multiply costhet_grad(j)
11406 C for side_chain by factor -2 !
11407 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
11408 C pep_side0pept_group is vector multiplication
11409 pep_side0pept_group=0.0
11411 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
11413 cosalfa=(pep_side0pept_group/
11414 & (dist_pep_side*dist_side_calf))
11415 fac_alfa_sin=1.0-cosalfa**2
11416 fac_alfa_sin=dsqrt(fac_alfa_sin)
11417 rkprim=fac_alfa_sin*(long-short)+short
11419 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
11420 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
11423 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
11424 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11425 &*(long-short)/fac_alfa_sin*cosalfa/
11426 &((dist_pep_side*dist_side_calf))*
11427 &((side_calf(j))-cosalfa*
11428 &((pep_side(j)/dist_pep_side)*dist_side_calf))
11430 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11431 &*(long-short)/fac_alfa_sin*cosalfa
11432 &/((dist_pep_side*dist_side_calf))*
11434 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
11437 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
11440 C now the gradient...
11441 C grad_shield is gradient of Calfa for peptide groups
11442 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
11444 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
11445 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
11447 grad_shield(j,i)=grad_shield(j,i)
11448 C gradient po skalowaniu
11449 & +(sh_frac_dist_grad(j)
11450 C gradient po costhet
11451 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
11452 &-scale_fac_dist*(cosphi_grad_long(j))
11453 &/(1.0-cosphi) )*div77_81
11455 C grad_shield_side is Cbeta sidechain gradient
11456 grad_shield_side(j,ishield_list(i),i)=
11457 & (sh_frac_dist_grad(j)*-2.0d0
11458 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
11459 & +scale_fac_dist*(cosphi_grad_long(j))
11460 & *2.0d0/(1.0-cosphi))
11461 & *div77_81*VofOverlap
11463 grad_shield_loc(j,ishield_list(i),i)=
11464 & scale_fac_dist*cosphi_grad_loc(j)
11465 & *2.0d0/(1.0-cosphi)
11466 & *div77_81*VofOverlap
11468 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
11470 fac_shield(i)=VolumeTotal*div77_81+div4_81
11471 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
11475 C--------------------------------------------------------------------------
11476 double precision function tschebyshev(m,n,x,y)
11478 include "DIMENSIONS"
11480 double precision x(n),y,yy(0:maxvar),aux
11481 c Tschebyshev polynomial. Note that the first term is omitted
11482 c m=0: the constant term is included
11483 c m=1: the constant term is not included
11487 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
11496 C--------------------------------------------------------------------------
11497 double precision function gradtschebyshev(m,n,x,y)
11499 include "DIMENSIONS"
11501 double precision x(n+1),y,yy(0:maxvar),aux
11502 c Tschebyshev polynomial. Note that the first term is omitted
11503 c m=0: the constant term is included
11504 c m=1: the constant term is not included
11508 yy(i)=2*y*yy(i-1)-yy(i-2)
11512 aux=aux+x(i+1)*yy(i)*(i+1)
11513 C print *, x(i+1),yy(i),i
11515 gradtschebyshev=aux
11518 C------------------------------------------------------------------------
11519 C first for shielding is setting of function of side-chains
11520 subroutine set_shield_fac2
11521 implicit real*8 (a-h,o-z)
11522 include 'DIMENSIONS'
11523 include 'COMMON.CHAIN'
11524 include 'COMMON.DERIV'
11525 include 'COMMON.IOUNITS'
11526 include 'COMMON.SHIELD'
11527 include 'COMMON.INTERACT'
11528 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11529 double precision div77_81/0.974996043d0/,
11530 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11532 C the vector between center of side_chain and peptide group
11533 double precision pep_side(3),long,side_calf(3),
11534 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11535 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11536 C the line belowe needs to be changed for FGPROC>1
11538 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11540 Cif there two consequtive dummy atoms there is no peptide group between them
11541 C the line below has to be changed for FGPROC>1
11544 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11548 C first lets set vector conecting the ithe side-chain with kth side-chain
11549 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11550 C pep_side(j)=2.0d0
11551 C and vector conecting the side-chain with its proper calfa
11552 side_calf(j)=c(j,k+nres)-c(j,k)
11553 C side_calf(j)=2.0d0
11554 pept_group(j)=c(j,i)-c(j,i+1)
11555 C lets have their lenght
11556 dist_pep_side=pep_side(j)**2+dist_pep_side
11557 dist_side_calf=dist_side_calf+side_calf(j)**2
11558 dist_pept_group=dist_pept_group+pept_group(j)**2
11560 dist_pep_side=dsqrt(dist_pep_side)
11561 dist_pept_group=dsqrt(dist_pept_group)
11562 dist_side_calf=dsqrt(dist_side_calf)
11564 pep_side_norm(j)=pep_side(j)/dist_pep_side
11565 side_calf_norm(j)=dist_side_calf
11567 C now sscale fraction
11568 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
11569 C print *,buff_shield,"buff"
11571 if (sh_frac_dist.le.0.0) cycle
11572 C If we reach here it means that this side chain reaches the shielding sphere
11573 C Lets add him to the list for gradient
11574 ishield_list(i)=ishield_list(i)+1
11575 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
11576 C this list is essential otherwise problem would be O3
11577 shield_list(ishield_list(i),i)=k
11578 C Lets have the sscale value
11579 if (sh_frac_dist.gt.1.0) then
11580 scale_fac_dist=1.0d0
11582 sh_frac_dist_grad(j)=0.0d0
11585 scale_fac_dist=-sh_frac_dist*sh_frac_dist
11586 & *(2.0d0*sh_frac_dist-3.0d0)
11587 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
11588 & /dist_pep_side/buff_shield*0.5d0
11589 C remember for the final gradient multiply sh_frac_dist_grad(j)
11590 C for side_chain by factor -2 !
11592 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
11593 C sh_frac_dist_grad(j)=0.0d0
11594 C scale_fac_dist=1.0d0
11595 C print *,"jestem",scale_fac_dist,fac_help_scale,
11596 C & sh_frac_dist_grad(j)
11599 C this is what is now we have the distance scaling now volume...
11600 short=short_r_sidechain(itype(k))
11601 long=long_r_sidechain(itype(k))
11602 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
11603 sinthet=short/dist_pep_side*costhet
11607 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
11608 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
11609 C & -short/dist_pep_side**2/costhet)
11610 C costhet_fac=0.0d0
11612 costhet_grad(j)=costhet_fac*pep_side(j)
11614 C remember for the final gradient multiply costhet_grad(j)
11615 C for side_chain by factor -2 !
11616 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
11617 C pep_side0pept_group is vector multiplication
11618 pep_side0pept_group=0.0d0
11620 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
11622 cosalfa=(pep_side0pept_group/
11623 & (dist_pep_side*dist_side_calf))
11624 fac_alfa_sin=1.0d0-cosalfa**2
11625 fac_alfa_sin=dsqrt(fac_alfa_sin)
11626 rkprim=fac_alfa_sin*(long-short)+short
11630 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
11632 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
11633 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
11634 & dist_pep_side**2)
11637 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
11638 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
11639 &*(long-short)/fac_alfa_sin*cosalfa/
11640 &((dist_pep_side*dist_side_calf))*
11641 &((side_calf(j))-cosalfa*
11642 &((pep_side(j)/dist_pep_side)*dist_side_calf))
11643 C cosphi_grad_long(j)=0.0d0
11644 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
11645 &*(long-short)/fac_alfa_sin*cosalfa
11646 &/((dist_pep_side*dist_side_calf))*
11648 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
11649 C cosphi_grad_loc(j)=0.0d0
11651 C print *,sinphi,sinthet
11652 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
11655 C now the gradient...
11657 grad_shield(j,i)=grad_shield(j,i)
11658 C gradient po skalowaniu
11659 & +(sh_frac_dist_grad(j)*VofOverlap
11660 C gradient po costhet
11661 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
11662 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
11663 & sinphi/sinthet*costhet*costhet_grad(j)
11664 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
11666 C grad_shield_side is Cbeta sidechain gradient
11667 grad_shield_side(j,ishield_list(i),i)=
11668 & (sh_frac_dist_grad(j)*-2.0d0
11670 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
11671 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
11672 & sinphi/sinthet*costhet*costhet_grad(j)
11673 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
11676 grad_shield_loc(j,ishield_list(i),i)=
11677 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
11678 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
11679 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
11683 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
11685 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
11686 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
11690 C-----------------------------------------------------------------------
11691 C-----------------------------------------------------------
11692 C This subroutine is to mimic the histone like structure but as well can be
11693 C utilizet to nanostructures (infinit) small modification has to be used to
11694 C make it finite (z gradient at the ends has to be changes as well as the x,y
11695 C gradient has to be modified at the ends
11696 C The energy function is Kihara potential
11697 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
11698 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
11699 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
11700 C simple Kihara potential
11701 subroutine calctube(Etube)
11702 implicit real*8 (a-h,o-z)
11703 include 'DIMENSIONS'
11704 include 'COMMON.GEO'
11705 include 'COMMON.VAR'
11706 include 'COMMON.LOCAL'
11707 include 'COMMON.CHAIN'
11708 include 'COMMON.DERIV'
11709 include 'COMMON.NAMES'
11710 include 'COMMON.INTERACT'
11711 include 'COMMON.IOUNITS'
11712 include 'COMMON.CALC'
11713 include 'COMMON.CONTROL'
11714 include 'COMMON.SPLITELE'
11715 include 'COMMON.SBRIDGE'
11716 double precision tub_r,vectube(3),enetube(maxres*2)
11721 C first we calculate the distance from tube center
11722 C first sugare-phosphate group for NARES this would be peptide group
11725 C lets ommit dummy atoms for now
11726 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
11727 C now calculate distance from center of tube and direction vectors
11728 vectube(1)=(c(1,i)+c(1,i+1))/2.0d0-tubecenter(1)
11729 vectube(2)=(c(2,i)+c(2,i+1))/2.0d0-tubecenter(2)
11730 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
11731 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
11733 C as the tube is infinity we do not calculate the Z-vector use of Z
11736 C now calculte the distance
11737 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
11738 C now normalize vector
11739 vectube(1)=vectube(1)/tub_r
11740 vectube(2)=vectube(2)/tub_r
11741 C calculte rdiffrence between r and r0
11744 rdiff6=rdiff**6.0d0
11745 C for vectorization reasons we will sumup at the end to avoid depenence of previous
11746 enetube(i)=pep_aa_tube/rdiff6**2.0d0-pep_bb_tube/rdiff6
11747 C write(iout,*) "TU13",i,rdiff6,enetube(i)
11748 C print *,rdiff,rdiff6,pep_aa_tube
11749 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
11750 C now we calculate gradient
11751 fac=(-12.0d0*pep_aa_tube/rdiff6+
11752 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
11753 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
11756 C now direction of gg_tube vector
11758 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
11759 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
11762 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
11764 C Lets not jump over memory as we use many times iti
11766 C lets ommit dummy atoms for now
11768 C in UNRES uncomment the line below as GLY has no side-chain...
11771 vectube(1)=c(1,i+nres)-tubecenter(1)
11772 vectube(2)=c(2,i+nres)-tubecenter(2)
11774 C as the tube is infinity we do not calculate the Z-vector use of Z
11777 C now calculte the distance
11778 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
11779 C now normalize vector
11780 vectube(1)=vectube(1)/tub_r
11781 vectube(2)=vectube(2)/tub_r
11782 C calculte rdiffrence between r and r0
11785 rdiff6=rdiff**6.0d0
11786 C for vectorization reasons we will sumup at the end to avoid depenence of previous
11787 sc_aa_tube=sc_aa_tube_par(iti)
11788 sc_bb_tube=sc_bb_tube_par(iti)
11789 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0-sc_bb_tube/rdiff6
11790 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
11791 C now we calculate gradient
11792 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff+
11793 & 6.0d0*sc_bb_tube/rdiff6/rdiff
11794 C now direction of gg_tube vector
11796 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
11797 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
11801 Etube=Etube+enetube(i)
11803 C print *,"ETUBE", etube
11806 C TO DO 1) add to total energy
11807 C 2) add to gradient summation
11808 C 3) add reading parameters (AND of course oppening of PARAM file)
11809 C 4) add reading the center of tube
11811 C 6) add to zerograd