1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
27 include 'COMMON.SPLITELE'
29 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
30 c & " nfgtasks",nfgtasks
31 if (nfgtasks.gt.1) then
33 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
34 if (fg_rank.eq.0) then
35 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
36 c print *,"Processor",myrank," BROADCAST iorder"
37 C FG master sets up the WEIGHTS_ array which will be broadcast to the
38 C FG slaves as WEIGHTS array.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
85 time_Bcast=time_Bcast+MPI_Wtime()-time00
86 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
87 c call chainbuild_cart
89 c print *,'Processor',myrank,' calling etotal ipot=',ipot
90 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
92 c if (modecalc.eq.12.or.modecalc.eq.14) then
93 c call int_from_cart1(.false.)
100 C Compute the side-chain and electrostatic interaction energy
103 goto (101,102,103,104,105,106) ipot
104 C Lennard-Jones potential.
106 cd print '(a)','Exit ELJ'
108 C Lennard-Jones-Kihara potential (shifted).
111 C Berne-Pechukas potential (dilated LJ, angular dependence).
114 C Gay-Berne potential (shifted LJ, angular dependence).
116 C print *,"bylem w egb"
118 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
121 C Soft-sphere potential
122 106 call e_softsphere(evdw)
124 C Calculate electrostatic (H-bonding) energy of the main chain.
128 cmc Sep-06: egb takes care of dynamic ss bonds too
130 c if (dyn_ss) call dyn_set_nss
132 c print *,"Processor",myrank," computed USCSC"
138 time_vec=time_vec+MPI_Wtime()-time01
140 C Introduction of shielding effect first for each peptide group
141 C the shielding factor is set this factor is describing how each
142 C peptide group is shielded by side-chains
143 C the matrix - shield_fac(i) the i index describe the ith between i and i+1
144 C write (iout,*) "shield_mode",shield_mode
145 if (shield_mode.gt.0) then
148 c print *,"Processor",myrank," left VEC_AND_DERIV"
151 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
152 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
153 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
154 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
156 if (welec.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 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
170 write (iout,*) "Soft-spheer ELEC potential"
171 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
174 c print *,"Processor",myrank," computed UELEC"
176 C Calculate excluded-volume interaction energy between peptide groups
181 call escp(evdw2,evdw2_14)
187 c write (iout,*) "Soft-sphere SCP potential"
188 call escp_soft_sphere(evdw2,evdw2_14)
191 c Calculate the bond-stretching energy
195 C Calculate the disulfide-bridge and other energy and the contributions
196 C from other distance constraints.
197 cd print *,'Calling EHPB'
199 cd print *,'EHPB exitted succesfully.'
201 C Calculate the virtual-bond-angle energy.
203 if (wang.gt.0d0) then
204 if ((tor_mode.eq.0).or.(tor_mode.eq.2)) then
205 call ebend(ebe,ethetacnstr)
207 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
209 if ((tor_mode.eq.1).or.(tor_mode.eq.2)) then
210 call ebend_kcc(ebe,ethetacnstr)
216 c print *,"Processor",myrank," computed UB"
218 C Calculate the SC local energy.
220 C print *,"TU DOCHODZE?"
222 c print *,"Processor",myrank," computed USC"
224 C Calculate the virtual-bond torsional energy.
226 cd print *,'nterm=',nterm
227 C print *,"tor",tor_mode
229 if ((tor_mode.eq.0).or.(tor_mode.eq.2)) then
230 call etor(etors,edihcnstr)
232 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
234 if ((tor_mode.eq.1).or.(tor_mode.eq.2)) then
235 call etor_kcc(etors,edihcnstr)
241 c print *,"Processor",myrank," computed Utor"
243 C 6/23/01 Calculate double-torsional energy
245 if ((wtor_d.gt.0).and.((tor_mode.eq.0).or.(tor_mode.eq.2))) then
250 c print *,"Processor",myrank," computed Utord"
252 C 21/5/07 Calculate local sicdechain correlation energy
254 if (wsccor.gt.0.0d0) then
255 call eback_sc_corr(esccor)
259 C print *,"PRZED MULIt"
260 c print *,"Processor",myrank," computed Usccorr"
262 C 12/1/95 Multi-body terms
266 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
267 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
268 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
269 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
270 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
277 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
278 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
279 cd write (iout,*) "multibody_hb ecorr",ecorr
281 c print *,"Processor",myrank," computed Ucorr"
283 C If performing constraint dynamics, call the constraint energy
284 C after the equilibration time
285 if(usampl.and.totT.gt.eq_time) then
292 C 01/27/2015 added by adasko
293 C the energy component below is energy transfer into lipid environment
294 C based on partition function
295 C print *,"przed lipidami"
296 if (wliptran.gt.0) then
297 call Eliptransfer(eliptran)
299 C print *,"za lipidami"
300 if (AFMlog.gt.0) then
301 call AFMforce(Eafmforce)
302 else if (selfguide.gt.0) then
303 call AFMvel(Eafmforce)
306 time_enecalc=time_enecalc+MPI_Wtime()-time00
308 c print *,"Processor",myrank," computed Uconstr"
317 energia(2)=evdw2-evdw2_14
334 energia(8)=eello_turn3
335 energia(9)=eello_turn4
342 energia(19)=edihcnstr
344 energia(20)=Uconst+Uconst_back
347 energia(23)=Eafmforce
348 energia(24)=ethetacnstr
349 c Here are the energies showed per procesor if the are more processors
350 c per molecule then we sum it up in sum_energy subroutine
351 c print *," Processor",myrank," calls SUM_ENERGY"
352 call sum_energy(energia,.true.)
353 if (dyn_ss) call dyn_set_nss
354 c print *," Processor",myrank," left SUM_ENERGY"
356 time_sumene=time_sumene+MPI_Wtime()-time00
360 c-------------------------------------------------------------------------------
361 subroutine sum_energy(energia,reduce)
362 implicit real*8 (a-h,o-z)
367 cMS$ATTRIBUTES C :: proc_proc
373 include 'COMMON.SETUP'
374 include 'COMMON.IOUNITS'
375 double precision energia(0:n_ene),enebuff(0:n_ene+1)
376 include 'COMMON.FFIELD'
377 include 'COMMON.DERIV'
378 include 'COMMON.INTERACT'
379 include 'COMMON.SBRIDGE'
380 include 'COMMON.CHAIN'
382 include 'COMMON.CONTROL'
383 include 'COMMON.TIME1'
386 if (nfgtasks.gt.1 .and. reduce) then
388 write (iout,*) "energies before REDUCE"
389 call enerprint(energia)
393 enebuff(i)=energia(i)
396 call MPI_Barrier(FG_COMM,IERR)
397 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
399 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
400 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
402 write (iout,*) "energies after REDUCE"
403 call enerprint(energia)
406 time_Reduce=time_Reduce+MPI_Wtime()-time00
408 if (fg_rank.eq.0) then
412 evdw2=energia(2)+energia(18)
428 eello_turn3=energia(8)
429 eello_turn4=energia(9)
436 edihcnstr=energia(19)
441 Eafmforce=energia(23)
442 ethetacnstr=energia(24)
444 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
445 & +wang*ebe+wtor*etors+wscloc*escloc
446 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
447 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
448 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
449 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+Eafmforce
452 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
453 & +wang*ebe+wtor*etors+wscloc*escloc
454 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
455 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
456 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
457 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
465 if (isnan(etot).ne.0) energia(0)=1.0d+99
467 if (isnan(etot)) energia(0)=1.0d+99
472 idumm=proc_proc(etot,i)
474 call proc_proc(etot,i)
476 if(i.eq.1)energia(0)=1.0d+99
483 c-------------------------------------------------------------------------------
484 subroutine sum_gradient
485 implicit real*8 (a-h,o-z)
490 cMS$ATTRIBUTES C :: proc_proc
496 double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
497 & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
498 & ,gloc_scbuf(3,-1:maxres)
499 include 'COMMON.SETUP'
500 include 'COMMON.IOUNITS'
501 include 'COMMON.FFIELD'
502 include 'COMMON.DERIV'
503 include 'COMMON.INTERACT'
504 include 'COMMON.SBRIDGE'
505 include 'COMMON.CHAIN'
507 include 'COMMON.CONTROL'
508 include 'COMMON.TIME1'
509 include 'COMMON.MAXGRAD'
510 include 'COMMON.SCCOR'
515 write (iout,*) "sum_gradient gvdwc, gvdwx"
517 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
518 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
523 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
524 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
525 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
528 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
529 C in virtual-bond-vector coordinates
532 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
534 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
535 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
537 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
539 c write (iout,'(i5,3f10.5,2x,f10.5)')
540 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
542 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
544 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
545 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
553 gradbufc(j,i)=wsc*gvdwc(j,i)+
554 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
555 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
556 & wel_loc*gel_loc_long(j,i)+
557 & wcorr*gradcorr_long(j,i)+
558 & wcorr5*gradcorr5_long(j,i)+
559 & wcorr6*gradcorr6_long(j,i)+
560 & wturn6*gcorr6_turn_long(j,i)+
562 & +wliptran*gliptranc(j,i)
564 & +welec*gshieldc(j,i)
565 & +wcorr*gshieldc_ec(j,i)
566 & +wturn3*gshieldc_t3(j,i)
567 & +wturn4*gshieldc_t4(j,i)
568 & +wel_loc*gshieldc_ll(j,i)
576 gradbufc(j,i)=wsc*gvdwc(j,i)+
577 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
578 & welec*gelc_long(j,i)+
580 & wel_loc*gel_loc_long(j,i)+
581 & wcorr*gradcorr_long(j,i)+
582 & wcorr5*gradcorr5_long(j,i)+
583 & wcorr6*gradcorr6_long(j,i)+
584 & wturn6*gcorr6_turn_long(j,i)+
586 & +wliptran*gliptranc(j,i)
588 & +welec*gshieldc(j,i)
589 & +wcorr*gshieldc_ec(j,i)
590 & +wturn4*gshieldc_t4(j,i)
591 & +wel_loc*gshieldc_ll(j,i)
598 if (nfgtasks.gt.1) then
601 write (iout,*) "gradbufc before allreduce"
603 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
609 gradbufc_sum(j,i)=gradbufc(j,i)
612 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
613 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
614 c time_reduce=time_reduce+MPI_Wtime()-time00
616 c write (iout,*) "gradbufc_sum after allreduce"
618 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
623 c time_allreduce=time_allreduce+MPI_Wtime()-time00
631 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
632 write (iout,*) (i," jgrad_start",jgrad_start(i),
633 & " jgrad_end ",jgrad_end(i),
634 & i=igrad_start,igrad_end)
637 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
638 c do not parallelize this part.
640 c do i=igrad_start,igrad_end
641 c do j=jgrad_start(i),jgrad_end(i)
643 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
648 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
652 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
656 write (iout,*) "gradbufc after summing"
658 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
665 write (iout,*) "gradbufc"
667 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
673 gradbufc_sum(j,i)=gradbufc(j,i)
678 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
682 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
687 c gradbufc(k,i)=0.0d0
691 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
696 write (iout,*) "gradbufc after summing"
698 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
706 gradbufc(k,nres)=0.0d0
711 C print *,gradbufc(1,13)
712 C print *,welec*gelc(1,13)
713 C print *,wel_loc*gel_loc(1,13)
714 C print *,0.5d0*(wscp*gvdwc_scpp(1,13))
715 C print *,welec*gelc_long(1,13)+wvdwpp*gvdwpp(1,13)
716 C print *,wel_loc*gel_loc_long(1,13)
717 C print *,gradafm(1,13),"AFM"
718 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
719 & wel_loc*gel_loc(j,i)+
720 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
721 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
722 & wel_loc*gel_loc_long(j,i)+
723 & wcorr*gradcorr_long(j,i)+
724 & wcorr5*gradcorr5_long(j,i)+
725 & wcorr6*gradcorr6_long(j,i)+
726 & wturn6*gcorr6_turn_long(j,i))+
728 & wcorr*gradcorr(j,i)+
729 & wturn3*gcorr3_turn(j,i)+
730 & wturn4*gcorr4_turn(j,i)+
731 & wcorr5*gradcorr5(j,i)+
732 & wcorr6*gradcorr6(j,i)+
733 & wturn6*gcorr6_turn(j,i)+
734 & wsccor*gsccorc(j,i)
735 & +wscloc*gscloc(j,i)
736 & +wliptran*gliptranc(j,i)
738 & +welec*gshieldc(j,i)
739 & +welec*gshieldc_loc(j,i)
740 & +wcorr*gshieldc_ec(j,i)
741 & +wcorr*gshieldc_loc_ec(j,i)
742 & +wturn3*gshieldc_t3(j,i)
743 & +wturn3*gshieldc_loc_t3(j,i)
744 & +wturn4*gshieldc_t4(j,i)
745 & +wturn4*gshieldc_loc_t4(j,i)
746 & +wel_loc*gshieldc_ll(j,i)
747 & +wel_loc*gshieldc_loc_ll(j,i)
755 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
756 & wel_loc*gel_loc(j,i)+
757 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
758 & welec*gelc_long(j,i)+
759 & wel_loc*gel_loc_long(j,i)+
760 & wcorr*gcorr_long(j,i)+
761 & wcorr5*gradcorr5_long(j,i)+
762 & wcorr6*gradcorr6_long(j,i)+
763 & wturn6*gcorr6_turn_long(j,i))+
765 & wcorr*gradcorr(j,i)+
766 & wturn3*gcorr3_turn(j,i)+
767 & wturn4*gcorr4_turn(j,i)+
768 & wcorr5*gradcorr5(j,i)+
769 & wcorr6*gradcorr6(j,i)+
770 & wturn6*gcorr6_turn(j,i)+
771 & wsccor*gsccorc(j,i)
772 & +wscloc*gscloc(j,i)
773 & +wliptran*gliptranc(j,i)
775 & +welec*gshieldc(j,i)
776 & +welec*gshieldc_loc(j,i)
777 & +wcorr*gshieldc_ec(j,i)
778 & +wcorr*gshieldc_loc_ec(j,i)
779 & +wturn3*gshieldc_t3(j,i)
780 & +wturn3*gshieldc_loc_t3(j,i)
781 & +wturn4*gshieldc_t4(j,i)
782 & +wturn4*gshieldc_loc_t4(j,i)
783 & +wel_loc*gshieldc_ll(j,i)
784 & +wel_loc*gshieldc_loc_ll(j,i)
791 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
793 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
794 & wsccor*gsccorx(j,i)
795 & +wscloc*gsclocx(j,i)
796 & +wliptran*gliptranx(j,i)
797 & +welec*gshieldx(j,i)
798 & +wcorr*gshieldx_ec(j,i)
799 & +wturn3*gshieldx_t3(j,i)
800 & +wturn4*gshieldx_t4(j,i)
801 & +wel_loc*gshieldx_ll(j,i)
808 write (iout,*) "gloc before adding corr"
810 write (iout,*) i,gloc(i,icg)
814 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
815 & +wcorr5*g_corr5_loc(i)
816 & +wcorr6*g_corr6_loc(i)
817 & +wturn4*gel_loc_turn4(i)
818 & +wturn3*gel_loc_turn3(i)
819 & +wturn6*gel_loc_turn6(i)
820 & +wel_loc*gel_loc_loc(i)
823 write (iout,*) "gloc after adding corr"
825 write (iout,*) i,gloc(i,icg)
829 if (nfgtasks.gt.1) then
832 gradbufc(j,i)=gradc(j,i,icg)
833 gradbufx(j,i)=gradx(j,i,icg)
837 glocbuf(i)=gloc(i,icg)
841 write (iout,*) "gloc_sc before reduce"
844 write (iout,*) i,j,gloc_sc(j,i,icg)
851 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
855 call MPI_Barrier(FG_COMM,IERR)
856 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
858 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
859 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
860 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
861 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
862 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
863 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
864 time_reduce=time_reduce+MPI_Wtime()-time00
865 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
866 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
867 time_reduce=time_reduce+MPI_Wtime()-time00
870 write (iout,*) "gloc_sc after reduce"
873 write (iout,*) i,j,gloc_sc(j,i,icg)
879 write (iout,*) "gloc after reduce"
881 write (iout,*) i,gloc(i,icg)
886 if (gnorm_check) then
888 c Compute the maximum elements of the gradient
898 gcorr3_turn_max=0.0d0
899 gcorr4_turn_max=0.0d0
902 gcorr6_turn_max=0.0d0
912 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
913 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
914 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
915 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
916 & gvdwc_scp_max=gvdwc_scp_norm
917 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
918 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
919 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
920 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
921 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
922 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
923 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
924 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
925 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
926 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
927 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
928 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
929 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
931 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
932 & gcorr3_turn_max=gcorr3_turn_norm
933 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
935 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
936 & gcorr4_turn_max=gcorr4_turn_norm
937 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
938 if (gradcorr5_norm.gt.gradcorr5_max)
939 & gradcorr5_max=gradcorr5_norm
940 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
941 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
942 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
944 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
945 & gcorr6_turn_max=gcorr6_turn_norm
946 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
947 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
948 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
949 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
950 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
951 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
952 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
953 if (gradx_scp_norm.gt.gradx_scp_max)
954 & gradx_scp_max=gradx_scp_norm
955 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
956 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
957 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
958 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
959 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
960 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
961 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
962 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
966 open(istat,file=statname,position="append")
968 open(istat,file=statname,access="append")
970 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
971 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
972 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
973 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
974 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
975 & gsccorx_max,gsclocx_max
977 if (gvdwc_max.gt.1.0d4) then
978 write (iout,*) "gvdwc gvdwx gradb gradbx"
980 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
981 & gradb(j,i),gradbx(j,i),j=1,3)
983 call pdbout(0.0d0,'cipiszcze',iout)
989 write (iout,*) "gradc gradx gloc"
991 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
992 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
996 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
1000 c-------------------------------------------------------------------------------
1001 subroutine rescale_weights(t_bath)
1002 implicit real*8 (a-h,o-z)
1003 include 'DIMENSIONS'
1004 include 'COMMON.IOUNITS'
1005 include 'COMMON.FFIELD'
1006 include 'COMMON.SBRIDGE'
1007 double precision kfac /2.4d0/
1008 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
1010 c facT=2*temp0/(t_bath+temp0)
1011 if (rescale_mode.eq.0) then
1017 else if (rescale_mode.eq.1) then
1018 facT=kfac/(kfac-1.0d0+t_bath/temp0)
1019 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1020 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1021 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1022 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1023 else if (rescale_mode.eq.2) then
1029 facT=licznik/dlog(dexp(x)+dexp(-x))
1030 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
1031 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
1032 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
1033 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
1035 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1036 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1038 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1042 welec=weights(3)*fact
1043 wcorr=weights(4)*fact3
1044 wcorr5=weights(5)*fact4
1045 wcorr6=weights(6)*fact5
1046 wel_loc=weights(7)*fact2
1047 wturn3=weights(8)*fact2
1048 wturn4=weights(9)*fact3
1049 wturn6=weights(10)*fact5
1050 wtor=weights(13)*fact
1051 wtor_d=weights(14)*fact2
1052 wsccor=weights(21)*fact
1056 C------------------------------------------------------------------------
1057 subroutine enerprint(energia)
1058 implicit real*8 (a-h,o-z)
1059 include 'DIMENSIONS'
1060 include 'COMMON.IOUNITS'
1061 include 'COMMON.FFIELD'
1062 include 'COMMON.SBRIDGE'
1064 double precision energia(0:n_ene)
1069 evdw2=energia(2)+energia(18)
1081 eello_turn3=energia(8)
1082 eello_turn4=energia(9)
1083 eello_turn6=energia(10)
1089 edihcnstr=energia(19)
1093 eliptran=energia(22)
1094 Eafmforce=energia(23)
1095 ethetacnstr=energia(24)
1097 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1098 & estr,wbond,ebe,wang,
1099 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1101 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1102 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1103 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1105 10 format (/'Virtual-chain energies:'//
1106 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1107 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1108 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1109 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1110 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1111 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1112 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1113 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1114 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1115 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1116 & ' (SS bridges & dist. cnstr.)'/
1117 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1118 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1119 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1120 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1121 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1122 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1123 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1124 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1125 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1126 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1127 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1128 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1129 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1130 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1131 & 'ETOT= ',1pE16.6,' (total)')
1134 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1135 & estr,wbond,ebe,wang,
1136 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1138 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1139 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1140 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1142 10 format (/'Virtual-chain energies:'//
1143 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1144 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1145 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1146 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1147 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1148 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1149 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1150 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1151 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1152 & ' (SS bridges & dist. cnstr.)'/
1153 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1154 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1155 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1156 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1157 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1158 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1159 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1160 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1161 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1162 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1163 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1164 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1165 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1166 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1167 & 'ETOT= ',1pE16.6,' (total)')
1171 C-----------------------------------------------------------------------
1172 subroutine elj(evdw)
1174 C This subroutine calculates the interaction energy of nonbonded side chains
1175 C assuming the LJ potential of interaction.
1177 implicit real*8 (a-h,o-z)
1178 include 'DIMENSIONS'
1179 parameter (accur=1.0d-10)
1180 include 'COMMON.GEO'
1181 include 'COMMON.VAR'
1182 include 'COMMON.LOCAL'
1183 include 'COMMON.CHAIN'
1184 include 'COMMON.DERIV'
1185 include 'COMMON.INTERACT'
1186 include 'COMMON.TORSION'
1187 include 'COMMON.SBRIDGE'
1188 include 'COMMON.NAMES'
1189 include 'COMMON.IOUNITS'
1190 include 'COMMON.CONTACTS'
1192 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1194 do i=iatsc_s,iatsc_e
1195 itypi=iabs(itype(i))
1196 if (itypi.eq.ntyp1) cycle
1197 itypi1=iabs(itype(i+1))
1204 C Calculate SC interaction energy.
1206 do iint=1,nint_gr(i)
1207 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1208 cd & 'iend=',iend(i,iint)
1209 do j=istart(i,iint),iend(i,iint)
1210 itypj=iabs(itype(j))
1211 if (itypj.eq.ntyp1) cycle
1215 C Change 12/1/95 to calculate four-body interactions
1216 rij=xj*xj+yj*yj+zj*zj
1218 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1219 eps0ij=eps(itypi,itypj)
1221 C have you changed here?
1225 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1226 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1227 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1228 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1229 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1230 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1233 C Calculate the components of the gradient in DC and X
1235 fac=-rrij*(e1+evdwij)
1240 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1241 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1242 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1243 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1247 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1251 C 12/1/95, revised on 5/20/97
1253 C Calculate the contact function. The ith column of the array JCONT will
1254 C contain the numbers of atoms that make contacts with the atom I (of numbers
1255 C greater than I). The arrays FACONT and GACONT will contain the values of
1256 C the contact function and its derivative.
1258 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1259 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1260 C Uncomment next line, if the correlation interactions are contact function only
1261 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1263 sigij=sigma(itypi,itypj)
1264 r0ij=rs0(itypi,itypj)
1266 C Check whether the SC's are not too far to make a contact.
1269 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1270 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1272 if (fcont.gt.0.0D0) then
1273 C If the SC-SC distance if close to sigma, apply spline.
1274 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1275 cAdam & fcont1,fprimcont1)
1276 cAdam fcont1=1.0d0-fcont1
1277 cAdam if (fcont1.gt.0.0d0) then
1278 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1279 cAdam fcont=fcont*fcont1
1281 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1282 cga eps0ij=1.0d0/dsqrt(eps0ij)
1284 cga gg(k)=gg(k)*eps0ij
1286 cga eps0ij=-evdwij*eps0ij
1287 C Uncomment for AL's type of SC correlation interactions.
1288 cadam eps0ij=-evdwij
1289 num_conti=num_conti+1
1290 jcont(num_conti,i)=j
1291 facont(num_conti,i)=fcont*eps0ij
1292 fprimcont=eps0ij*fprimcont/rij
1294 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1295 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1296 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1297 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1298 gacont(1,num_conti,i)=-fprimcont*xj
1299 gacont(2,num_conti,i)=-fprimcont*yj
1300 gacont(3,num_conti,i)=-fprimcont*zj
1301 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1302 cd write (iout,'(2i3,3f10.5)')
1303 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1309 num_cont(i)=num_conti
1313 gvdwc(j,i)=expon*gvdwc(j,i)
1314 gvdwx(j,i)=expon*gvdwx(j,i)
1317 C******************************************************************************
1321 C To save time, the factor of EXPON has been extracted from ALL components
1322 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1325 C******************************************************************************
1328 C-----------------------------------------------------------------------------
1329 subroutine eljk(evdw)
1331 C This subroutine calculates the interaction energy of nonbonded side chains
1332 C assuming the LJK potential of interaction.
1334 implicit real*8 (a-h,o-z)
1335 include 'DIMENSIONS'
1336 include 'COMMON.GEO'
1337 include 'COMMON.VAR'
1338 include 'COMMON.LOCAL'
1339 include 'COMMON.CHAIN'
1340 include 'COMMON.DERIV'
1341 include 'COMMON.INTERACT'
1342 include 'COMMON.IOUNITS'
1343 include 'COMMON.NAMES'
1346 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1348 do i=iatsc_s,iatsc_e
1349 itypi=iabs(itype(i))
1350 if (itypi.eq.ntyp1) cycle
1351 itypi1=iabs(itype(i+1))
1356 C Calculate SC interaction energy.
1358 do iint=1,nint_gr(i)
1359 do j=istart(i,iint),iend(i,iint)
1360 itypj=iabs(itype(j))
1361 if (itypj.eq.ntyp1) cycle
1365 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1366 fac_augm=rrij**expon
1367 e_augm=augm(itypi,itypj)*fac_augm
1368 r_inv_ij=dsqrt(rrij)
1370 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1371 fac=r_shift_inv**expon
1372 C have you changed here?
1376 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1377 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1378 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1379 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1380 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1381 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1382 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1385 C Calculate the components of the gradient in DC and X
1387 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1392 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1393 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1394 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1395 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1399 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1407 gvdwc(j,i)=expon*gvdwc(j,i)
1408 gvdwx(j,i)=expon*gvdwx(j,i)
1413 C-----------------------------------------------------------------------------
1414 subroutine ebp(evdw)
1416 C This subroutine calculates the interaction energy of nonbonded side chains
1417 C assuming the Berne-Pechukas potential of interaction.
1419 implicit real*8 (a-h,o-z)
1420 include 'DIMENSIONS'
1421 include 'COMMON.GEO'
1422 include 'COMMON.VAR'
1423 include 'COMMON.LOCAL'
1424 include 'COMMON.CHAIN'
1425 include 'COMMON.DERIV'
1426 include 'COMMON.NAMES'
1427 include 'COMMON.INTERACT'
1428 include 'COMMON.IOUNITS'
1429 include 'COMMON.CALC'
1430 common /srutu/ icall
1431 c double precision rrsave(maxdim)
1434 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1436 c if (icall.eq.0) then
1442 do i=iatsc_s,iatsc_e
1443 itypi=iabs(itype(i))
1444 if (itypi.eq.ntyp1) cycle
1445 itypi1=iabs(itype(i+1))
1449 dxi=dc_norm(1,nres+i)
1450 dyi=dc_norm(2,nres+i)
1451 dzi=dc_norm(3,nres+i)
1452 c dsci_inv=dsc_inv(itypi)
1453 dsci_inv=vbld_inv(i+nres)
1455 C Calculate SC interaction energy.
1457 do iint=1,nint_gr(i)
1458 do j=istart(i,iint),iend(i,iint)
1460 itypj=iabs(itype(j))
1461 if (itypj.eq.ntyp1) cycle
1462 c dscj_inv=dsc_inv(itypj)
1463 dscj_inv=vbld_inv(j+nres)
1464 chi1=chi(itypi,itypj)
1465 chi2=chi(itypj,itypi)
1472 alf12=0.5D0*(alf1+alf2)
1473 C For diagnostics only!!!
1486 dxj=dc_norm(1,nres+j)
1487 dyj=dc_norm(2,nres+j)
1488 dzj=dc_norm(3,nres+j)
1489 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1490 cd if (icall.eq.0) then
1496 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1498 C Calculate whole angle-dependent part of epsilon and contributions
1499 C to its derivatives
1500 C have you changed here?
1501 fac=(rrij*sigsq)**expon2
1504 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1505 eps2der=evdwij*eps3rt
1506 eps3der=evdwij*eps2rt
1507 evdwij=evdwij*eps2rt*eps3rt
1510 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1512 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1513 cd & restyp(itypi),i,restyp(itypj),j,
1514 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1515 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1516 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1519 C Calculate gradient components.
1520 e1=e1*eps1*eps2rt**2*eps3rt**2
1521 fac=-expon*(e1+evdwij)
1524 C Calculate radial part of the gradient
1528 C Calculate the angular part of the gradient and sum add the contributions
1529 C to the appropriate components of the Cartesian gradient.
1537 C-----------------------------------------------------------------------------
1538 subroutine egb(evdw)
1540 C This subroutine calculates the interaction energy of nonbonded side chains
1541 C assuming the Gay-Berne potential of interaction.
1543 implicit real*8 (a-h,o-z)
1544 include 'DIMENSIONS'
1545 include 'COMMON.GEO'
1546 include 'COMMON.VAR'
1547 include 'COMMON.LOCAL'
1548 include 'COMMON.CHAIN'
1549 include 'COMMON.DERIV'
1550 include 'COMMON.NAMES'
1551 include 'COMMON.INTERACT'
1552 include 'COMMON.IOUNITS'
1553 include 'COMMON.CALC'
1554 include 'COMMON.CONTROL'
1555 include 'COMMON.SPLITELE'
1556 include 'COMMON.SBRIDGE'
1558 integer xshift,yshift,zshift
1561 ccccc energy_dec=.false.
1562 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1565 c if (icall.eq.0) lprn=.false.
1567 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1568 C we have the original box)
1572 do i=iatsc_s,iatsc_e
1573 itypi=iabs(itype(i))
1574 if (itypi.eq.ntyp1) cycle
1575 itypi1=iabs(itype(i+1))
1579 C Return atom into box, boxxsize is size of box in x dimension
1581 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1582 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1583 C Condition for being inside the proper box
1584 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1585 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1589 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1590 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1591 C Condition for being inside the proper box
1592 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1593 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1597 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1598 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1599 C Condition for being inside the proper box
1600 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1601 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1605 if (xi.lt.0) xi=xi+boxxsize
1607 if (yi.lt.0) yi=yi+boxysize
1609 if (zi.lt.0) zi=zi+boxzsize
1610 C define scaling factor for lipids
1612 C if (positi.le.0) positi=positi+boxzsize
1614 C first for peptide groups
1615 c for each residue check if it is in lipid or lipid water border area
1616 if ((zi.gt.bordlipbot)
1617 &.and.(zi.lt.bordliptop)) then
1618 C the energy transfer exist
1619 if (zi.lt.buflipbot) then
1620 C what fraction I am in
1622 & ((zi-bordlipbot)/lipbufthick)
1623 C lipbufthick is thickenes of lipid buffore
1624 sslipi=sscalelip(fracinbuf)
1625 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1626 elseif (zi.gt.bufliptop) then
1627 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1628 sslipi=sscalelip(fracinbuf)
1629 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1639 C xi=xi+xshift*boxxsize
1640 C yi=yi+yshift*boxysize
1641 C zi=zi+zshift*boxzsize
1643 dxi=dc_norm(1,nres+i)
1644 dyi=dc_norm(2,nres+i)
1645 dzi=dc_norm(3,nres+i)
1646 c dsci_inv=dsc_inv(itypi)
1647 dsci_inv=vbld_inv(i+nres)
1648 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1649 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1651 C Calculate SC interaction energy.
1653 do iint=1,nint_gr(i)
1654 do j=istart(i,iint),iend(i,iint)
1655 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1657 c write(iout,*) "PRZED ZWYKLE", evdwij
1658 call dyn_ssbond_ene(i,j,evdwij)
1659 c write(iout,*) "PO ZWYKLE", evdwij
1662 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1663 & 'evdw',i,j,evdwij,' ss'
1664 C triple bond artifac removal
1665 do k=j+1,iend(i,iint)
1666 C search over all next residues
1667 if (dyn_ss_mask(k)) then
1668 C check if they are cysteins
1669 C write(iout,*) 'k=',k
1671 c write(iout,*) "PRZED TRI", evdwij
1672 evdwij_przed_tri=evdwij
1673 call triple_ssbond_ene(i,j,k,evdwij)
1674 c if(evdwij_przed_tri.ne.evdwij) then
1675 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1678 c write(iout,*) "PO TRI", evdwij
1679 C call the energy function that removes the artifical triple disulfide
1680 C bond the soubroutine is located in ssMD.F
1682 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1683 & 'evdw',i,j,evdwij,'tss'
1684 endif!dyn_ss_mask(k)
1688 itypj=iabs(itype(j))
1689 if (itypj.eq.ntyp1) cycle
1690 c dscj_inv=dsc_inv(itypj)
1691 dscj_inv=vbld_inv(j+nres)
1692 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1693 c & 1.0d0/vbld(j+nres)
1694 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1695 sig0ij=sigma(itypi,itypj)
1696 chi1=chi(itypi,itypj)
1697 chi2=chi(itypj,itypi)
1704 alf12=0.5D0*(alf1+alf2)
1705 C For diagnostics only!!!
1718 C Return atom J into box the original box
1720 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1721 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1722 C Condition for being inside the proper box
1723 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1724 c & (xj.lt.((-0.5d0)*boxxsize))) then
1728 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1729 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1730 C Condition for being inside the proper box
1731 c if ((yj.gt.((0.5d0)*boxysize)).or.
1732 c & (yj.lt.((-0.5d0)*boxysize))) then
1736 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1737 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1738 C Condition for being inside the proper box
1739 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1740 c & (zj.lt.((-0.5d0)*boxzsize))) then
1744 if (xj.lt.0) xj=xj+boxxsize
1746 if (yj.lt.0) yj=yj+boxysize
1748 if (zj.lt.0) zj=zj+boxzsize
1749 if ((zj.gt.bordlipbot)
1750 &.and.(zj.lt.bordliptop)) then
1751 C the energy transfer exist
1752 if (zj.lt.buflipbot) then
1753 C what fraction I am in
1755 & ((zj-bordlipbot)/lipbufthick)
1756 C lipbufthick is thickenes of lipid buffore
1757 sslipj=sscalelip(fracinbuf)
1758 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1759 elseif (zj.gt.bufliptop) then
1760 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1761 sslipj=sscalelip(fracinbuf)
1762 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1771 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1772 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1773 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1774 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1775 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1776 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1777 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1778 C print *,sslipi,sslipj,bordlipbot,zi,zj
1779 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1787 xj=xj_safe+xshift*boxxsize
1788 yj=yj_safe+yshift*boxysize
1789 zj=zj_safe+zshift*boxzsize
1790 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1791 if(dist_temp.lt.dist_init) then
1801 if (subchap.eq.1) then
1810 dxj=dc_norm(1,nres+j)
1811 dyj=dc_norm(2,nres+j)
1812 dzj=dc_norm(3,nres+j)
1816 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1817 c write (iout,*) "j",j," dc_norm",
1818 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1819 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1821 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1822 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1824 c write (iout,'(a7,4f8.3)')
1825 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1826 if (sss.gt.0.0d0) then
1827 C Calculate angle-dependent terms of energy and contributions to their
1831 sig=sig0ij*dsqrt(sigsq)
1832 rij_shift=1.0D0/rij-sig+sig0ij
1833 c for diagnostics; uncomment
1834 c rij_shift=1.2*sig0ij
1835 C I hate to put IF's in the loops, but here don't have another choice!!!!
1836 if (rij_shift.le.0.0D0) then
1838 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1839 cd & restyp(itypi),i,restyp(itypj),j,
1840 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1844 c---------------------------------------------------------------
1845 rij_shift=1.0D0/rij_shift
1846 fac=rij_shift**expon
1847 C here to start with
1852 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1853 eps2der=evdwij*eps3rt
1854 eps3der=evdwij*eps2rt
1855 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1856 C &((sslipi+sslipj)/2.0d0+
1857 C &(2.0d0-sslipi-sslipj)/2.0d0)
1858 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1859 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1860 evdwij=evdwij*eps2rt*eps3rt
1861 evdw=evdw+evdwij*sss
1863 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1865 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1866 & restyp(itypi),i,restyp(itypj),j,
1867 & epsi,sigm,chi1,chi2,chip1,chip2,
1868 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1869 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1873 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1876 C Calculate gradient components.
1877 e1=e1*eps1*eps2rt**2*eps3rt**2
1878 fac=-expon*(e1+evdwij)*rij_shift
1881 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1882 c & evdwij,fac,sigma(itypi,itypj),expon
1883 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1885 C Calculate the radial part of the gradient
1886 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1887 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1888 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1889 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1890 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1891 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1897 C Calculate angular part of the gradient.
1907 c write (iout,*) "Number of loop steps in EGB:",ind
1908 cccc energy_dec=.false.
1911 C-----------------------------------------------------------------------------
1912 subroutine egbv(evdw)
1914 C This subroutine calculates the interaction energy of nonbonded side chains
1915 C assuming the Gay-Berne-Vorobjev potential of interaction.
1917 implicit real*8 (a-h,o-z)
1918 include 'DIMENSIONS'
1919 include 'COMMON.GEO'
1920 include 'COMMON.VAR'
1921 include 'COMMON.LOCAL'
1922 include 'COMMON.CHAIN'
1923 include 'COMMON.DERIV'
1924 include 'COMMON.NAMES'
1925 include 'COMMON.INTERACT'
1926 include 'COMMON.IOUNITS'
1927 include 'COMMON.CALC'
1928 common /srutu/ icall
1931 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1934 c if (icall.eq.0) lprn=.true.
1936 do i=iatsc_s,iatsc_e
1937 itypi=iabs(itype(i))
1938 if (itypi.eq.ntyp1) cycle
1939 itypi1=iabs(itype(i+1))
1944 if (xi.lt.0) xi=xi+boxxsize
1946 if (yi.lt.0) yi=yi+boxysize
1948 if (zi.lt.0) zi=zi+boxzsize
1949 C define scaling factor for lipids
1951 C if (positi.le.0) positi=positi+boxzsize
1953 C first for peptide groups
1954 c for each residue check if it is in lipid or lipid water border area
1955 if ((zi.gt.bordlipbot)
1956 &.and.(zi.lt.bordliptop)) then
1957 C the energy transfer exist
1958 if (zi.lt.buflipbot) then
1959 C what fraction I am in
1961 & ((zi-bordlipbot)/lipbufthick)
1962 C lipbufthick is thickenes of lipid buffore
1963 sslipi=sscalelip(fracinbuf)
1964 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1965 elseif (zi.gt.bufliptop) then
1966 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1967 sslipi=sscalelip(fracinbuf)
1968 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1978 dxi=dc_norm(1,nres+i)
1979 dyi=dc_norm(2,nres+i)
1980 dzi=dc_norm(3,nres+i)
1981 c dsci_inv=dsc_inv(itypi)
1982 dsci_inv=vbld_inv(i+nres)
1984 C Calculate SC interaction energy.
1986 do iint=1,nint_gr(i)
1987 do j=istart(i,iint),iend(i,iint)
1989 itypj=iabs(itype(j))
1990 if (itypj.eq.ntyp1) cycle
1991 c dscj_inv=dsc_inv(itypj)
1992 dscj_inv=vbld_inv(j+nres)
1993 sig0ij=sigma(itypi,itypj)
1994 r0ij=r0(itypi,itypj)
1995 chi1=chi(itypi,itypj)
1996 chi2=chi(itypj,itypi)
2003 alf12=0.5D0*(alf1+alf2)
2004 C For diagnostics only!!!
2018 if (xj.lt.0) xj=xj+boxxsize
2020 if (yj.lt.0) yj=yj+boxysize
2022 if (zj.lt.0) zj=zj+boxzsize
2023 if ((zj.gt.bordlipbot)
2024 &.and.(zj.lt.bordliptop)) then
2025 C the energy transfer exist
2026 if (zj.lt.buflipbot) then
2027 C what fraction I am in
2029 & ((zj-bordlipbot)/lipbufthick)
2030 C lipbufthick is thickenes of lipid buffore
2031 sslipj=sscalelip(fracinbuf)
2032 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
2033 elseif (zj.gt.bufliptop) then
2034 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
2035 sslipj=sscalelip(fracinbuf)
2036 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
2045 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
2046 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2047 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
2048 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2049 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
2050 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
2051 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2059 xj=xj_safe+xshift*boxxsize
2060 yj=yj_safe+yshift*boxysize
2061 zj=zj_safe+zshift*boxzsize
2062 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2063 if(dist_temp.lt.dist_init) then
2073 if (subchap.eq.1) then
2082 dxj=dc_norm(1,nres+j)
2083 dyj=dc_norm(2,nres+j)
2084 dzj=dc_norm(3,nres+j)
2085 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2087 C Calculate angle-dependent terms of energy and contributions to their
2091 sig=sig0ij*dsqrt(sigsq)
2092 rij_shift=1.0D0/rij-sig+r0ij
2093 C I hate to put IF's in the loops, but here don't have another choice!!!!
2094 if (rij_shift.le.0.0D0) then
2099 c---------------------------------------------------------------
2100 rij_shift=1.0D0/rij_shift
2101 fac=rij_shift**expon
2104 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2105 eps2der=evdwij*eps3rt
2106 eps3der=evdwij*eps2rt
2107 fac_augm=rrij**expon
2108 e_augm=augm(itypi,itypj)*fac_augm
2109 evdwij=evdwij*eps2rt*eps3rt
2110 evdw=evdw+evdwij+e_augm
2112 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2114 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2115 & restyp(itypi),i,restyp(itypj),j,
2116 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2117 & chi1,chi2,chip1,chip2,
2118 & eps1,eps2rt**2,eps3rt**2,
2119 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2122 C Calculate gradient components.
2123 e1=e1*eps1*eps2rt**2*eps3rt**2
2124 fac=-expon*(e1+evdwij)*rij_shift
2126 fac=rij*fac-2*expon*rrij*e_augm
2127 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2128 C Calculate the radial part of the gradient
2132 C Calculate angular part of the gradient.
2138 C-----------------------------------------------------------------------------
2139 subroutine sc_angular
2140 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2141 C om12. Called by ebp, egb, and egbv.
2143 include 'COMMON.CALC'
2144 include 'COMMON.IOUNITS'
2148 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2149 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2150 om12=dxi*dxj+dyi*dyj+dzi*dzj
2152 C Calculate eps1(om12) and its derivative in om12
2153 faceps1=1.0D0-om12*chiom12
2154 faceps1_inv=1.0D0/faceps1
2155 eps1=dsqrt(faceps1_inv)
2156 C Following variable is eps1*deps1/dom12
2157 eps1_om12=faceps1_inv*chiom12
2162 c write (iout,*) "om12",om12," eps1",eps1
2163 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2168 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2169 sigsq=1.0D0-facsig*faceps1_inv
2170 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2171 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2172 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2178 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2179 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2181 C Calculate eps2 and its derivatives in om1, om2, and om12.
2184 chipom12=chip12*om12
2185 facp=1.0D0-om12*chipom12
2187 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2188 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2189 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2190 C Following variable is the square root of eps2
2191 eps2rt=1.0D0-facp1*facp_inv
2192 C Following three variables are the derivatives of the square root of eps
2193 C in om1, om2, and om12.
2194 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2195 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2196 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2197 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2198 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2199 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2200 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2201 c & " eps2rt_om12",eps2rt_om12
2202 C Calculate whole angle-dependent part of epsilon and contributions
2203 C to its derivatives
2206 C----------------------------------------------------------------------------
2208 implicit real*8 (a-h,o-z)
2209 include 'DIMENSIONS'
2210 include 'COMMON.CHAIN'
2211 include 'COMMON.DERIV'
2212 include 'COMMON.CALC'
2213 include 'COMMON.IOUNITS'
2214 double precision dcosom1(3),dcosom2(3)
2215 cc print *,'sss=',sss
2216 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2217 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2218 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2219 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2223 c eom12=evdwij*eps1_om12
2225 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2226 c & " sigder",sigder
2227 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2228 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2230 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2231 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2234 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2236 c write (iout,*) "gg",(gg(k),k=1,3)
2238 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2239 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2240 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2241 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2242 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2243 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2244 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2245 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2246 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2247 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2250 C Calculate the components of the gradient in DC and X
2254 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2258 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2259 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2263 C-----------------------------------------------------------------------
2264 subroutine e_softsphere(evdw)
2266 C This subroutine calculates the interaction energy of nonbonded side chains
2267 C assuming the LJ potential of interaction.
2269 implicit real*8 (a-h,o-z)
2270 include 'DIMENSIONS'
2271 parameter (accur=1.0d-10)
2272 include 'COMMON.GEO'
2273 include 'COMMON.VAR'
2274 include 'COMMON.LOCAL'
2275 include 'COMMON.CHAIN'
2276 include 'COMMON.DERIV'
2277 include 'COMMON.INTERACT'
2278 include 'COMMON.TORSION'
2279 include 'COMMON.SBRIDGE'
2280 include 'COMMON.NAMES'
2281 include 'COMMON.IOUNITS'
2282 include 'COMMON.CONTACTS'
2284 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2286 do i=iatsc_s,iatsc_e
2287 itypi=iabs(itype(i))
2288 if (itypi.eq.ntyp1) cycle
2289 itypi1=iabs(itype(i+1))
2294 C Calculate SC interaction energy.
2296 do iint=1,nint_gr(i)
2297 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2298 cd & 'iend=',iend(i,iint)
2299 do j=istart(i,iint),iend(i,iint)
2300 itypj=iabs(itype(j))
2301 if (itypj.eq.ntyp1) cycle
2305 rij=xj*xj+yj*yj+zj*zj
2306 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2307 r0ij=r0(itypi,itypj)
2309 c print *,i,j,r0ij,dsqrt(rij)
2310 if (rij.lt.r0ijsq) then
2311 evdwij=0.25d0*(rij-r0ijsq)**2
2319 C Calculate the components of the gradient in DC and X
2325 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2326 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2327 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2328 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2332 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2340 C--------------------------------------------------------------------------
2341 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2344 C Soft-sphere potential of p-p interaction
2346 implicit real*8 (a-h,o-z)
2347 include 'DIMENSIONS'
2348 include 'COMMON.CONTROL'
2349 include 'COMMON.IOUNITS'
2350 include 'COMMON.GEO'
2351 include 'COMMON.VAR'
2352 include 'COMMON.LOCAL'
2353 include 'COMMON.CHAIN'
2354 include 'COMMON.DERIV'
2355 include 'COMMON.INTERACT'
2356 include 'COMMON.CONTACTS'
2357 include 'COMMON.TORSION'
2358 include 'COMMON.VECTORS'
2359 include 'COMMON.FFIELD'
2361 C write(iout,*) 'In EELEC_soft_sphere'
2368 do i=iatel_s,iatel_e
2369 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2373 xmedi=c(1,i)+0.5d0*dxi
2374 ymedi=c(2,i)+0.5d0*dyi
2375 zmedi=c(3,i)+0.5d0*dzi
2376 xmedi=mod(xmedi,boxxsize)
2377 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2378 ymedi=mod(ymedi,boxysize)
2379 if (ymedi.lt.0) ymedi=ymedi+boxysize
2380 zmedi=mod(zmedi,boxzsize)
2381 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2383 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2384 do j=ielstart(i),ielend(i)
2385 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2389 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2390 r0ij=rpp(iteli,itelj)
2399 if (xj.lt.0) xj=xj+boxxsize
2401 if (yj.lt.0) yj=yj+boxysize
2403 if (zj.lt.0) zj=zj+boxzsize
2404 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2412 xj=xj_safe+xshift*boxxsize
2413 yj=yj_safe+yshift*boxysize
2414 zj=zj_safe+zshift*boxzsize
2415 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2416 if(dist_temp.lt.dist_init) then
2426 if (isubchap.eq.1) then
2435 rij=xj*xj+yj*yj+zj*zj
2436 sss=sscale(sqrt(rij))
2437 sssgrad=sscagrad(sqrt(rij))
2438 if (rij.lt.r0ijsq) then
2439 evdw1ij=0.25d0*(rij-r0ijsq)**2
2445 evdw1=evdw1+evdw1ij*sss
2447 C Calculate contributions to the Cartesian gradient.
2449 ggg(1)=fac*xj*sssgrad
2450 ggg(2)=fac*yj*sssgrad
2451 ggg(3)=fac*zj*sssgrad
2453 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2454 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2457 * Loop over residues i+1 thru j-1.
2461 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2466 cgrad do i=nnt,nct-1
2468 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2470 cgrad do j=i+1,nct-1
2472 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2478 c------------------------------------------------------------------------------
2479 subroutine vec_and_deriv
2480 implicit real*8 (a-h,o-z)
2481 include 'DIMENSIONS'
2485 include 'COMMON.IOUNITS'
2486 include 'COMMON.GEO'
2487 include 'COMMON.VAR'
2488 include 'COMMON.LOCAL'
2489 include 'COMMON.CHAIN'
2490 include 'COMMON.VECTORS'
2491 include 'COMMON.SETUP'
2492 include 'COMMON.TIME1'
2493 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2494 C Compute the local reference systems. For reference system (i), the
2495 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2496 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2498 do i=ivec_start,ivec_end
2502 if (i.eq.nres-1) then
2503 C Case of the last full residue
2504 C Compute the Z-axis
2505 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2506 costh=dcos(pi-theta(nres))
2507 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2511 C Compute the derivatives of uz
2513 uzder(2,1,1)=-dc_norm(3,i-1)
2514 uzder(3,1,1)= dc_norm(2,i-1)
2515 uzder(1,2,1)= dc_norm(3,i-1)
2517 uzder(3,2,1)=-dc_norm(1,i-1)
2518 uzder(1,3,1)=-dc_norm(2,i-1)
2519 uzder(2,3,1)= dc_norm(1,i-1)
2522 uzder(2,1,2)= dc_norm(3,i)
2523 uzder(3,1,2)=-dc_norm(2,i)
2524 uzder(1,2,2)=-dc_norm(3,i)
2526 uzder(3,2,2)= dc_norm(1,i)
2527 uzder(1,3,2)= dc_norm(2,i)
2528 uzder(2,3,2)=-dc_norm(1,i)
2530 C Compute the Y-axis
2533 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2535 C Compute the derivatives of uy
2538 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2539 & -dc_norm(k,i)*dc_norm(j,i-1)
2540 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2542 uyder(j,j,1)=uyder(j,j,1)-costh
2543 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2548 uygrad(l,k,j,i)=uyder(l,k,j)
2549 uzgrad(l,k,j,i)=uzder(l,k,j)
2553 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2554 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2555 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2556 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2559 C Compute the Z-axis
2560 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2561 costh=dcos(pi-theta(i+2))
2562 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2566 C Compute the derivatives of uz
2568 uzder(2,1,1)=-dc_norm(3,i+1)
2569 uzder(3,1,1)= dc_norm(2,i+1)
2570 uzder(1,2,1)= dc_norm(3,i+1)
2572 uzder(3,2,1)=-dc_norm(1,i+1)
2573 uzder(1,3,1)=-dc_norm(2,i+1)
2574 uzder(2,3,1)= dc_norm(1,i+1)
2577 uzder(2,1,2)= dc_norm(3,i)
2578 uzder(3,1,2)=-dc_norm(2,i)
2579 uzder(1,2,2)=-dc_norm(3,i)
2581 uzder(3,2,2)= dc_norm(1,i)
2582 uzder(1,3,2)= dc_norm(2,i)
2583 uzder(2,3,2)=-dc_norm(1,i)
2585 C Compute the Y-axis
2588 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2590 C Compute the derivatives of uy
2593 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2594 & -dc_norm(k,i)*dc_norm(j,i+1)
2595 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2597 uyder(j,j,1)=uyder(j,j,1)-costh
2598 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2603 uygrad(l,k,j,i)=uyder(l,k,j)
2604 uzgrad(l,k,j,i)=uzder(l,k,j)
2608 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2609 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2610 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2611 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2615 vbld_inv_temp(1)=vbld_inv(i+1)
2616 if (i.lt.nres-1) then
2617 vbld_inv_temp(2)=vbld_inv(i+2)
2619 vbld_inv_temp(2)=vbld_inv(i)
2624 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2625 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2630 #if defined(PARVEC) && defined(MPI)
2631 if (nfgtasks1.gt.1) then
2633 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2634 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2635 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2636 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2637 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2639 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2640 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2642 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2643 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2644 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2645 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2646 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2647 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2648 time_gather=time_gather+MPI_Wtime()-time00
2650 c if (fg_rank.eq.0) then
2651 c write (iout,*) "Arrays UY and UZ"
2653 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2660 C-----------------------------------------------------------------------------
2661 subroutine check_vecgrad
2662 implicit real*8 (a-h,o-z)
2663 include 'DIMENSIONS'
2664 include 'COMMON.IOUNITS'
2665 include 'COMMON.GEO'
2666 include 'COMMON.VAR'
2667 include 'COMMON.LOCAL'
2668 include 'COMMON.CHAIN'
2669 include 'COMMON.VECTORS'
2670 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2671 dimension uyt(3,maxres),uzt(3,maxres)
2672 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2673 double precision delta /1.0d-7/
2676 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2677 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2678 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2679 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2680 cd & (dc_norm(if90,i),if90=1,3)
2681 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2682 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2683 cd write(iout,'(a)')
2689 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2690 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2703 cd write (iout,*) 'i=',i
2705 erij(k)=dc_norm(k,i)
2709 dc_norm(k,i)=erij(k)
2711 dc_norm(j,i)=dc_norm(j,i)+delta
2712 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2714 c dc_norm(k,i)=dc_norm(k,i)/fac
2716 c write (iout,*) (dc_norm(k,i),k=1,3)
2717 c write (iout,*) (erij(k),k=1,3)
2720 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2721 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2722 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2723 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2725 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2726 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2727 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2730 dc_norm(k,i)=erij(k)
2733 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2734 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2735 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2736 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2737 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2738 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2739 cd write (iout,'(a)')
2744 C--------------------------------------------------------------------------
2745 subroutine set_matrices
2746 implicit real*8 (a-h,o-z)
2747 include 'DIMENSIONS'
2750 include "COMMON.SETUP"
2752 integer status(MPI_STATUS_SIZE)
2754 include 'COMMON.IOUNITS'
2755 include 'COMMON.GEO'
2756 include 'COMMON.VAR'
2757 include 'COMMON.LOCAL'
2758 include 'COMMON.CHAIN'
2759 include 'COMMON.DERIV'
2760 include 'COMMON.INTERACT'
2761 include 'COMMON.CONTACTS'
2762 include 'COMMON.TORSION'
2763 include 'COMMON.VECTORS'
2764 include 'COMMON.FFIELD'
2765 double precision auxvec(2),auxmat(2,2)
2767 C Compute the virtual-bond-torsional-angle dependent quantities needed
2768 C to calculate the el-loc multibody terms of various order.
2770 c write(iout,*) 'nphi=',nphi,nres
2772 do i=ivec_start+2,ivec_end+2
2777 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2778 iti = itortyp(itype(i-2))
2782 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2783 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2784 iti1 = itortyp(itype(i-1))
2789 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2790 & +bnew1(2,1,iti)*dsin(theta(i-1))
2791 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2792 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2793 & +bnew1(2,1,iti)*dcos(theta(i-1))
2794 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2795 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2796 c &*(cos(theta(i)/2.0)
2797 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2798 & +bnew2(2,1,iti)*dsin(theta(i-1))
2799 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2800 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2801 c &*(cos(theta(i)/2.0)
2802 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2803 & +bnew2(2,1,iti)*dcos(theta(i-1))
2804 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2805 c if (ggb1(1,i).eq.0.0d0) then
2806 c write(iout,*) 'i=',i,ggb1(1,i),
2807 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2808 c &bnew1(2,1,iti)*cos(theta(i)),
2809 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2811 b1(2,i-2)=bnew1(1,2,iti)
2813 b2(2,i-2)=bnew2(1,2,iti)
2815 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2816 EE(1,2,i-2)=eeold(1,2,iti)
2817 EE(2,1,i-2)=eeold(2,1,iti)
2818 EE(2,2,i-2)=eeold(2,2,iti)
2819 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2824 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2825 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2826 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2827 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2828 b1tilde(1,i-2)=b1(1,i-2)
2829 b1tilde(2,i-2)=-b1(2,i-2)
2830 b2tilde(1,i-2)=b2(1,i-2)
2831 b2tilde(2,i-2)=-b2(2,i-2)
2832 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2833 c write(iout,*) 'b1=',b1(1,i-2)
2834 c write (iout,*) 'theta=', theta(i-1)
2837 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2838 iti = itortyp(itype(i-2))
2842 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2843 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2844 iti1 = itortyp(itype(i-1))
2852 b1tilde(1,i-2)=b1(1,i-2)
2853 b1tilde(2,i-2)=-b1(2,i-2)
2854 b2tilde(1,i-2)=b2(1,i-2)
2855 b2tilde(2,i-2)=-b2(2,i-2)
2856 EE(1,2,i-2)=eeold(1,2,iti)
2857 EE(2,1,i-2)=eeold(2,1,iti)
2858 EE(2,2,i-2)=eeold(2,2,iti)
2859 EE(1,1,i-2)=eeold(1,1,iti)
2863 do i=ivec_start+2,ivec_end+2
2867 if (i .lt. nres+1) then
2904 if (i .gt. 3 .and. i .lt. nres+1) then
2905 obrot_der(1,i-2)=-sin1
2906 obrot_der(2,i-2)= cos1
2907 Ugder(1,1,i-2)= sin1
2908 Ugder(1,2,i-2)=-cos1
2909 Ugder(2,1,i-2)=-cos1
2910 Ugder(2,2,i-2)=-sin1
2913 obrot2_der(1,i-2)=-dwasin2
2914 obrot2_der(2,i-2)= dwacos2
2915 Ug2der(1,1,i-2)= dwasin2
2916 Ug2der(1,2,i-2)=-dwacos2
2917 Ug2der(2,1,i-2)=-dwacos2
2918 Ug2der(2,2,i-2)=-dwasin2
2920 obrot_der(1,i-2)=0.0d0
2921 obrot_der(2,i-2)=0.0d0
2922 Ugder(1,1,i-2)=0.0d0
2923 Ugder(1,2,i-2)=0.0d0
2924 Ugder(2,1,i-2)=0.0d0
2925 Ugder(2,2,i-2)=0.0d0
2926 obrot2_der(1,i-2)=0.0d0
2927 obrot2_der(2,i-2)=0.0d0
2928 Ug2der(1,1,i-2)=0.0d0
2929 Ug2der(1,2,i-2)=0.0d0
2930 Ug2der(2,1,i-2)=0.0d0
2931 Ug2der(2,2,i-2)=0.0d0
2933 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2934 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2935 iti = itortyp(itype(i-2))
2939 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2940 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2941 iti1 = itortyp(itype(i-1))
2945 cd write (iout,*) '*******i',i,' iti1',iti
2946 cd write (iout,*) 'b1',b1(:,iti)
2947 cd write (iout,*) 'b2',b2(:,iti)
2948 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2949 c if (i .gt. iatel_s+2) then
2950 if (i .gt. nnt+2) then
2951 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2953 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2954 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2956 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2957 c & EE(1,2,iti),EE(2,2,iti)
2958 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2959 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2960 c write(iout,*) "Macierz EUG",
2961 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2963 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2965 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2966 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2967 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2968 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2969 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2980 DtUg2(l,k,i-2)=0.0d0
2984 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2985 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2987 muder(k,i-2)=Ub2der(k,i-2)
2989 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2990 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2991 if (itype(i-1).le.ntyp) then
2992 iti1 = itortyp(itype(i-1))
3000 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
3002 C write (iout,*) 'mumu',i,b1(1,i-1),Ub2(1,i-2)
3003 c write (iout,*) 'mu ',mu(:,i-2),i-2
3004 cd write (iout,*) 'mu1',mu1(:,i-2)
3005 cd write (iout,*) 'mu2',mu2(:,i-2)
3006 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3008 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3009 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
3010 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3011 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
3012 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3013 C Vectors and matrices dependent on a single virtual-bond dihedral.
3014 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
3015 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3016 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3017 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
3018 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
3019 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3020 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3021 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3022 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3025 C Matrices dependent on two consecutive virtual-bond dihedrals.
3026 C The order of matrices is from left to right.
3027 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3029 c do i=max0(ivec_start,2),ivec_end
3031 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3032 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3033 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3034 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3035 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3036 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3037 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3038 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3041 #if defined(MPI) && defined(PARMAT)
3043 c if (fg_rank.eq.0) then
3044 write (iout,*) "Arrays UG and UGDER before GATHER"
3046 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3047 & ((ug(l,k,i),l=1,2),k=1,2),
3048 & ((ugder(l,k,i),l=1,2),k=1,2)
3050 write (iout,*) "Arrays UG2 and UG2DER"
3052 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3053 & ((ug2(l,k,i),l=1,2),k=1,2),
3054 & ((ug2der(l,k,i),l=1,2),k=1,2)
3056 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3058 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3059 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3060 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3062 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3064 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3065 & costab(i),sintab(i),costab2(i),sintab2(i)
3067 write (iout,*) "Array MUDER"
3069 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3073 if (nfgtasks.gt.1) then
3075 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
3076 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
3077 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
3079 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
3080 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3082 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
3083 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3085 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
3086 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3088 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
3089 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3091 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
3092 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3094 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
3095 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3097 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
3098 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
3099 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3100 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
3101 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
3102 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3103 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
3104 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
3105 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3106 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
3107 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
3108 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3109 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3111 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
3112 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3114 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
3115 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3117 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
3118 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3120 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3121 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3123 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3124 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3126 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3127 & ivec_count(fg_rank1),
3128 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3130 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3131 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3133 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3134 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3136 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3137 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3139 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3140 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3142 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3143 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3145 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3146 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3148 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3149 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3151 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3152 & ivec_count(fg_rank1),
3153 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3155 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3156 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3158 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3159 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3161 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3162 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3164 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3165 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3167 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3168 & ivec_count(fg_rank1),
3169 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3171 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3172 & ivec_count(fg_rank1),
3173 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3175 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3176 & ivec_count(fg_rank1),
3177 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3178 & MPI_MAT2,FG_COMM1,IERR)
3179 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3180 & ivec_count(fg_rank1),
3181 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3182 & MPI_MAT2,FG_COMM1,IERR)
3185 c Passes matrix info through the ring
3188 if (irecv.lt.0) irecv=nfgtasks1-1
3191 if (inext.ge.nfgtasks1) inext=0
3193 c write (iout,*) "isend",isend," irecv",irecv
3195 lensend=lentyp(isend)
3196 lenrecv=lentyp(irecv)
3197 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3198 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3199 c & MPI_ROTAT1(lensend),inext,2200+isend,
3200 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3201 c & iprev,2200+irecv,FG_COMM,status,IERR)
3202 c write (iout,*) "Gather ROTAT1"
3204 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3205 c & MPI_ROTAT2(lensend),inext,3300+isend,
3206 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3207 c & iprev,3300+irecv,FG_COMM,status,IERR)
3208 c write (iout,*) "Gather ROTAT2"
3210 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3211 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3212 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3213 & iprev,4400+irecv,FG_COMM,status,IERR)
3214 c write (iout,*) "Gather ROTAT_OLD"
3216 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3217 & MPI_PRECOMP11(lensend),inext,5500+isend,
3218 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3219 & iprev,5500+irecv,FG_COMM,status,IERR)
3220 c write (iout,*) "Gather PRECOMP11"
3222 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3223 & MPI_PRECOMP12(lensend),inext,6600+isend,
3224 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3225 & iprev,6600+irecv,FG_COMM,status,IERR)
3226 c write (iout,*) "Gather PRECOMP12"
3228 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3230 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3231 & MPI_ROTAT2(lensend),inext,7700+isend,
3232 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3233 & iprev,7700+irecv,FG_COMM,status,IERR)
3234 c write (iout,*) "Gather PRECOMP21"
3236 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3237 & MPI_PRECOMP22(lensend),inext,8800+isend,
3238 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3239 & iprev,8800+irecv,FG_COMM,status,IERR)
3240 c write (iout,*) "Gather PRECOMP22"
3242 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3243 & MPI_PRECOMP23(lensend),inext,9900+isend,
3244 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3245 & MPI_PRECOMP23(lenrecv),
3246 & iprev,9900+irecv,FG_COMM,status,IERR)
3247 c write (iout,*) "Gather PRECOMP23"
3252 if (irecv.lt.0) irecv=nfgtasks1-1
3255 time_gather=time_gather+MPI_Wtime()-time00
3258 c if (fg_rank.eq.0) then
3259 write (iout,*) "Arrays UG and UGDER"
3261 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3262 & ((ug(l,k,i),l=1,2),k=1,2),
3263 & ((ugder(l,k,i),l=1,2),k=1,2)
3265 write (iout,*) "Arrays UG2 and UG2DER"
3267 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3268 & ((ug2(l,k,i),l=1,2),k=1,2),
3269 & ((ug2der(l,k,i),l=1,2),k=1,2)
3271 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3273 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3274 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3275 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3277 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3279 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3280 & costab(i),sintab(i),costab2(i),sintab2(i)
3282 write (iout,*) "Array MUDER"
3284 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3290 cd iti = itortyp(itype(i))
3293 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3294 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3299 C--------------------------------------------------------------------------
3300 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3302 C This subroutine calculates the average interaction energy and its gradient
3303 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3304 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3305 C The potential depends both on the distance of peptide-group centers and on
3306 C the orientation of the CA-CA virtual bonds.
3308 implicit real*8 (a-h,o-z)
3312 include 'DIMENSIONS'
3313 include 'COMMON.CONTROL'
3314 include 'COMMON.SETUP'
3315 include 'COMMON.IOUNITS'
3316 include 'COMMON.GEO'
3317 include 'COMMON.VAR'
3318 include 'COMMON.LOCAL'
3319 include 'COMMON.CHAIN'
3320 include 'COMMON.DERIV'
3321 include 'COMMON.INTERACT'
3322 include 'COMMON.CONTACTS'
3323 include 'COMMON.TORSION'
3324 include 'COMMON.VECTORS'
3325 include 'COMMON.FFIELD'
3326 include 'COMMON.TIME1'
3327 include 'COMMON.SPLITELE'
3328 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3329 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3330 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3331 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3332 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3333 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3335 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3337 double precision scal_el /1.0d0/
3339 double precision scal_el /0.5d0/
3342 C 13-go grudnia roku pamietnego...
3343 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3344 & 0.0d0,1.0d0,0.0d0,
3345 & 0.0d0,0.0d0,1.0d0/
3346 cd write(iout,*) 'In EELEC'
3348 cd write(iout,*) 'Type',i
3349 cd write(iout,*) 'B1',B1(:,i)
3350 cd write(iout,*) 'B2',B2(:,i)
3351 cd write(iout,*) 'CC',CC(:,:,i)
3352 cd write(iout,*) 'DD',DD(:,:,i)
3353 cd write(iout,*) 'EE',EE(:,:,i)
3355 cd call check_vecgrad
3357 if (icheckgrad.eq.1) then
3359 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3361 dc_norm(k,i)=dc(k,i)*fac
3363 c write (iout,*) 'i',i,' fac',fac
3366 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3367 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3368 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3369 c call vec_and_deriv
3375 time_mat=time_mat+MPI_Wtime()-time01
3379 cd write (iout,*) 'i=',i
3381 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3384 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3385 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3398 cd print '(a)','Enter EELEC'
3399 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3401 gel_loc_loc(i)=0.0d0
3406 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3408 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3410 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3411 do i=iturn3_start,iturn3_end
3413 C write(iout,*) "tu jest i",i
3414 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3415 C changes suggested by Ana to avoid out of bounds
3416 & .or.((i+4).gt.nres)
3418 C end of changes by Ana
3419 & .or. itype(i+2).eq.ntyp1
3420 & .or. itype(i+3).eq.ntyp1) cycle
3422 if(itype(i-1).eq.ntyp1)cycle
3425 if (itype(i+4).eq.ntyp1) cycle
3430 dx_normi=dc_norm(1,i)
3431 dy_normi=dc_norm(2,i)
3432 dz_normi=dc_norm(3,i)
3433 xmedi=c(1,i)+0.5d0*dxi
3434 ymedi=c(2,i)+0.5d0*dyi
3435 zmedi=c(3,i)+0.5d0*dzi
3436 xmedi=mod(xmedi,boxxsize)
3437 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3438 ymedi=mod(ymedi,boxysize)
3439 if (ymedi.lt.0) ymedi=ymedi+boxysize
3440 zmedi=mod(zmedi,boxzsize)
3441 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3443 call eelecij(i,i+2,ees,evdw1,eel_loc)
3444 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3445 num_cont_hb(i)=num_conti
3447 do i=iturn4_start,iturn4_end
3449 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3450 C changes suggested by Ana to avoid out of bounds
3451 & .or.((i+5).gt.nres)
3453 C end of changes suggested by Ana
3454 & .or. itype(i+3).eq.ntyp1
3455 & .or. itype(i+4).eq.ntyp1
3456 & .or. itype(i+5).eq.ntyp1
3457 & .or. itype(i).eq.ntyp1
3458 & .or. itype(i-1).eq.ntyp1
3463 dx_normi=dc_norm(1,i)
3464 dy_normi=dc_norm(2,i)
3465 dz_normi=dc_norm(3,i)
3466 xmedi=c(1,i)+0.5d0*dxi
3467 ymedi=c(2,i)+0.5d0*dyi
3468 zmedi=c(3,i)+0.5d0*dzi
3469 C Return atom into box, boxxsize is size of box in x dimension
3471 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3472 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3473 C Condition for being inside the proper box
3474 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3475 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3479 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3480 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3481 C Condition for being inside the proper box
3482 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3483 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3487 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3488 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3489 C Condition for being inside the proper box
3490 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3491 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3494 xmedi=mod(xmedi,boxxsize)
3495 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3496 ymedi=mod(ymedi,boxysize)
3497 if (ymedi.lt.0) ymedi=ymedi+boxysize
3498 zmedi=mod(zmedi,boxzsize)
3499 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3501 num_conti=num_cont_hb(i)
3502 c write(iout,*) "JESTEM W PETLI"
3503 call eelecij(i,i+3,ees,evdw1,eel_loc)
3504 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3505 & call eturn4(i,eello_turn4)
3506 num_cont_hb(i)=num_conti
3508 C Loop over all neighbouring boxes
3513 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3516 do i=iatel_s,iatel_e
3519 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3520 C changes suggested by Ana to avoid out of bounds
3521 & .or.((i+2).gt.nres)
3523 C end of changes by Ana
3524 & .or. itype(i+2).eq.ntyp1
3525 & .or. itype(i-1).eq.ntyp1
3530 dx_normi=dc_norm(1,i)
3531 dy_normi=dc_norm(2,i)
3532 dz_normi=dc_norm(3,i)
3533 xmedi=c(1,i)+0.5d0*dxi
3534 ymedi=c(2,i)+0.5d0*dyi
3535 zmedi=c(3,i)+0.5d0*dzi
3536 xmedi=mod(xmedi,boxxsize)
3537 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3538 ymedi=mod(ymedi,boxysize)
3539 if (ymedi.lt.0) ymedi=ymedi+boxysize
3540 zmedi=mod(zmedi,boxzsize)
3541 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3542 C xmedi=xmedi+xshift*boxxsize
3543 C ymedi=ymedi+yshift*boxysize
3544 C zmedi=zmedi+zshift*boxzsize
3546 C Return tom into box, boxxsize is size of box in x dimension
3548 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3549 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3550 C Condition for being inside the proper box
3551 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3552 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3556 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3557 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3558 C Condition for being inside the proper box
3559 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3560 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3564 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3565 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3566 cC Condition for being inside the proper box
3567 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3568 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3572 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3573 num_conti=num_cont_hb(i)
3575 do j=ielstart(i),ielend(i)
3577 C write (iout,*) i,j
3579 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3580 C changes suggested by Ana to avoid out of bounds
3581 & .or.((j+2).gt.nres)
3583 C end of changes by Ana
3584 & .or.itype(j+2).eq.ntyp1
3585 & .or.itype(j-1).eq.ntyp1
3587 call eelecij(i,j,ees,evdw1,eel_loc)
3589 num_cont_hb(i)=num_conti
3595 c write (iout,*) "Number of loop steps in EELEC:",ind
3597 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3598 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3600 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3601 ccc eel_loc=eel_loc+eello_turn3
3602 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3605 C-------------------------------------------------------------------------------
3606 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3607 implicit real*8 (a-h,o-z)
3608 include 'DIMENSIONS'
3612 include 'COMMON.CONTROL'
3613 include 'COMMON.IOUNITS'
3614 include 'COMMON.GEO'
3615 include 'COMMON.VAR'
3616 include 'COMMON.LOCAL'
3617 include 'COMMON.CHAIN'
3618 include 'COMMON.DERIV'
3619 include 'COMMON.INTERACT'
3620 include 'COMMON.CONTACTS'
3621 include 'COMMON.TORSION'
3622 include 'COMMON.VECTORS'
3623 include 'COMMON.FFIELD'
3624 include 'COMMON.TIME1'
3625 include 'COMMON.SPLITELE'
3626 include 'COMMON.SHIELD'
3627 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3628 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3629 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3630 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3631 & gmuij2(4),gmuji2(4)
3632 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3633 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3635 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3637 double precision scal_el /1.0d0/
3639 double precision scal_el /0.5d0/
3642 C 13-go grudnia roku pamietnego...
3643 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3644 & 0.0d0,1.0d0,0.0d0,
3645 & 0.0d0,0.0d0,1.0d0/
3646 c time00=MPI_Wtime()
3647 cd write (iout,*) "eelecij",i,j
3651 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3652 aaa=app(iteli,itelj)
3653 bbb=bpp(iteli,itelj)
3654 ael6i=ael6(iteli,itelj)
3655 ael3i=ael3(iteli,itelj)
3659 dx_normj=dc_norm(1,j)
3660 dy_normj=dc_norm(2,j)
3661 dz_normj=dc_norm(3,j)
3662 C xj=c(1,j)+0.5D0*dxj-xmedi
3663 C yj=c(2,j)+0.5D0*dyj-ymedi
3664 C zj=c(3,j)+0.5D0*dzj-zmedi
3669 if (xj.lt.0) xj=xj+boxxsize
3671 if (yj.lt.0) yj=yj+boxysize
3673 if (zj.lt.0) zj=zj+boxzsize
3674 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3675 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3683 xj=xj_safe+xshift*boxxsize
3684 yj=yj_safe+yshift*boxysize
3685 zj=zj_safe+zshift*boxzsize
3686 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3687 if(dist_temp.lt.dist_init) then
3697 if (isubchap.eq.1) then
3706 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3708 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3709 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3710 C Condition for being inside the proper box
3711 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3712 c & (xj.lt.((-0.5d0)*boxxsize))) then
3716 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3717 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3718 C Condition for being inside the proper box
3719 c if ((yj.gt.((0.5d0)*boxysize)).or.
3720 c & (yj.lt.((-0.5d0)*boxysize))) then
3724 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3725 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3726 C Condition for being inside the proper box
3727 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3728 c & (zj.lt.((-0.5d0)*boxzsize))) then
3731 C endif !endPBC condintion
3735 rij=xj*xj+yj*yj+zj*zj
3737 sss=sscale(sqrt(rij))
3738 sssgrad=sscagrad(sqrt(rij))
3739 c if (sss.gt.0.0d0) then
3745 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3746 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3747 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3748 fac=cosa-3.0D0*cosb*cosg
3750 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3751 if (j.eq.i+2) ev1=scal_el*ev1
3756 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3760 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3761 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3762 if (shield_mode.gt.0) then
3765 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3766 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3775 evdw1=evdw1+evdwij*sss
3776 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3777 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3778 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3779 cd & xmedi,ymedi,zmedi,xj,yj,zj
3781 if (energy_dec) then
3782 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3784 &,iteli,itelj,aaa,evdw1
3785 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
3786 &fac_shield(i),fac_shield(j)
3790 C Calculate contributions to the Cartesian gradient.
3793 facvdw=-6*rrmij*(ev1+evdwij)*sss
3794 facel=-3*rrmij*(el1+eesij)
3801 * Radial derivatives. First process both termini of the fragment (i,j)
3806 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3807 & (shield_mode.gt.0)) then
3809 do ilist=1,ishield_list(i)
3810 iresshield=shield_list(ilist,i)
3812 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
3814 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3816 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
3817 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3818 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3819 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3820 C if (iresshield.gt.i) then
3821 C do ishi=i+1,iresshield-1
3822 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3823 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3827 C do ishi=iresshield,i
3828 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3829 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3835 do ilist=1,ishield_list(j)
3836 iresshield=shield_list(ilist,j)
3838 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
3840 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3842 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
3843 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3845 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3846 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3847 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3848 C if (iresshield.gt.j) then
3849 C do ishi=j+1,iresshield-1
3850 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3851 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3855 C do ishi=iresshield,j
3856 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3857 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3864 gshieldc(k,i)=gshieldc(k,i)+
3865 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
3866 gshieldc(k,j)=gshieldc(k,j)+
3867 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
3868 gshieldc(k,i-1)=gshieldc(k,i-1)+
3869 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
3870 gshieldc(k,j-1)=gshieldc(k,j-1)+
3871 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
3876 c ghalf=0.5D0*ggg(k)
3877 c gelc(k,i)=gelc(k,i)+ghalf
3878 c gelc(k,j)=gelc(k,j)+ghalf
3880 c 9/28/08 AL Gradient compotents will be summed only at the end
3881 C print *,"before", gelc_long(1,i), gelc_long(1,j)
3883 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3884 C & +grad_shield(k,j)*eesij/fac_shield(j)
3885 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3886 C & +grad_shield(k,i)*eesij/fac_shield(i)
3887 C gelc_long(k,i-1)=gelc_long(k,i-1)
3888 C & +grad_shield(k,i)*eesij/fac_shield(i)
3889 C gelc_long(k,j-1)=gelc_long(k,j-1)
3890 C & +grad_shield(k,j)*eesij/fac_shield(j)
3892 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
3895 * Loop over residues i+1 thru j-1.
3899 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3902 if (sss.gt.0.0) then
3903 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3904 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3905 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3912 c ghalf=0.5D0*ggg(k)
3913 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3914 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3916 c 9/28/08 AL Gradient compotents will be summed only at the end
3918 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3919 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3922 * Loop over residues i+1 thru j-1.
3926 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3931 facvdw=(ev1+evdwij)*sss
3934 fac=-3*rrmij*(facvdw+facvdw+facel)
3939 * Radial derivatives. First process both termini of the fragment (i,j)
3942 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
3944 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
3946 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
3948 c ghalf=0.5D0*ggg(k)
3949 c gelc(k,i)=gelc(k,i)+ghalf
3950 c gelc(k,j)=gelc(k,j)+ghalf
3952 c 9/28/08 AL Gradient compotents will be summed only at the end
3954 gelc_long(k,j)=gelc(k,j)+ggg(k)
3955 gelc_long(k,i)=gelc(k,i)-ggg(k)
3958 * Loop over residues i+1 thru j-1.
3962 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3965 c 9/28/08 AL Gradient compotents will be summed only at the end
3966 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3967 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3968 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3970 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3971 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3977 ecosa=2.0D0*fac3*fac1+fac4
3980 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3981 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3983 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3984 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3986 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3987 cd & (dcosg(k),k=1,3)
3989 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
3990 & fac_shield(i)**2*fac_shield(j)**2
3993 c ghalf=0.5D0*ggg(k)
3994 c gelc(k,i)=gelc(k,i)+ghalf
3995 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3996 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3997 c gelc(k,j)=gelc(k,j)+ghalf
3998 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3999 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4003 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4006 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
4009 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4010 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
4011 & *fac_shield(i)**2*fac_shield(j)**2
4013 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4014 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
4015 & *fac_shield(i)**2*fac_shield(j)**2
4016 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4017 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4019 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
4023 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
4024 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
4025 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4027 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
4028 C energy of a peptide unit is assumed in the form of a second-order
4029 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
4030 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
4031 C are computed for EVERY pair of non-contiguous peptide groups.
4034 if (j.lt.nres-1) then
4046 muij(kkk)=mu(k,i)*mu(l,j)
4047 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
4049 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
4050 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
4051 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
4052 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
4053 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
4054 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4058 cd write (iout,*) 'EELEC: i',i,' j',j
4059 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
4060 cd write(iout,*) 'muij',muij
4061 ury=scalar(uy(1,i),erij)
4062 urz=scalar(uz(1,i),erij)
4063 vry=scalar(uy(1,j),erij)
4064 vrz=scalar(uz(1,j),erij)
4065 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4066 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4067 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4068 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4069 fac=dsqrt(-ael6i)*r3ij
4074 cd write (iout,'(4i5,4f10.5)')
4075 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
4076 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4077 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4078 cd & uy(:,j),uz(:,j)
4079 cd write (iout,'(4f10.5)')
4080 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4081 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4082 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
4083 cd write (iout,'(9f10.5/)')
4084 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4085 C Derivatives of the elements of A in virtual-bond vectors
4086 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4088 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4089 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4090 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4091 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4092 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4093 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4094 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4095 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4096 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4097 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4098 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4099 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4101 C Compute radial contributions to the gradient
4119 C Add the contributions coming from er
4122 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4123 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4124 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4125 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4128 C Derivatives in DC(i)
4129 cgrad ghalf1=0.5d0*agg(k,1)
4130 cgrad ghalf2=0.5d0*agg(k,2)
4131 cgrad ghalf3=0.5d0*agg(k,3)
4132 cgrad ghalf4=0.5d0*agg(k,4)
4133 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
4134 & -3.0d0*uryg(k,2)*vry)!+ghalf1
4135 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
4136 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
4137 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
4138 & -3.0d0*urzg(k,2)*vry)!+ghalf3
4139 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
4140 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
4141 C Derivatives in DC(i+1)
4142 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
4143 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4144 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
4145 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4146 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
4147 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4148 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
4149 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4150 C Derivatives in DC(j)
4151 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
4152 & -3.0d0*vryg(k,2)*ury)!+ghalf1
4153 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4154 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4155 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4156 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4157 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4158 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4159 C Derivatives in DC(j+1) or DC(nres-1)
4160 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4161 & -3.0d0*vryg(k,3)*ury)
4162 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4163 & -3.0d0*vrzg(k,3)*ury)
4164 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4165 & -3.0d0*vryg(k,3)*urz)
4166 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4167 & -3.0d0*vrzg(k,3)*urz)
4168 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4170 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4183 aggi(k,l)=-aggi(k,l)
4184 aggi1(k,l)=-aggi1(k,l)
4185 aggj(k,l)=-aggj(k,l)
4186 aggj1(k,l)=-aggj1(k,l)
4189 if (j.lt.nres-1) then
4195 aggi(k,l)=-aggi(k,l)
4196 aggi1(k,l)=-aggi1(k,l)
4197 aggj(k,l)=-aggj(k,l)
4198 aggj1(k,l)=-aggj1(k,l)
4209 aggi(k,l)=-aggi(k,l)
4210 aggi1(k,l)=-aggi1(k,l)
4211 aggj(k,l)=-aggj(k,l)
4212 aggj1(k,l)=-aggj1(k,l)
4217 IF (wel_loc.gt.0.0d0) THEN
4218 C Contribution to the local-electrostatic energy coming from the i-j pair
4219 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4221 if (shield_mode.eq.0) then
4228 eel_loc_ij=eel_loc_ij
4229 & *fac_shield(i)*fac_shield(j)
4230 C Now derivative over eel_loc
4231 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4232 & (shield_mode.gt.0)) then
4235 do ilist=1,ishield_list(i)
4236 iresshield=shield_list(ilist,i)
4238 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
4241 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4243 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
4244 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4248 do ilist=1,ishield_list(j)
4249 iresshield=shield_list(ilist,j)
4251 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
4254 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4256 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
4257 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4264 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
4265 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4266 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
4267 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4268 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
4269 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4270 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
4271 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4276 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4277 c & ' eel_loc_ij',eel_loc_ij
4278 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4279 C Calculate patrial derivative for theta angle
4281 geel_loc_ij=(a22*gmuij1(1)
4285 & *fac_shield(i)*fac_shield(j)
4286 c write(iout,*) "derivative over thatai"
4287 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4289 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4290 & geel_loc_ij*wel_loc
4291 c write(iout,*) "derivative over thatai-1"
4292 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4299 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4300 & geel_loc_ij*wel_loc
4301 & *fac_shield(i)*fac_shield(j)
4303 c Derivative over j residue
4304 geel_loc_ji=a22*gmuji1(1)
4308 c write(iout,*) "derivative over thataj"
4309 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4312 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4313 & geel_loc_ji*wel_loc
4314 & *fac_shield(i)*fac_shield(j)
4321 c write(iout,*) "derivative over thataj-1"
4322 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4324 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4325 & geel_loc_ji*wel_loc
4326 & *fac_shield(i)*fac_shield(j)
4328 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4330 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4331 & 'eelloc',i,j,eel_loc_ij
4332 c if (eel_loc_ij.ne.0)
4333 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4334 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4336 eel_loc=eel_loc+eel_loc_ij
4337 C Partial derivatives in virtual-bond dihedral angles gamma
4339 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4340 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4341 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
4342 & *fac_shield(i)*fac_shield(j)
4344 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4345 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4346 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
4347 & *fac_shield(i)*fac_shield(j)
4348 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4350 ggg(l)=(agg(l,1)*muij(1)+
4351 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
4352 & *fac_shield(i)*fac_shield(j)
4353 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4354 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4355 cgrad ghalf=0.5d0*ggg(l)
4356 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4357 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4361 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4364 C Remaining derivatives of eello
4366 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4367 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4368 & *fac_shield(i)*fac_shield(j)
4370 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4371 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4372 & *fac_shield(i)*fac_shield(j)
4374 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4375 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4376 & *fac_shield(i)*fac_shield(j)
4378 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4379 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4380 & *fac_shield(i)*fac_shield(j)
4384 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4385 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4386 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4387 & .and. num_conti.le.maxconts) then
4388 c write (iout,*) i,j," entered corr"
4390 C Calculate the contact function. The ith column of the array JCONT will
4391 C contain the numbers of atoms that make contacts with the atom I (of numbers
4392 C greater than I). The arrays FACONT and GACONT will contain the values of
4393 C the contact function and its derivative.
4394 c r0ij=1.02D0*rpp(iteli,itelj)
4395 c r0ij=1.11D0*rpp(iteli,itelj)
4396 r0ij=2.20D0*rpp(iteli,itelj)
4397 c r0ij=1.55D0*rpp(iteli,itelj)
4398 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4399 if (fcont.gt.0.0D0) then
4400 num_conti=num_conti+1
4401 if (num_conti.gt.maxconts) then
4402 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4403 & ' will skip next contacts for this conf.'
4405 jcont_hb(num_conti,i)=j
4406 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4407 cd & " jcont_hb",jcont_hb(num_conti,i)
4408 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4409 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4410 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4412 d_cont(num_conti,i)=rij
4413 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4414 C --- Electrostatic-interaction matrix ---
4415 a_chuj(1,1,num_conti,i)=a22
4416 a_chuj(1,2,num_conti,i)=a23
4417 a_chuj(2,1,num_conti,i)=a32
4418 a_chuj(2,2,num_conti,i)=a33
4419 C --- Gradient of rij
4421 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4428 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4429 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4430 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4431 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4432 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4437 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4438 C Calculate contact energies
4440 wij=cosa-3.0D0*cosb*cosg
4443 c fac3=dsqrt(-ael6i)/r0ij**3
4444 fac3=dsqrt(-ael6i)*r3ij
4445 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4446 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4447 if (ees0tmp.gt.0) then
4448 ees0pij=dsqrt(ees0tmp)
4452 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4453 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4454 if (ees0tmp.gt.0) then
4455 ees0mij=dsqrt(ees0tmp)
4460 if (shield_mode.eq.0) then
4464 ees0plist(num_conti,i)=j
4465 C fac_shield(i)=0.4d0
4466 C fac_shield(j)=0.6d0
4468 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4469 & *fac_shield(i)*fac_shield(j)
4470 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4471 & *fac_shield(i)*fac_shield(j)
4472 C Diagnostics. Comment out or remove after debugging!
4473 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4474 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4475 c ees0m(num_conti,i)=0.0D0
4477 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4478 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4479 C Angular derivatives of the contact function
4480 ees0pij1=fac3/ees0pij
4481 ees0mij1=fac3/ees0mij
4482 fac3p=-3.0D0*fac3*rrmij
4483 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4484 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4486 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4487 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4488 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4489 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4490 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4491 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4492 ecosap=ecosa1+ecosa2
4493 ecosbp=ecosb1+ecosb2
4494 ecosgp=ecosg1+ecosg2
4495 ecosam=ecosa1-ecosa2
4496 ecosbm=ecosb1-ecosb2
4497 ecosgm=ecosg1-ecosg2
4506 facont_hb(num_conti,i)=fcont
4507 fprimcont=fprimcont/rij
4508 cd facont_hb(num_conti,i)=1.0D0
4509 C Following line is for diagnostics.
4512 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4513 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4516 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4517 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4519 gggp(1)=gggp(1)+ees0pijp*xj
4520 gggp(2)=gggp(2)+ees0pijp*yj
4521 gggp(3)=gggp(3)+ees0pijp*zj
4522 gggm(1)=gggm(1)+ees0mijp*xj
4523 gggm(2)=gggm(2)+ees0mijp*yj
4524 gggm(3)=gggm(3)+ees0mijp*zj
4525 C Derivatives due to the contact function
4526 gacont_hbr(1,num_conti,i)=fprimcont*xj
4527 gacont_hbr(2,num_conti,i)=fprimcont*yj
4528 gacont_hbr(3,num_conti,i)=fprimcont*zj
4531 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4532 c following the change of gradient-summation algorithm.
4534 cgrad ghalfp=0.5D0*gggp(k)
4535 cgrad ghalfm=0.5D0*gggm(k)
4536 gacontp_hb1(k,num_conti,i)=!ghalfp
4537 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4538 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4539 & *fac_shield(i)*fac_shield(j)
4541 gacontp_hb2(k,num_conti,i)=!ghalfp
4542 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4543 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4544 & *fac_shield(i)*fac_shield(j)
4546 gacontp_hb3(k,num_conti,i)=gggp(k)
4547 & *fac_shield(i)*fac_shield(j)
4549 gacontm_hb1(k,num_conti,i)=!ghalfm
4550 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4551 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4552 & *fac_shield(i)*fac_shield(j)
4554 gacontm_hb2(k,num_conti,i)=!ghalfm
4555 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4556 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4557 & *fac_shield(i)*fac_shield(j)
4559 gacontm_hb3(k,num_conti,i)=gggm(k)
4560 & *fac_shield(i)*fac_shield(j)
4563 C Diagnostics. Comment out or remove after debugging!
4565 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4566 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4567 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4568 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4569 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4570 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4573 endif ! num_conti.le.maxconts
4576 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4579 ghalf=0.5d0*agg(l,k)
4580 aggi(l,k)=aggi(l,k)+ghalf
4581 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4582 aggj(l,k)=aggj(l,k)+ghalf
4585 if (j.eq.nres-1 .and. i.lt.j-2) then
4588 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4593 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4596 C-----------------------------------------------------------------------------
4597 subroutine eturn3(i,eello_turn3)
4598 C Third- and fourth-order contributions from turns
4599 implicit real*8 (a-h,o-z)
4600 include 'DIMENSIONS'
4601 include 'COMMON.IOUNITS'
4602 include 'COMMON.GEO'
4603 include 'COMMON.VAR'
4604 include 'COMMON.LOCAL'
4605 include 'COMMON.CHAIN'
4606 include 'COMMON.DERIV'
4607 include 'COMMON.INTERACT'
4608 include 'COMMON.CONTACTS'
4609 include 'COMMON.TORSION'
4610 include 'COMMON.VECTORS'
4611 include 'COMMON.FFIELD'
4612 include 'COMMON.CONTROL'
4613 include 'COMMON.SHIELD'
4615 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4616 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4617 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4618 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4619 & auxgmat2(2,2),auxgmatt2(2,2)
4620 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4621 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4622 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4623 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4626 c write (iout,*) "eturn3",i,j,j1,j2
4631 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4633 C Third-order contributions
4640 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4641 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4642 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4643 c auxalary matices for theta gradient
4644 c auxalary matrix for i+1 and constant i+2
4645 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4646 c auxalary matrix for i+2 and constant i+1
4647 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4648 call transpose2(auxmat(1,1),auxmat1(1,1))
4649 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4650 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4651 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4652 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4653 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4654 if (shield_mode.eq.0) then
4661 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4662 & *fac_shield(i)*fac_shield(j)
4663 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
4664 & *fac_shield(i)*fac_shield(j)
4665 C Derivatives in theta
4666 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4667 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4668 & *fac_shield(i)*fac_shield(j)
4669 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4670 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4671 & *fac_shield(i)*fac_shield(j)
4674 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4675 C Derivatives in shield mode
4676 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4677 & (shield_mode.gt.0)) then
4680 do ilist=1,ishield_list(i)
4681 iresshield=shield_list(ilist,i)
4683 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4685 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4687 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4688 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4692 do ilist=1,ishield_list(j)
4693 iresshield=shield_list(ilist,j)
4695 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4697 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4699 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4700 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4707 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
4708 & grad_shield(k,i)*eello_t3/fac_shield(i)
4709 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
4710 & grad_shield(k,j)*eello_t3/fac_shield(j)
4711 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
4712 & grad_shield(k,i)*eello_t3/fac_shield(i)
4713 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
4714 & grad_shield(k,j)*eello_t3/fac_shield(j)
4718 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4719 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4720 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4721 cd & ' eello_turn3_num',4*eello_turn3_num
4722 C Derivatives in gamma(i)
4723 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4724 call transpose2(auxmat2(1,1),auxmat3(1,1))
4725 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4726 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4727 & *fac_shield(i)*fac_shield(j)
4728 C Derivatives in gamma(i+1)
4729 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4730 call transpose2(auxmat2(1,1),auxmat3(1,1))
4731 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4732 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4733 & +0.5d0*(pizda(1,1)+pizda(2,2))
4734 & *fac_shield(i)*fac_shield(j)
4735 C Cartesian derivatives
4737 c ghalf1=0.5d0*agg(l,1)
4738 c ghalf2=0.5d0*agg(l,2)
4739 c ghalf3=0.5d0*agg(l,3)
4740 c ghalf4=0.5d0*agg(l,4)
4741 a_temp(1,1)=aggi(l,1)!+ghalf1
4742 a_temp(1,2)=aggi(l,2)!+ghalf2
4743 a_temp(2,1)=aggi(l,3)!+ghalf3
4744 a_temp(2,2)=aggi(l,4)!+ghalf4
4745 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4746 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4747 & +0.5d0*(pizda(1,1)+pizda(2,2))
4748 & *fac_shield(i)*fac_shield(j)
4750 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4751 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4752 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4753 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4754 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4755 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4756 & +0.5d0*(pizda(1,1)+pizda(2,2))
4757 & *fac_shield(i)*fac_shield(j)
4758 a_temp(1,1)=aggj(l,1)!+ghalf1
4759 a_temp(1,2)=aggj(l,2)!+ghalf2
4760 a_temp(2,1)=aggj(l,3)!+ghalf3
4761 a_temp(2,2)=aggj(l,4)!+ghalf4
4762 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4763 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4764 & +0.5d0*(pizda(1,1)+pizda(2,2))
4765 & *fac_shield(i)*fac_shield(j)
4766 a_temp(1,1)=aggj1(l,1)
4767 a_temp(1,2)=aggj1(l,2)
4768 a_temp(2,1)=aggj1(l,3)
4769 a_temp(2,2)=aggj1(l,4)
4770 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4771 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4772 & +0.5d0*(pizda(1,1)+pizda(2,2))
4773 & *fac_shield(i)*fac_shield(j)
4777 C-------------------------------------------------------------------------------
4778 subroutine eturn4(i,eello_turn4)
4779 C Third- and fourth-order contributions from turns
4780 implicit real*8 (a-h,o-z)
4781 include 'DIMENSIONS'
4782 include 'COMMON.IOUNITS'
4783 include 'COMMON.GEO'
4784 include 'COMMON.VAR'
4785 include 'COMMON.LOCAL'
4786 include 'COMMON.CHAIN'
4787 include 'COMMON.DERIV'
4788 include 'COMMON.INTERACT'
4789 include 'COMMON.CONTACTS'
4790 include 'COMMON.TORSION'
4791 include 'COMMON.VECTORS'
4792 include 'COMMON.FFIELD'
4793 include 'COMMON.CONTROL'
4794 include 'COMMON.SHIELD'
4796 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4797 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4798 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4799 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4800 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4801 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4802 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4803 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4804 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4805 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4806 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4809 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4811 C Fourth-order contributions
4819 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4820 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4821 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4822 c write(iout,*)"WCHODZE W PROGRAM"
4827 iti1=itortyp(itype(i+1))
4828 iti2=itortyp(itype(i+2))
4829 iti3=itortyp(itype(i+3))
4830 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4831 call transpose2(EUg(1,1,i+1),e1t(1,1))
4832 call transpose2(Eug(1,1,i+2),e2t(1,1))
4833 call transpose2(Eug(1,1,i+3),e3t(1,1))
4834 C Ematrix derivative in theta
4835 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4836 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4837 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4838 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4839 c eta1 in derivative theta
4840 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4841 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4842 c auxgvec is derivative of Ub2 so i+3 theta
4843 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4844 c auxalary matrix of E i+1
4845 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4848 s1=scalar2(b1(1,i+2),auxvec(1))
4849 c derivative of theta i+2 with constant i+3
4850 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4851 c derivative of theta i+2 with constant i+2
4852 gs32=scalar2(b1(1,i+2),auxgvec(1))
4853 c derivative of E matix in theta of i+1
4854 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4856 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4857 c ea31 in derivative theta
4858 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4859 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4860 c auxilary matrix auxgvec of Ub2 with constant E matirx
4861 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4862 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4863 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4867 s2=scalar2(b1(1,i+1),auxvec(1))
4868 c derivative of theta i+1 with constant i+3
4869 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4870 c derivative of theta i+2 with constant i+1
4871 gs21=scalar2(b1(1,i+1),auxgvec(1))
4872 c derivative of theta i+3 with constant i+1
4873 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4874 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4876 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4877 c two derivatives over diffetent matrices
4878 c gtae3e2 is derivative over i+3
4879 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4880 c ae3gte2 is derivative over i+2
4881 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4882 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4883 c three possible derivative over theta E matices
4885 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4887 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4889 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4890 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4892 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4893 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4894 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4895 if (shield_mode.eq.0) then
4902 eello_turn4=eello_turn4-(s1+s2+s3)
4903 & *fac_shield(i)*fac_shield(j)
4904 eello_t4=-(s1+s2+s3)
4905 & *fac_shield(i)*fac_shield(j)
4906 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4907 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4908 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4909 C Now derivative over shield:
4910 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4911 & (shield_mode.gt.0)) then
4914 do ilist=1,ishield_list(i)
4915 iresshield=shield_list(ilist,i)
4917 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
4919 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
4921 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
4922 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
4926 do ilist=1,ishield_list(j)
4927 iresshield=shield_list(ilist,j)
4929 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
4931 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
4933 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
4934 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
4941 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
4942 & grad_shield(k,i)*eello_t4/fac_shield(i)
4943 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
4944 & grad_shield(k,j)*eello_t4/fac_shield(j)
4945 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
4946 & grad_shield(k,i)*eello_t4/fac_shield(i)
4947 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
4948 & grad_shield(k,j)*eello_t4/fac_shield(j)
4957 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4958 cd & ' eello_turn4_num',8*eello_turn4_num
4960 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4961 & -(gs13+gsE13+gsEE1)*wturn4
4962 & *fac_shield(i)*fac_shield(j)
4963 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4964 & -(gs23+gs21+gsEE2)*wturn4
4965 & *fac_shield(i)*fac_shield(j)
4967 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4968 & -(gs32+gsE31+gsEE3)*wturn4
4969 & *fac_shield(i)*fac_shield(j)
4971 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4974 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4975 & 'eturn4',i,j,-(s1+s2+s3)
4976 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4977 c & ' eello_turn4_num',8*eello_turn4_num
4978 C Derivatives in gamma(i)
4979 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4980 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4981 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4982 s1=scalar2(b1(1,i+2),auxvec(1))
4983 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4984 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4985 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4986 & *fac_shield(i)*fac_shield(j)
4987 C Derivatives in gamma(i+1)
4988 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4989 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4990 s2=scalar2(b1(1,i+1),auxvec(1))
4991 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4992 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4993 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4994 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4995 & *fac_shield(i)*fac_shield(j)
4996 C Derivatives in gamma(i+2)
4997 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4998 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4999 s1=scalar2(b1(1,i+2),auxvec(1))
5000 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5001 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5002 s2=scalar2(b1(1,i+1),auxvec(1))
5003 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5004 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5005 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5006 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
5007 & *fac_shield(i)*fac_shield(j)
5008 C Cartesian derivatives
5009 C Derivatives of this turn contributions in DC(i+2)
5010 if (j.lt.nres-1) then
5012 a_temp(1,1)=agg(l,1)
5013 a_temp(1,2)=agg(l,2)
5014 a_temp(2,1)=agg(l,3)
5015 a_temp(2,2)=agg(l,4)
5016 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5017 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5018 s1=scalar2(b1(1,i+2),auxvec(1))
5019 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5020 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5021 s2=scalar2(b1(1,i+1),auxvec(1))
5022 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5023 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5024 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5026 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
5027 & *fac_shield(i)*fac_shield(j)
5030 C Remaining derivatives of this turn contribution
5032 a_temp(1,1)=aggi(l,1)
5033 a_temp(1,2)=aggi(l,2)
5034 a_temp(2,1)=aggi(l,3)
5035 a_temp(2,2)=aggi(l,4)
5036 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5037 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5038 s1=scalar2(b1(1,i+2),auxvec(1))
5039 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5040 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5041 s2=scalar2(b1(1,i+1),auxvec(1))
5042 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5043 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5044 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5045 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
5046 & *fac_shield(i)*fac_shield(j)
5047 a_temp(1,1)=aggi1(l,1)
5048 a_temp(1,2)=aggi1(l,2)
5049 a_temp(2,1)=aggi1(l,3)
5050 a_temp(2,2)=aggi1(l,4)
5051 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5052 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5053 s1=scalar2(b1(1,i+2),auxvec(1))
5054 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5055 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5056 s2=scalar2(b1(1,i+1),auxvec(1))
5057 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5058 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5059 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5060 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
5061 & *fac_shield(i)*fac_shield(j)
5062 a_temp(1,1)=aggj(l,1)
5063 a_temp(1,2)=aggj(l,2)
5064 a_temp(2,1)=aggj(l,3)
5065 a_temp(2,2)=aggj(l,4)
5066 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5067 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5068 s1=scalar2(b1(1,i+2),auxvec(1))
5069 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5070 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5071 s2=scalar2(b1(1,i+1),auxvec(1))
5072 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5073 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5074 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5075 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
5076 & *fac_shield(i)*fac_shield(j)
5077 a_temp(1,1)=aggj1(l,1)
5078 a_temp(1,2)=aggj1(l,2)
5079 a_temp(2,1)=aggj1(l,3)
5080 a_temp(2,2)=aggj1(l,4)
5081 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5082 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5083 s1=scalar2(b1(1,i+2),auxvec(1))
5084 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5085 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5086 s2=scalar2(b1(1,i+1),auxvec(1))
5087 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5088 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5089 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5090 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5091 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
5092 & *fac_shield(i)*fac_shield(j)
5096 C-----------------------------------------------------------------------------
5097 subroutine vecpr(u,v,w)
5098 implicit real*8(a-h,o-z)
5099 dimension u(3),v(3),w(3)
5100 w(1)=u(2)*v(3)-u(3)*v(2)
5101 w(2)=-u(1)*v(3)+u(3)*v(1)
5102 w(3)=u(1)*v(2)-u(2)*v(1)
5105 C-----------------------------------------------------------------------------
5106 subroutine unormderiv(u,ugrad,unorm,ungrad)
5107 C This subroutine computes the derivatives of a normalized vector u, given
5108 C the derivatives computed without normalization conditions, ugrad. Returns
5111 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
5112 double precision vec(3)
5113 double precision scalar
5115 c write (2,*) 'ugrad',ugrad
5118 vec(i)=scalar(ugrad(1,i),u(1))
5120 c write (2,*) 'vec',vec
5123 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5126 c write (2,*) 'ungrad',ungrad
5129 C-----------------------------------------------------------------------------
5130 subroutine escp_soft_sphere(evdw2,evdw2_14)
5132 C This subroutine calculates the excluded-volume interaction energy between
5133 C peptide-group centers and side chains and its gradient in virtual-bond and
5134 C side-chain vectors.
5136 implicit real*8 (a-h,o-z)
5137 include 'DIMENSIONS'
5138 include 'COMMON.GEO'
5139 include 'COMMON.VAR'
5140 include 'COMMON.LOCAL'
5141 include 'COMMON.CHAIN'
5142 include 'COMMON.DERIV'
5143 include 'COMMON.INTERACT'
5144 include 'COMMON.FFIELD'
5145 include 'COMMON.IOUNITS'
5146 include 'COMMON.CONTROL'
5151 cd print '(a)','Enter ESCP'
5152 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5156 do i=iatscp_s,iatscp_e
5157 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5159 xi=0.5D0*(c(1,i)+c(1,i+1))
5160 yi=0.5D0*(c(2,i)+c(2,i+1))
5161 zi=0.5D0*(c(3,i)+c(3,i+1))
5162 C Return atom into box, boxxsize is size of box in x dimension
5164 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5165 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5166 C Condition for being inside the proper box
5167 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5168 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5172 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5173 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5174 C Condition for being inside the proper box
5175 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5176 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5180 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5181 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5182 cC Condition for being inside the proper box
5183 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5184 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5188 if (xi.lt.0) xi=xi+boxxsize
5190 if (yi.lt.0) yi=yi+boxysize
5192 if (zi.lt.0) zi=zi+boxzsize
5193 C xi=xi+xshift*boxxsize
5194 C yi=yi+yshift*boxysize
5195 C zi=zi+zshift*boxzsize
5196 do iint=1,nscp_gr(i)
5198 do j=iscpstart(i,iint),iscpend(i,iint)
5199 if (itype(j).eq.ntyp1) cycle
5200 itypj=iabs(itype(j))
5201 C Uncomment following three lines for SC-p interactions
5205 C Uncomment following three lines for Ca-p interactions
5210 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5211 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5212 C Condition for being inside the proper box
5213 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5214 c & (xj.lt.((-0.5d0)*boxxsize))) then
5218 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5219 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5220 cC Condition for being inside the proper box
5221 c if ((yj.gt.((0.5d0)*boxysize)).or.
5222 c & (yj.lt.((-0.5d0)*boxysize))) then
5226 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5227 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5228 C Condition for being inside the proper box
5229 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5230 c & (zj.lt.((-0.5d0)*boxzsize))) then
5233 if (xj.lt.0) xj=xj+boxxsize
5235 if (yj.lt.0) yj=yj+boxysize
5237 if (zj.lt.0) zj=zj+boxzsize
5238 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5246 xj=xj_safe+xshift*boxxsize
5247 yj=yj_safe+yshift*boxysize
5248 zj=zj_safe+zshift*boxzsize
5249 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5250 if(dist_temp.lt.dist_init) then
5260 if (subchap.eq.1) then
5273 rij=xj*xj+yj*yj+zj*zj
5277 if (rij.lt.r0ijsq) then
5278 evdwij=0.25d0*(rij-r0ijsq)**2
5286 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5291 cgrad if (j.lt.i) then
5292 cd write (iout,*) 'j<i'
5293 C Uncomment following three lines for SC-p interactions
5295 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5298 cd write (iout,*) 'j>i'
5300 cgrad ggg(k)=-ggg(k)
5301 C Uncomment following line for SC-p interactions
5302 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5306 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5308 cgrad kstart=min0(i+1,j)
5309 cgrad kend=max0(i-1,j-1)
5310 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5311 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5312 cgrad do k=kstart,kend
5314 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5318 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5319 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5330 C-----------------------------------------------------------------------------
5331 subroutine escp(evdw2,evdw2_14)
5333 C This subroutine calculates the excluded-volume interaction energy between
5334 C peptide-group centers and side chains and its gradient in virtual-bond and
5335 C side-chain vectors.
5337 implicit real*8 (a-h,o-z)
5338 include 'DIMENSIONS'
5339 include 'COMMON.GEO'
5340 include 'COMMON.VAR'
5341 include 'COMMON.LOCAL'
5342 include 'COMMON.CHAIN'
5343 include 'COMMON.DERIV'
5344 include 'COMMON.INTERACT'
5345 include 'COMMON.FFIELD'
5346 include 'COMMON.IOUNITS'
5347 include 'COMMON.CONTROL'
5348 include 'COMMON.SPLITELE'
5352 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
5353 cd print '(a)','Enter ESCP'
5354 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5358 do i=iatscp_s,iatscp_e
5359 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5361 xi=0.5D0*(c(1,i)+c(1,i+1))
5362 yi=0.5D0*(c(2,i)+c(2,i+1))
5363 zi=0.5D0*(c(3,i)+c(3,i+1))
5365 if (xi.lt.0) xi=xi+boxxsize
5367 if (yi.lt.0) yi=yi+boxysize
5369 if (zi.lt.0) zi=zi+boxzsize
5370 c xi=xi+xshift*boxxsize
5371 c yi=yi+yshift*boxysize
5372 c zi=zi+zshift*boxzsize
5373 c print *,xi,yi,zi,'polozenie i'
5374 C Return atom into box, boxxsize is size of box in x dimension
5376 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5377 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5378 C Condition for being inside the proper box
5379 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5380 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5384 c print *,xi,boxxsize,"pierwszy"
5386 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5387 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5388 C Condition for being inside the proper box
5389 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5390 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5394 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5395 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5396 C Condition for being inside the proper box
5397 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5398 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5401 do iint=1,nscp_gr(i)
5403 do j=iscpstart(i,iint),iscpend(i,iint)
5404 itypj=iabs(itype(j))
5405 if (itypj.eq.ntyp1) cycle
5406 C Uncomment following three lines for SC-p interactions
5410 C Uncomment following three lines for Ca-p interactions
5415 if (xj.lt.0) xj=xj+boxxsize
5417 if (yj.lt.0) yj=yj+boxysize
5419 if (zj.lt.0) zj=zj+boxzsize
5421 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5422 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5423 C Condition for being inside the proper box
5424 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5425 c & (xj.lt.((-0.5d0)*boxxsize))) then
5429 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5430 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5431 cC Condition for being inside the proper box
5432 c if ((yj.gt.((0.5d0)*boxysize)).or.
5433 c & (yj.lt.((-0.5d0)*boxysize))) then
5437 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5438 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5439 C Condition for being inside the proper box
5440 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5441 c & (zj.lt.((-0.5d0)*boxzsize))) then
5444 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5445 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5453 xj=xj_safe+xshift*boxxsize
5454 yj=yj_safe+yshift*boxysize
5455 zj=zj_safe+zshift*boxzsize
5456 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5457 if(dist_temp.lt.dist_init) then
5467 if (subchap.eq.1) then
5476 c print *,xj,yj,zj,'polozenie j'
5477 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5479 sss=sscale(1.0d0/(dsqrt(rrij)))
5480 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5481 c if (sss.eq.0) print *,'czasem jest OK'
5482 if (sss.le.0.0d0) cycle
5483 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5485 e1=fac*fac*aad(itypj,iteli)
5486 e2=fac*bad(itypj,iteli)
5487 if (iabs(j-i) .le. 2) then
5490 evdw2_14=evdw2_14+(e1+e2)*sss
5493 evdw2=evdw2+evdwij*sss
5494 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5495 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5498 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5500 fac=-(evdwij+e1)*rrij*sss
5501 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5505 cgrad if (j.lt.i) then
5506 cd write (iout,*) 'j<i'
5507 C Uncomment following three lines for SC-p interactions
5509 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5512 cd write (iout,*) 'j>i'
5514 cgrad ggg(k)=-ggg(k)
5515 C Uncomment following line for SC-p interactions
5516 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5517 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5521 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5523 cgrad kstart=min0(i+1,j)
5524 cgrad kend=max0(i-1,j-1)
5525 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5526 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5527 cgrad do k=kstart,kend
5529 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5533 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5534 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5536 c endif !endif for sscale cutoff
5546 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5547 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5548 gradx_scp(j,i)=expon*gradx_scp(j,i)
5551 C******************************************************************************
5555 C To save time the factor EXPON has been extracted from ALL components
5556 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5559 C******************************************************************************
5562 C--------------------------------------------------------------------------
5563 subroutine edis(ehpb)
5565 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5567 implicit real*8 (a-h,o-z)
5568 include 'DIMENSIONS'
5569 include 'COMMON.SBRIDGE'
5570 include 'COMMON.CHAIN'
5571 include 'COMMON.DERIV'
5572 include 'COMMON.VAR'
5573 include 'COMMON.INTERACT'
5574 include 'COMMON.IOUNITS'
5575 include 'COMMON.CONTROL'
5581 C write (iout,*) ,"link_end",link_end,constr_dist
5582 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5583 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5584 if (link_end.eq.0) return
5585 do i=link_start,link_end
5586 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5587 C CA-CA distance used in regularization of structure.
5590 C iii and jjj point to the residues for which the distance is assigned.
5591 if (ii.gt.nres) then
5598 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5599 c & dhpb(i),dhpb1(i),forcon(i)
5600 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5601 C distance and angle dependent SS bond potential.
5602 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5603 C & iabs(itype(jjj)).eq.1) then
5604 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5605 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5606 if (.not.dyn_ss .and. i.le.nss) then
5607 C 15/02/13 CC dynamic SSbond - additional check
5608 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5609 & iabs(itype(jjj)).eq.1) then
5610 call ssbond_ene(iii,jjj,eij)
5613 cd write (iout,*) "eij",eij
5614 cd & ' waga=',waga,' fac=',fac
5615 else if (ii.gt.nres .and. jj.gt.nres) then
5616 c Restraints from contact prediction
5618 if (constr_dist.eq.11) then
5619 ehpb=ehpb+fordepth(i)**4.0d0
5620 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5621 fac=fordepth(i)**4.0d0
5622 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5623 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5624 & ehpb,fordepth(i),dd
5626 if (dhpb1(i).gt.0.0d0) then
5627 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5628 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5629 c write (iout,*) "beta nmr",
5630 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5634 C Get the force constant corresponding to this distance.
5636 C Calculate the contribution to energy.
5637 ehpb=ehpb+waga*rdis*rdis
5638 c write (iout,*) "beta reg",dd,waga*rdis*rdis
5640 C Evaluate gradient.
5646 ggg(j)=fac*(c(j,jj)-c(j,ii))
5649 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5650 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5653 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5654 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5657 C Calculate the distance between the two points and its difference from the
5660 if (constr_dist.eq.11) then
5661 ehpb=ehpb+fordepth(i)**4.0d0
5662 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5663 fac=fordepth(i)**4.0d0
5664 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5665 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5666 & ehpb,fordepth(i),dd
5668 if (dhpb1(i).gt.0.0d0) then
5669 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5670 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5671 c write (iout,*) "alph nmr",
5672 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5675 C Get the force constant corresponding to this distance.
5677 C Calculate the contribution to energy.
5678 ehpb=ehpb+waga*rdis*rdis
5679 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5681 C Evaluate gradient.
5687 ggg(j)=fac*(c(j,jj)-c(j,ii))
5689 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5690 C If this is a SC-SC distance, we need to calculate the contributions to the
5691 C Cartesian gradient in the SC vectors (ghpbx).
5694 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5695 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5698 cgrad do j=iii,jjj-1
5700 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5704 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5705 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5709 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5712 C--------------------------------------------------------------------------
5713 subroutine ssbond_ene(i,j,eij)
5715 C Calculate the distance and angle dependent SS-bond potential energy
5716 C using a free-energy function derived based on RHF/6-31G** ab initio
5717 C calculations of diethyl disulfide.
5719 C A. Liwo and U. Kozlowska, 11/24/03
5721 implicit real*8 (a-h,o-z)
5722 include 'DIMENSIONS'
5723 include 'COMMON.SBRIDGE'
5724 include 'COMMON.CHAIN'
5725 include 'COMMON.DERIV'
5726 include 'COMMON.LOCAL'
5727 include 'COMMON.INTERACT'
5728 include 'COMMON.VAR'
5729 include 'COMMON.IOUNITS'
5730 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5731 itypi=iabs(itype(i))
5735 dxi=dc_norm(1,nres+i)
5736 dyi=dc_norm(2,nres+i)
5737 dzi=dc_norm(3,nres+i)
5738 c dsci_inv=dsc_inv(itypi)
5739 dsci_inv=vbld_inv(nres+i)
5740 itypj=iabs(itype(j))
5741 c dscj_inv=dsc_inv(itypj)
5742 dscj_inv=vbld_inv(nres+j)
5746 dxj=dc_norm(1,nres+j)
5747 dyj=dc_norm(2,nres+j)
5748 dzj=dc_norm(3,nres+j)
5749 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5754 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5755 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5756 om12=dxi*dxj+dyi*dyj+dzi*dzj
5758 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5759 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5765 deltat12=om2-om1+2.0d0
5767 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5768 & +akct*deltad*deltat12
5769 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5770 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5771 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5772 c & " deltat12",deltat12," eij",eij
5773 ed=2*akcm*deltad+akct*deltat12
5775 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5776 eom1=-2*akth*deltat1-pom1-om2*pom2
5777 eom2= 2*akth*deltat2+pom1-om1*pom2
5780 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5781 ghpbx(k,i)=ghpbx(k,i)-ggk
5782 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5783 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5784 ghpbx(k,j)=ghpbx(k,j)+ggk
5785 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5786 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5787 ghpbc(k,i)=ghpbc(k,i)-ggk
5788 ghpbc(k,j)=ghpbc(k,j)+ggk
5791 C Calculate the components of the gradient in DC and X
5795 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5800 C--------------------------------------------------------------------------
5801 subroutine ebond(estr)
5803 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5805 implicit real*8 (a-h,o-z)
5806 include 'DIMENSIONS'
5807 include 'COMMON.LOCAL'
5808 include 'COMMON.GEO'
5809 include 'COMMON.INTERACT'
5810 include 'COMMON.DERIV'
5811 include 'COMMON.VAR'
5812 include 'COMMON.CHAIN'
5813 include 'COMMON.IOUNITS'
5814 include 'COMMON.NAMES'
5815 include 'COMMON.FFIELD'
5816 include 'COMMON.CONTROL'
5817 include 'COMMON.SETUP'
5818 double precision u(3),ud(3)
5821 do i=ibondp_start,ibondp_end
5822 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5823 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5825 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5826 c & *dc(j,i-1)/vbld(i)
5828 c if (energy_dec) write(iout,*)
5829 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5831 C Checking if it involves dummy (NH3+ or COO-) group
5832 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5833 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5834 diff = vbld(i)-vbldpDUM
5836 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5837 diff = vbld(i)-vbldp0
5839 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5840 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5843 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5845 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5848 estr=0.5d0*AKP*estr+estr1
5850 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5852 do i=ibond_start,ibond_end
5854 if (iti.ne.10 .and. iti.ne.ntyp1) then
5857 diff=vbld(i+nres)-vbldsc0(1,iti)
5858 if (energy_dec) write (iout,*)
5859 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5860 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5861 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5863 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5867 diff=vbld(i+nres)-vbldsc0(j,iti)
5868 ud(j)=aksc(j,iti)*diff
5869 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5883 uprod2=uprod2*u(k)*u(k)
5887 usumsqder=usumsqder+ud(j)*uprod2
5889 estr=estr+uprod/usum
5891 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5899 C--------------------------------------------------------------------------
5900 subroutine ebend(etheta,ethetacnstr)
5902 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5903 C angles gamma and its derivatives in consecutive thetas and gammas.
5905 implicit real*8 (a-h,o-z)
5906 include 'DIMENSIONS'
5907 include 'COMMON.LOCAL'
5908 include 'COMMON.GEO'
5909 include 'COMMON.INTERACT'
5910 include 'COMMON.DERIV'
5911 include 'COMMON.VAR'
5912 include 'COMMON.CHAIN'
5913 include 'COMMON.IOUNITS'
5914 include 'COMMON.NAMES'
5915 include 'COMMON.FFIELD'
5916 include 'COMMON.CONTROL'
5917 include 'COMMON.TORCNSTR'
5918 common /calcthet/ term1,term2,termm,diffak,ratak,
5919 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5920 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5921 double precision y(2),z(2)
5923 c time11=dexp(-2*time)
5926 c write (*,'(a,i2)') 'EBEND ICG=',icg
5927 do i=ithet_start,ithet_end
5928 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5929 & .or.itype(i).eq.ntyp1) cycle
5930 C Zero the energy function and its derivative at 0 or pi.
5931 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5933 ichir1=isign(1,itype(i-2))
5934 ichir2=isign(1,itype(i))
5935 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5936 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5937 if (itype(i-1).eq.10) then
5938 itype1=isign(10,itype(i-2))
5939 ichir11=isign(1,itype(i-2))
5940 ichir12=isign(1,itype(i-2))
5941 itype2=isign(10,itype(i))
5942 ichir21=isign(1,itype(i))
5943 ichir22=isign(1,itype(i))
5946 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5949 if (phii.ne.phii) phii=150.0
5959 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5962 if (phii1.ne.phii1) phii1=150.0
5974 C Calculate the "mean" value of theta from the part of the distribution
5975 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5976 C In following comments this theta will be referred to as t_c.
5977 thet_pred_mean=0.0d0
5979 athetk=athet(k,it,ichir1,ichir2)
5980 bthetk=bthet(k,it,ichir1,ichir2)
5982 athetk=athet(k,itype1,ichir11,ichir12)
5983 bthetk=bthet(k,itype2,ichir21,ichir22)
5985 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5986 c write(iout,*) 'chuj tu', y(k),z(k)
5988 dthett=thet_pred_mean*ssd
5989 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5990 C Derivatives of the "mean" values in gamma1 and gamma2.
5991 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5992 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5993 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5994 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5996 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5997 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5998 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5999 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
6001 if (theta(i).gt.pi-delta) then
6002 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
6004 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
6005 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6006 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
6008 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
6010 else if (theta(i).lt.delta) then
6011 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
6012 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6013 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
6015 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
6016 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
6019 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
6022 etheta=etheta+ethetai
6023 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
6024 & 'ebend',i,ethetai,theta(i),itype(i)
6025 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
6026 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
6027 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
6030 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6031 do i=ithetaconstr_start,ithetaconstr_end
6032 itheta=itheta_constr(i)
6033 thetiii=theta(itheta)
6034 difi=pinorm(thetiii-theta_constr0(i))
6035 if (difi.gt.theta_drange(i)) then
6036 difi=difi-theta_drange(i)
6037 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6038 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6039 & +for_thet_constr(i)*difi**3
6040 else if (difi.lt.-drange(i)) then
6042 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6043 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6044 & +for_thet_constr(i)*difi**3
6048 if (energy_dec) then
6049 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6050 & i,itheta,rad2deg*thetiii,
6051 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6052 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6053 & gloc(itheta+nphi-2,icg)
6057 C Ufff.... We've done all this!!!
6060 C---------------------------------------------------------------------------
6061 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
6063 implicit real*8 (a-h,o-z)
6064 include 'DIMENSIONS'
6065 include 'COMMON.LOCAL'
6066 include 'COMMON.IOUNITS'
6067 common /calcthet/ term1,term2,termm,diffak,ratak,
6068 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6069 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6070 C Calculate the contributions to both Gaussian lobes.
6071 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6072 C The "polynomial part" of the "standard deviation" of this part of
6073 C the distributioni.
6074 ccc write (iout,*) thetai,thet_pred_mean
6077 sig=sig*thet_pred_mean+polthet(j,it)
6079 C Derivative of the "interior part" of the "standard deviation of the"
6080 C gamma-dependent Gaussian lobe in t_c.
6081 sigtc=3*polthet(3,it)
6083 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6086 C Set the parameters of both Gaussian lobes of the distribution.
6087 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6088 fac=sig*sig+sigc0(it)
6091 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6092 sigsqtc=-4.0D0*sigcsq*sigtc
6093 c print *,i,sig,sigtc,sigsqtc
6094 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
6095 sigtc=-sigtc/(fac*fac)
6096 C Following variable is sigma(t_c)**(-2)
6097 sigcsq=sigcsq*sigcsq
6099 sig0inv=1.0D0/sig0i**2
6100 delthec=thetai-thet_pred_mean
6101 delthe0=thetai-theta0i
6102 term1=-0.5D0*sigcsq*delthec*delthec
6103 term2=-0.5D0*sig0inv*delthe0*delthe0
6104 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
6105 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6106 C NaNs in taking the logarithm. We extract the largest exponent which is added
6107 C to the energy (this being the log of the distribution) at the end of energy
6108 C term evaluation for this virtual-bond angle.
6109 if (term1.gt.term2) then
6111 term2=dexp(term2-termm)
6115 term1=dexp(term1-termm)
6118 C The ratio between the gamma-independent and gamma-dependent lobes of
6119 C the distribution is a Gaussian function of thet_pred_mean too.
6120 diffak=gthet(2,it)-thet_pred_mean
6121 ratak=diffak/gthet(3,it)**2
6122 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6123 C Let's differentiate it in thet_pred_mean NOW.
6125 C Now put together the distribution terms to make complete distribution.
6126 termexp=term1+ak*term2
6127 termpre=sigc+ak*sig0i
6128 C Contribution of the bending energy from this theta is just the -log of
6129 C the sum of the contributions from the two lobes and the pre-exponential
6130 C factor. Simple enough, isn't it?
6131 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6132 C write (iout,*) 'termexp',termexp,termm,termpre,i
6133 C NOW the derivatives!!!
6134 C 6/6/97 Take into account the deformation.
6135 E_theta=(delthec*sigcsq*term1
6136 & +ak*delthe0*sig0inv*term2)/termexp
6137 E_tc=((sigtc+aktc*sig0i)/termpre
6138 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
6139 & aktc*term2)/termexp)
6142 c-----------------------------------------------------------------------------
6143 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
6144 implicit real*8 (a-h,o-z)
6145 include 'DIMENSIONS'
6146 include 'COMMON.LOCAL'
6147 include 'COMMON.IOUNITS'
6148 common /calcthet/ term1,term2,termm,diffak,ratak,
6149 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6150 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6151 delthec=thetai-thet_pred_mean
6152 delthe0=thetai-theta0i
6153 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
6154 t3 = thetai-thet_pred_mean
6158 t14 = t12+t6*sigsqtc
6160 t21 = thetai-theta0i
6166 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
6167 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
6168 & *(-t12*t9-ak*sig0inv*t27)
6172 C--------------------------------------------------------------------------
6173 subroutine ebend(etheta,ethetacnstr)
6175 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6176 C angles gamma and its derivatives in consecutive thetas and gammas.
6177 C ab initio-derived potentials from
6178 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6180 implicit real*8 (a-h,o-z)
6181 include 'DIMENSIONS'
6182 include 'COMMON.LOCAL'
6183 include 'COMMON.GEO'
6184 include 'COMMON.INTERACT'
6185 include 'COMMON.DERIV'
6186 include 'COMMON.VAR'
6187 include 'COMMON.CHAIN'
6188 include 'COMMON.IOUNITS'
6189 include 'COMMON.NAMES'
6190 include 'COMMON.FFIELD'
6191 include 'COMMON.CONTROL'
6192 include 'COMMON.TORCNSTR'
6193 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
6194 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
6195 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
6196 & sinph1ph2(maxdouble,maxdouble)
6197 logical lprn /.false./, lprn1 /.false./
6199 do i=ithet_start,ithet_end
6200 c print *,i,itype(i-1),itype(i),itype(i-2)
6201 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6202 & .or.itype(i).eq.ntyp1) cycle
6203 C print *,i,theta(i)
6204 if (iabs(itype(i+1)).eq.20) iblock=2
6205 if (iabs(itype(i+1)).ne.20) iblock=1
6209 theti2=0.5d0*theta(i)
6210 ityp2=ithetyp((itype(i-1)))
6212 coskt(k)=dcos(k*theti2)
6213 sinkt(k)=dsin(k*theti2)
6216 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
6219 if (phii.ne.phii) phii=150.0
6223 ityp1=ithetyp((itype(i-2)))
6224 C propagation of chirality for glycine type
6226 cosph1(k)=dcos(k*phii)
6227 sinph1(k)=dsin(k*phii)
6232 ityp1=ithetyp((itype(i-2)))
6237 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6240 if (phii1.ne.phii1) phii1=150.0
6245 ityp3=ithetyp((itype(i)))
6247 cosph2(k)=dcos(k*phii1)
6248 sinph2(k)=dsin(k*phii1)
6252 ityp3=ithetyp((itype(i)))
6258 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
6261 ccl=cosph1(l)*cosph2(k-l)
6262 ssl=sinph1(l)*sinph2(k-l)
6263 scl=sinph1(l)*cosph2(k-l)
6264 csl=cosph1(l)*sinph2(k-l)
6265 cosph1ph2(l,k)=ccl-ssl
6266 cosph1ph2(k,l)=ccl+ssl
6267 sinph1ph2(l,k)=scl+csl
6268 sinph1ph2(k,l)=scl-csl
6272 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
6273 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6274 write (iout,*) "coskt and sinkt"
6276 write (iout,*) k,coskt(k),sinkt(k)
6280 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6281 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
6284 & write (iout,*) "k",k,"
6285 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
6286 & " ethetai",ethetai
6289 write (iout,*) "cosph and sinph"
6291 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6293 write (iout,*) "cosph1ph2 and sinph2ph2"
6296 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6297 & sinph1ph2(l,k),sinph1ph2(k,l)
6300 write(iout,*) "ethetai",ethetai
6305 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
6306 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
6307 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
6308 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6309 ethetai=ethetai+sinkt(m)*aux
6310 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6311 dephii=dephii+k*sinkt(m)*(
6312 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
6313 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6314 dephii1=dephii1+k*sinkt(m)*(
6315 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
6316 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6318 & write (iout,*) "m",m," k",k," bbthet",
6319 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
6320 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
6321 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
6322 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6323 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6326 C print *,"cosph1", (cosph1(k), k=1,nsingle)
6327 C print *,"cosph2", (cosph2(k), k=1,nsingle)
6328 C print *,"sinph1", (sinph1(k), k=1,nsingle)
6329 C print *,"sinph2", (sinph2(k), k=1,nsingle)
6331 & write(iout,*) "ethetai",ethetai
6332 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6336 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6337 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
6338 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6339 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6340 ethetai=ethetai+sinkt(m)*aux
6341 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6342 dephii=dephii+l*sinkt(m)*(
6343 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
6344 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6345 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6346 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6347 dephii1=dephii1+(k-l)*sinkt(m)*(
6348 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6349 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6350 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
6351 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6353 write (iout,*) "m",m," k",k," l",l," ffthet",
6354 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6355 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
6356 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6357 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
6358 & " ethetai",ethetai
6359 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6360 & cosph1ph2(k,l)*sinkt(m),
6361 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6370 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6371 & i,theta(i)*rad2deg,phii*rad2deg,
6372 & phii1*rad2deg,ethetai
6374 etheta=etheta+ethetai
6375 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6376 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6377 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
6381 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6382 do i=ithetaconstr_start,ithetaconstr_end
6383 itheta=itheta_constr(i)
6384 thetiii=theta(itheta)
6385 difi=pinorm(thetiii-theta_constr0(i))
6386 if (difi.gt.theta_drange(i)) then
6387 difi=difi-theta_drange(i)
6388 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6389 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6390 & +for_thet_constr(i)*difi**3
6391 else if (difi.lt.-drange(i)) then
6393 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6394 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6395 & +for_thet_constr(i)*difi**3
6399 if (energy_dec) then
6400 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6401 & i,itheta,rad2deg*thetiii,
6402 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6403 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6404 & gloc(itheta+nphi-2,icg)
6412 c-----------------------------------------------------------------------------
6413 subroutine esc(escloc)
6414 C Calculate the local energy of a side chain and its derivatives in the
6415 C corresponding virtual-bond valence angles THETA and the spherical angles
6417 implicit real*8 (a-h,o-z)
6418 include 'DIMENSIONS'
6419 include 'COMMON.GEO'
6420 include 'COMMON.LOCAL'
6421 include 'COMMON.VAR'
6422 include 'COMMON.INTERACT'
6423 include 'COMMON.DERIV'
6424 include 'COMMON.CHAIN'
6425 include 'COMMON.IOUNITS'
6426 include 'COMMON.NAMES'
6427 include 'COMMON.FFIELD'
6428 include 'COMMON.CONTROL'
6429 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6430 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6431 common /sccalc/ time11,time12,time112,theti,it,nlobit
6434 c write (iout,'(a)') 'ESC'
6435 do i=loc_start,loc_end
6437 if (it.eq.ntyp1) cycle
6438 if (it.eq.10) goto 1
6439 nlobit=nlob(iabs(it))
6440 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6441 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6442 theti=theta(i+1)-pipol
6447 if (x(2).gt.pi-delta) then
6451 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6453 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6454 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6456 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6457 & ddersc0(1),dersc(1))
6458 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6459 & ddersc0(3),dersc(3))
6461 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6463 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6464 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6465 & dersc0(2),esclocbi,dersc02)
6466 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6468 call splinthet(x(2),0.5d0*delta,ss,ssd)
6473 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6475 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6476 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6478 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6480 c write (iout,*) escloci
6481 else if (x(2).lt.delta) then
6485 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6487 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6488 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6490 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6491 & ddersc0(1),dersc(1))
6492 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6493 & ddersc0(3),dersc(3))
6495 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6497 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6498 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6499 & dersc0(2),esclocbi,dersc02)
6500 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6505 call splinthet(x(2),0.5d0*delta,ss,ssd)
6507 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6509 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6510 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6512 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6513 c write (iout,*) escloci
6515 call enesc(x,escloci,dersc,ddummy,.false.)
6518 escloc=escloc+escloci
6519 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6520 & 'escloc',i,escloci
6521 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6523 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6525 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6526 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6531 C---------------------------------------------------------------------------
6532 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6533 implicit real*8 (a-h,o-z)
6534 include 'DIMENSIONS'
6535 include 'COMMON.GEO'
6536 include 'COMMON.LOCAL'
6537 include 'COMMON.IOUNITS'
6538 common /sccalc/ time11,time12,time112,theti,it,nlobit
6539 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6540 double precision contr(maxlob,-1:1)
6542 c write (iout,*) 'it=',it,' nlobit=',nlobit
6546 if (mixed) ddersc(j)=0.0d0
6550 C Because of periodicity of the dependence of the SC energy in omega we have
6551 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6552 C To avoid underflows, first compute & store the exponents.
6560 z(k)=x(k)-censc(k,j,it)
6565 Axk=Axk+gaussc(l,k,j,it)*z(l)
6571 expfac=expfac+Ax(k,j,iii)*z(k)
6579 C As in the case of ebend, we want to avoid underflows in exponentiation and
6580 C subsequent NaNs and INFs in energy calculation.
6581 C Find the largest exponent
6585 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6589 cd print *,'it=',it,' emin=',emin
6591 C Compute the contribution to SC energy and derivatives
6596 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6597 if(adexp.ne.adexp) adexp=1.0
6600 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6602 cd print *,'j=',j,' expfac=',expfac
6603 escloc_i=escloc_i+expfac
6605 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6609 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6610 & +gaussc(k,2,j,it))*expfac
6617 dersc(1)=dersc(1)/cos(theti)**2
6618 ddersc(1)=ddersc(1)/cos(theti)**2
6621 escloci=-(dlog(escloc_i)-emin)
6623 dersc(j)=dersc(j)/escloc_i
6627 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6632 C------------------------------------------------------------------------------
6633 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6634 implicit real*8 (a-h,o-z)
6635 include 'DIMENSIONS'
6636 include 'COMMON.GEO'
6637 include 'COMMON.LOCAL'
6638 include 'COMMON.IOUNITS'
6639 common /sccalc/ time11,time12,time112,theti,it,nlobit
6640 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6641 double precision contr(maxlob)
6652 z(k)=x(k)-censc(k,j,it)
6658 Axk=Axk+gaussc(l,k,j,it)*z(l)
6664 expfac=expfac+Ax(k,j)*z(k)
6669 C As in the case of ebend, we want to avoid underflows in exponentiation and
6670 C subsequent NaNs and INFs in energy calculation.
6671 C Find the largest exponent
6674 if (emin.gt.contr(j)) emin=contr(j)
6678 C Compute the contribution to SC energy and derivatives
6682 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6683 escloc_i=escloc_i+expfac
6685 dersc(k)=dersc(k)+Ax(k,j)*expfac
6687 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6688 & +gaussc(1,2,j,it))*expfac
6692 dersc(1)=dersc(1)/cos(theti)**2
6693 dersc12=dersc12/cos(theti)**2
6694 escloci=-(dlog(escloc_i)-emin)
6696 dersc(j)=dersc(j)/escloc_i
6698 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6702 c----------------------------------------------------------------------------------
6703 subroutine esc(escloc)
6704 C Calculate the local energy of a side chain and its derivatives in the
6705 C corresponding virtual-bond valence angles THETA and the spherical angles
6706 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6707 C added by Urszula Kozlowska. 07/11/2007
6709 implicit real*8 (a-h,o-z)
6710 include 'DIMENSIONS'
6711 include 'COMMON.GEO'
6712 include 'COMMON.LOCAL'
6713 include 'COMMON.VAR'
6714 include 'COMMON.SCROT'
6715 include 'COMMON.INTERACT'
6716 include 'COMMON.DERIV'
6717 include 'COMMON.CHAIN'
6718 include 'COMMON.IOUNITS'
6719 include 'COMMON.NAMES'
6720 include 'COMMON.FFIELD'
6721 include 'COMMON.CONTROL'
6722 include 'COMMON.VECTORS'
6723 double precision x_prime(3),y_prime(3),z_prime(3)
6724 & , sumene,dsc_i,dp2_i,x(65),
6725 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6726 & de_dxx,de_dyy,de_dzz,de_dt
6727 double precision s1_t,s1_6_t,s2_t,s2_6_t
6729 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6730 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6731 & dt_dCi(3),dt_dCi1(3)
6732 common /sccalc/ time11,time12,time112,theti,it,nlobit
6735 do i=loc_start,loc_end
6736 if (itype(i).eq.ntyp1) cycle
6737 costtab(i+1) =dcos(theta(i+1))
6738 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6739 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6740 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6741 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6742 cosfac=dsqrt(cosfac2)
6743 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6744 sinfac=dsqrt(sinfac2)
6746 if (it.eq.10) goto 1
6748 C Compute the axes of tghe local cartesian coordinates system; store in
6749 c x_prime, y_prime and z_prime
6756 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6757 C & dc_norm(3,i+nres)
6759 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6760 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6763 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6766 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6767 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6768 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6769 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6770 c & " xy",scalar(x_prime(1),y_prime(1)),
6771 c & " xz",scalar(x_prime(1),z_prime(1)),
6772 c & " yy",scalar(y_prime(1),y_prime(1)),
6773 c & " yz",scalar(y_prime(1),z_prime(1)),
6774 c & " zz",scalar(z_prime(1),z_prime(1))
6776 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6777 C to local coordinate system. Store in xx, yy, zz.
6783 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6784 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6785 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6792 C Compute the energy of the ith side cbain
6794 c write (2,*) "xx",xx," yy",yy," zz",zz
6797 x(j) = sc_parmin(j,it)
6800 Cc diagnostics - remove later
6802 yy1 = dsin(alph(2))*dcos(omeg(2))
6803 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6804 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6805 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6807 C," --- ", xx_w,yy_w,zz_w
6810 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6811 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6813 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6814 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6816 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6817 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6818 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6819 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6820 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6822 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6823 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6824 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6825 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6826 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6828 dsc_i = 0.743d0+x(61)
6830 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6831 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6832 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6833 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6834 s1=(1+x(63))/(0.1d0 + dscp1)
6835 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6836 s2=(1+x(65))/(0.1d0 + dscp2)
6837 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6838 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6839 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6840 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6842 c & dscp1,dscp2,sumene
6843 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6844 escloc = escloc + sumene
6845 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6850 C This section to check the numerical derivatives of the energy of ith side
6851 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6852 C #define DEBUG in the code to turn it on.
6854 write (2,*) "sumene =",sumene
6858 write (2,*) xx,yy,zz
6859 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6860 de_dxx_num=(sumenep-sumene)/aincr
6862 write (2,*) "xx+ sumene from enesc=",sumenep
6865 write (2,*) xx,yy,zz
6866 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6867 de_dyy_num=(sumenep-sumene)/aincr
6869 write (2,*) "yy+ sumene from enesc=",sumenep
6872 write (2,*) xx,yy,zz
6873 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6874 de_dzz_num=(sumenep-sumene)/aincr
6876 write (2,*) "zz+ sumene from enesc=",sumenep
6877 costsave=cost2tab(i+1)
6878 sintsave=sint2tab(i+1)
6879 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6880 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6881 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6882 de_dt_num=(sumenep-sumene)/aincr
6883 write (2,*) " t+ sumene from enesc=",sumenep
6884 cost2tab(i+1)=costsave
6885 sint2tab(i+1)=sintsave
6886 C End of diagnostics section.
6889 C Compute the gradient of esc
6891 c zz=zz*dsign(1.0,dfloat(itype(i)))
6892 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6893 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6894 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6895 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6896 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6897 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6898 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6899 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6900 pom1=(sumene3*sint2tab(i+1)+sumene1)
6901 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6902 pom2=(sumene4*cost2tab(i+1)+sumene2)
6903 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6904 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6905 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6906 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6908 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6909 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6910 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6912 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6913 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6914 & +(pom1+pom2)*pom_dx
6916 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6919 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6920 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6921 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6923 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6924 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6925 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6926 & +x(59)*zz**2 +x(60)*xx*zz
6927 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6928 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6929 & +(pom1-pom2)*pom_dy
6931 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6934 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6935 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6936 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6937 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6938 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6939 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6940 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6941 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6943 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6946 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6947 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6948 & +pom1*pom_dt1+pom2*pom_dt2
6950 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6955 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6956 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6957 cosfac2xx=cosfac2*xx
6958 sinfac2yy=sinfac2*yy
6960 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6962 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6964 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6965 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6966 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6967 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6968 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6969 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6970 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6971 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6972 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6973 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6977 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6978 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6979 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6980 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6983 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6984 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6985 dZZ_XYZ(k)=vbld_inv(i+nres)*
6986 & (z_prime(k)-zz*dC_norm(k,i+nres))
6988 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6989 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6993 dXX_Ctab(k,i)=dXX_Ci(k)
6994 dXX_C1tab(k,i)=dXX_Ci1(k)
6995 dYY_Ctab(k,i)=dYY_Ci(k)
6996 dYY_C1tab(k,i)=dYY_Ci1(k)
6997 dZZ_Ctab(k,i)=dZZ_Ci(k)
6998 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6999 dXX_XYZtab(k,i)=dXX_XYZ(k)
7000 dYY_XYZtab(k,i)=dYY_XYZ(k)
7001 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
7005 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
7006 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
7007 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
7008 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
7009 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
7011 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
7012 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
7013 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
7014 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
7015 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
7016 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
7017 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
7018 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
7020 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
7021 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
7023 C to check gradient call subroutine check_grad
7029 c------------------------------------------------------------------------------
7030 double precision function enesc(x,xx,yy,zz,cost2,sint2)
7032 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
7033 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
7034 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7035 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7037 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7038 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7040 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7041 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7042 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7043 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7044 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7046 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7047 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7048 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7049 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7050 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7052 dsc_i = 0.743d0+x(61)
7054 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7055 & *(xx*cost2+yy*sint2))
7056 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7057 & *(xx*cost2-yy*sint2))
7058 s1=(1+x(63))/(0.1d0 + dscp1)
7059 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7060 s2=(1+x(65))/(0.1d0 + dscp2)
7061 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7062 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
7063 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
7068 c------------------------------------------------------------------------------
7069 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
7071 C This procedure calculates two-body contact function g(rij) and its derivative:
7074 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
7077 C where x=(rij-r0ij)/delta
7079 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
7082 double precision rij,r0ij,eps0ij,fcont,fprimcont
7083 double precision x,x2,x4,delta
7087 if (x.lt.-1.0D0) then
7090 else if (x.le.1.0D0) then
7093 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
7094 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7101 c------------------------------------------------------------------------------
7102 subroutine splinthet(theti,delta,ss,ssder)
7103 implicit real*8 (a-h,o-z)
7104 include 'DIMENSIONS'
7105 include 'COMMON.VAR'
7106 include 'COMMON.GEO'
7109 if (theti.gt.pipol) then
7110 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7112 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7117 c------------------------------------------------------------------------------
7118 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7120 double precision x,x0,delta,f0,f1,fprim0,f,fprim
7121 double precision ksi,ksi2,ksi3,a1,a2,a3
7122 a1=fprim0*delta/(f1-f0)
7128 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7129 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7132 c------------------------------------------------------------------------------
7133 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7135 double precision x,x0,delta,f0x,f1x,fprim0x,fx
7136 double precision ksi,ksi2,ksi3,a1,a2,a3
7141 a2=3*(f1x-f0x)-2*fprim0x*delta
7142 a3=fprim0x*delta-2*(f1x-f0x)
7143 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7146 C-----------------------------------------------------------------------------
7148 C-----------------------------------------------------------------------------
7149 subroutine etor(etors,edihcnstr)
7150 implicit real*8 (a-h,o-z)
7151 include 'DIMENSIONS'
7152 include 'COMMON.VAR'
7153 include 'COMMON.GEO'
7154 include 'COMMON.LOCAL'
7155 include 'COMMON.TORSION'
7156 include 'COMMON.INTERACT'
7157 include 'COMMON.DERIV'
7158 include 'COMMON.CHAIN'
7159 include 'COMMON.NAMES'
7160 include 'COMMON.IOUNITS'
7161 include 'COMMON.FFIELD'
7162 include 'COMMON.TORCNSTR'
7163 include 'COMMON.CONTROL'
7165 C Set lprn=.true. for debugging
7169 do i=iphi_start,iphi_end
7171 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7172 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7173 itori=itortyp(itype(i-2))
7174 itori1=itortyp(itype(i-1))
7177 C Proline-Proline pair is a special case...
7178 if (itori.eq.3 .and. itori1.eq.3) then
7179 if (phii.gt.-dwapi3) then
7181 fac=1.0D0/(1.0D0-cosphi)
7182 etorsi=v1(1,3,3)*fac
7183 etorsi=etorsi+etorsi
7184 etors=etors+etorsi-v1(1,3,3)
7185 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
7186 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7189 v1ij=v1(j+1,itori,itori1)
7190 v2ij=v2(j+1,itori,itori1)
7193 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7194 if (energy_dec) etors_ii=etors_ii+
7195 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7196 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7200 v1ij=v1(j,itori,itori1)
7201 v2ij=v2(j,itori,itori1)
7204 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7205 if (energy_dec) etors_ii=etors_ii+
7206 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7207 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7210 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7213 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7214 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7215 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7216 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7217 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7219 ! 6/20/98 - dihedral angle constraints
7222 itori=idih_constr(i)
7225 if (difi.gt.drange(i)) then
7227 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7228 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7229 else if (difi.lt.-drange(i)) then
7231 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
7232 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7234 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
7235 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7237 ! write (iout,*) 'edihcnstr',edihcnstr
7240 c------------------------------------------------------------------------------
7241 subroutine etor_d(etors_d)
7245 c----------------------------------------------------------------------------
7247 subroutine etor(etors,edihcnstr)
7248 implicit real*8 (a-h,o-z)
7249 include 'DIMENSIONS'
7250 include 'COMMON.VAR'
7251 include 'COMMON.GEO'
7252 include 'COMMON.LOCAL'
7253 include 'COMMON.TORSION'
7254 include 'COMMON.INTERACT'
7255 include 'COMMON.DERIV'
7256 include 'COMMON.CHAIN'
7257 include 'COMMON.NAMES'
7258 include 'COMMON.IOUNITS'
7259 include 'COMMON.FFIELD'
7260 include 'COMMON.TORCNSTR'
7261 include 'COMMON.CONTROL'
7263 C Set lprn=.true. for debugging
7267 do i=iphi_start,iphi_end
7268 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7269 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7270 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7271 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7272 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7273 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7274 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7275 C For introducing the NH3+ and COO- group please check the etor_d for reference
7278 if (iabs(itype(i)).eq.20) then
7283 itori=itortyp(itype(i-2))
7284 itori1=itortyp(itype(i-1))
7287 C Regular cosine and sine terms
7288 do j=1,nterm(itori,itori1,iblock)
7289 v1ij=v1(j,itori,itori1,iblock)
7290 v2ij=v2(j,itori,itori1,iblock)
7293 etors=etors+v1ij*cosphi+v2ij*sinphi
7294 if (energy_dec) etors_ii=etors_ii+
7295 & v1ij*cosphi+v2ij*sinphi
7296 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7300 C E = SUM ----------------------------------- - v1
7301 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7303 cosphi=dcos(0.5d0*phii)
7304 sinphi=dsin(0.5d0*phii)
7305 do j=1,nlor(itori,itori1,iblock)
7306 vl1ij=vlor1(j,itori,itori1)
7307 vl2ij=vlor2(j,itori,itori1)
7308 vl3ij=vlor3(j,itori,itori1)
7309 pom=vl2ij*cosphi+vl3ij*sinphi
7310 pom1=1.0d0/(pom*pom+1.0d0)
7311 etors=etors+vl1ij*pom1
7312 if (energy_dec) etors_ii=etors_ii+
7315 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7317 C Subtract the constant term
7318 etors=etors-v0(itori,itori1,iblock)
7319 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7320 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
7322 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7323 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7324 & (v1(j,itori,itori1,iblock),j=1,6),
7325 & (v2(j,itori,itori1,iblock),j=1,6)
7326 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7327 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7329 ! 6/20/98 - dihedral angle constraints
7331 c do i=1,ndih_constr
7332 do i=idihconstr_start,idihconstr_end
7333 itori=idih_constr(i)
7335 difi=pinorm(phii-phi0(i))
7336 if (difi.gt.drange(i)) then
7338 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7339 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7340 else if (difi.lt.-drange(i)) then
7342 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7343 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7347 if (energy_dec) then
7348 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
7349 & i,itori,rad2deg*phii,
7350 & rad2deg*phi0(i), rad2deg*drange(i),
7351 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
7354 cd write (iout,*) 'edihcnstr',edihcnstr
7357 c----------------------------------------------------------------------------
7358 subroutine etor_d(etors_d)
7359 C 6/23/01 Compute double torsional energy
7360 implicit real*8 (a-h,o-z)
7361 include 'DIMENSIONS'
7362 include 'COMMON.VAR'
7363 include 'COMMON.GEO'
7364 include 'COMMON.LOCAL'
7365 include 'COMMON.TORSION'
7366 include 'COMMON.INTERACT'
7367 include 'COMMON.DERIV'
7368 include 'COMMON.CHAIN'
7369 include 'COMMON.NAMES'
7370 include 'COMMON.IOUNITS'
7371 include 'COMMON.FFIELD'
7372 include 'COMMON.TORCNSTR'
7374 C Set lprn=.true. for debugging
7378 c write(iout,*) "a tu??"
7379 do i=iphid_start,iphid_end
7380 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7381 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7382 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7383 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7384 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7385 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7386 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7387 & (itype(i+1).eq.ntyp1)) cycle
7388 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7389 itori=itortyp(itype(i-2))
7390 itori1=itortyp(itype(i-1))
7391 itori2=itortyp(itype(i))
7397 if (iabs(itype(i+1)).eq.20) iblock=2
7398 C Iblock=2 Proline type
7399 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7400 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7401 C if (itype(i+1).eq.ntyp1) iblock=3
7402 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7403 C IS or IS NOT need for this
7404 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7405 C is (itype(i-3).eq.ntyp1) ntblock=2
7406 C ntblock is N-terminal blocking group
7408 C Regular cosine and sine terms
7409 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7410 C Example of changes for NH3+ blocking group
7411 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7412 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7413 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7414 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7415 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7416 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7417 cosphi1=dcos(j*phii)
7418 sinphi1=dsin(j*phii)
7419 cosphi2=dcos(j*phii1)
7420 sinphi2=dsin(j*phii1)
7421 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7422 & v2cij*cosphi2+v2sij*sinphi2
7423 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7424 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7426 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7428 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7429 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7430 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7431 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7432 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7433 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7434 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7435 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7436 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7437 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7438 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7439 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7440 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7441 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7444 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7445 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7450 C----------------------------------------------------------------------------------
7451 C The rigorous attempt to derive energy function
7452 subroutine etor_kcc(etors,edihcnstr)
7453 implicit real*8 (a-h,o-z)
7454 include 'DIMENSIONS'
7455 include 'COMMON.VAR'
7456 include 'COMMON.GEO'
7457 include 'COMMON.LOCAL'
7458 include 'COMMON.TORSION'
7459 include 'COMMON.INTERACT'
7460 include 'COMMON.DERIV'
7461 include 'COMMON.CHAIN'
7462 include 'COMMON.NAMES'
7463 include 'COMMON.IOUNITS'
7464 include 'COMMON.FFIELD'
7465 include 'COMMON.TORCNSTR'
7466 include 'COMMON.CONTROL'
7468 double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
7469 C Set lprn=.true. for debugging
7472 C print *,"wchodze kcc"
7473 if (tor_mode.ne.2) then
7476 do i=iphi_start,iphi_end
7477 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7478 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7479 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7480 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7481 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7482 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7483 itori=itortyp_kcc(itype(i-2))
7484 itori1=itortyp_kcc(itype(i-1))
7489 sumnonchebyshev=0.0d0
7491 C to avoid multiple devision by 2
7492 theti22=0.5d0*theta(i)
7493 C theta 12 is the theta_1 /2
7494 C theta 22 is theta_2 /2
7495 theti12=0.5d0*theta(i-1)
7496 C and appropriate sinus function
7497 sinthet2=dsin(theta(i))
7498 sinthet1=dsin(theta(i-1))
7499 costhet1=dcos(theta(i-1))
7500 costhet2=dcos(theta(i))
7501 C to speed up lets store its mutliplication
7502 sint1t2=sinthet2*sinthet1
7503 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
7504 C +d_n*sin(n*gamma)) *
7505 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
7506 C we have two sum 1) Non-Chebyshev which is with n and gamma
7507 do j=1,nterm_kcc(itori,itori1)
7509 v1ij=v1_kcc(j,itori,itori1)
7510 v2ij=v2_kcc(j,itori,itori1)
7511 C v1ij is c_n and d_n in euation above
7516 & sint1t2n*(v1ij*cosphi+v2ij*sinphi)
7517 actval=sint1t2n*(v1ij*cosphi+v2ij*sinphi)
7518 C etors=etors+sint1t2n*(v1ij*cosphi+v2ij*sinphi)
7519 C if (energy_dec) etors_ii=etors_ii+
7520 C & v1ij*cosphi+v2ij*sinphi
7521 C glocig is the gradient local i site in gamma
7522 glocig=j*(v2ij*cosphi-v1ij*sinphi)*sint1t2n
7523 C now gradient over theta_1
7524 glocit1=actval/sinthet1*j*costhet1
7525 glocit2=actval/sinthet2*j*costhet2
7527 C now the Czebyshev polinominal sum
7528 do k=1,nterm_kcc_Tb(itori,itori1)
7529 thybt1(k)=v1_chyb(k,j,itori,itori1)
7530 thybt2(k)=v2_chyb(k,j,itori,itori1)
7534 sumth1thyb=tschebyshev
7535 & (1,nterm_kcc_Tb(itori,itori1),thybt1(1),dcos(theti12)**2)
7536 gradthybt1=gradtschebyshev
7537 & (0,nterm_kcc_Tb(itori,itori1)-1,thybt1(1),
7539 & *dcos(theti12)*(-dsin(theti12))
7540 sumth2thyb=tschebyshev
7541 & (1,nterm_kcc_Tb(itori,itori1),thybt2(1),dcos(theti22)**2)
7542 gradthybt2=gradtschebyshev
7543 & (0,nterm_kcc_Tb(itori,itori1)-1,thybt2(1),
7545 & *dcos(theti22)*(-dsin(theti22))
7546 C print *, sumth1thyb, gradthybt1, sumth2thyb, gradthybt2,
7548 C & (0,nterm_kcc_Tb(itori,itori1)-1,thybt2(1),
7549 C & dcos(theti22)**2),
7552 C now overal sumation
7553 etors=etors+(1.0d0+sumth1thyb+sumth2thyb)*sumnonchebyshev
7554 C print *,"sumnon", sumnonchebyshev,sumth1thyb+sumth2thyb
7555 C derivative over gamma
7556 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
7557 & *(1.0d0+sumth1thyb+sumth2thyb)
7558 C derivative over theta1
7559 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*
7560 & (glocit1*(1.0d0+sumth1thyb+sumth2thyb)+
7561 & sumnonchebyshev*gradthybt1)
7562 C now derivative over theta2
7563 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*
7564 & (glocit2*(1.0d0+sumth1thyb+sumth2thyb)+
7565 & sumnonchebyshev*gradthybt2)
7569 C gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7570 ! 6/20/98 - dihedral angle constraints
7571 if (tor_mode.ne.2) then
7573 c do i=1,ndih_constr
7574 do i=idihconstr_start,idihconstr_end
7575 itori=idih_constr(i)
7577 difi=pinorm(phii-phi0(i))
7578 if (difi.gt.drange(i)) then
7580 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7581 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7582 else if (difi.lt.-drange(i)) then
7584 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7585 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7594 C The rigorous attempt to derive energy function
7595 subroutine ebend_kcc(etheta,ethetacnstr)
7597 implicit real*8 (a-h,o-z)
7598 include 'DIMENSIONS'
7599 include 'COMMON.VAR'
7600 include 'COMMON.GEO'
7601 include 'COMMON.LOCAL'
7602 include 'COMMON.TORSION'
7603 include 'COMMON.INTERACT'
7604 include 'COMMON.DERIV'
7605 include 'COMMON.CHAIN'
7606 include 'COMMON.NAMES'
7607 include 'COMMON.IOUNITS'
7608 include 'COMMON.FFIELD'
7609 include 'COMMON.TORCNSTR'
7610 include 'COMMON.CONTROL'
7612 double precision thybt1(maxtermkcc)
7613 C Set lprn=.true. for debugging
7616 C print *,"wchodze kcc"
7617 if (tormode.ne.2) etheta=0.0D0
7618 do i=ithet_start,ithet_end
7619 c print *,i,itype(i-1),itype(i),itype(i-2)
7620 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
7621 & .or.itype(i).eq.ntyp1) cycle
7622 iti=itortyp_kcc(itype(i-1))
7623 sinthet=dsin(theta(i)/2.0d0)
7624 costhet=dcos(theta(i)/2.0d0)
7625 do j=1,nbend_kcc_Tb(iti)
7626 thybt1(j)=v1bend_chyb(j,iti)
7628 sumth1thyb=tschebyshev
7629 & (1,nbend_kcc_Tb(iti),thybt1(1),costhet)
7630 ihelp=nbend_kcc_Tb(iti)-1
7631 gradthybt1=gradtschebyshev
7632 & (0,ihelp,thybt1(1),costhet)
7633 etheta=etheta+sumth1thyb
7634 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
7635 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*
7636 & gradthybt1*sinthet*(-0.5d0)
7638 if (tormode.ne.2) then
7640 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
7641 do i=ithetaconstr_start,ithetaconstr_end
7642 itheta=itheta_constr(i)
7643 thetiii=theta(itheta)
7644 difi=pinorm(thetiii-theta_constr0(i))
7645 if (difi.gt.theta_drange(i)) then
7646 difi=difi-theta_drange(i)
7647 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7648 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7649 & +for_thet_constr(i)*difi**3
7650 else if (difi.lt.-drange(i)) then
7652 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7653 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7654 & +for_thet_constr(i)*difi**3
7658 if (energy_dec) then
7659 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
7660 & i,itheta,rad2deg*thetiii,
7661 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
7662 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
7663 & gloc(itheta+nphi-2,icg)
7669 c------------------------------------------------------------------------------
7670 subroutine eback_sc_corr(esccor)
7671 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7672 c conformational states; temporarily implemented as differences
7673 c between UNRES torsional potentials (dependent on three types of
7674 c residues) and the torsional potentials dependent on all 20 types
7675 c of residues computed from AM1 energy surfaces of terminally-blocked
7676 c amino-acid residues.
7677 implicit real*8 (a-h,o-z)
7678 include 'DIMENSIONS'
7679 include 'COMMON.VAR'
7680 include 'COMMON.GEO'
7681 include 'COMMON.LOCAL'
7682 include 'COMMON.TORSION'
7683 include 'COMMON.SCCOR'
7684 include 'COMMON.INTERACT'
7685 include 'COMMON.DERIV'
7686 include 'COMMON.CHAIN'
7687 include 'COMMON.NAMES'
7688 include 'COMMON.IOUNITS'
7689 include 'COMMON.FFIELD'
7690 include 'COMMON.CONTROL'
7692 C Set lprn=.true. for debugging
7695 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7697 do i=itau_start,itau_end
7698 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7700 isccori=isccortyp(itype(i-2))
7701 isccori1=isccortyp(itype(i-1))
7702 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7704 do intertyp=1,3 !intertyp
7705 cc Added 09 May 2012 (Adasko)
7706 cc Intertyp means interaction type of backbone mainchain correlation:
7707 c 1 = SC...Ca...Ca...Ca
7708 c 2 = Ca...Ca...Ca...SC
7709 c 3 = SC...Ca...Ca...SCi
7711 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7712 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7713 & (itype(i-1).eq.ntyp1)))
7714 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7715 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7716 & .or.(itype(i).eq.ntyp1)))
7717 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7718 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7719 & (itype(i-3).eq.ntyp1)))) cycle
7720 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7721 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7723 do j=1,nterm_sccor(isccori,isccori1)
7724 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7725 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7726 cosphi=dcos(j*tauangle(intertyp,i))
7727 sinphi=dsin(j*tauangle(intertyp,i))
7728 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7729 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7731 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7732 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7734 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7735 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
7736 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
7737 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7738 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7744 c----------------------------------------------------------------------------
7745 subroutine multibody(ecorr)
7746 C This subroutine calculates multi-body contributions to energy following
7747 C the idea of Skolnick et al. If side chains I and J make a contact and
7748 C at the same time side chains I+1 and J+1 make a contact, an extra
7749 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7750 implicit real*8 (a-h,o-z)
7751 include 'DIMENSIONS'
7752 include 'COMMON.IOUNITS'
7753 include 'COMMON.DERIV'
7754 include 'COMMON.INTERACT'
7755 include 'COMMON.CONTACTS'
7756 double precision gx(3),gx1(3)
7759 C Set lprn=.true. for debugging
7763 write (iout,'(a)') 'Contact function values:'
7765 write (iout,'(i2,20(1x,i2,f10.5))')
7766 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7781 num_conti=num_cont(i)
7782 num_conti1=num_cont(i1)
7787 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7788 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7789 cd & ' ishift=',ishift
7790 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7791 C The system gains extra energy.
7792 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7793 endif ! j1==j+-ishift
7802 c------------------------------------------------------------------------------
7803 double precision function esccorr(i,j,k,l,jj,kk)
7804 implicit real*8 (a-h,o-z)
7805 include 'DIMENSIONS'
7806 include 'COMMON.IOUNITS'
7807 include 'COMMON.DERIV'
7808 include 'COMMON.INTERACT'
7809 include 'COMMON.CONTACTS'
7810 include 'COMMON.SHIELD'
7811 double precision gx(3),gx1(3)
7816 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7817 C Calculate the multi-body contribution to energy.
7818 C Calculate multi-body contributions to the gradient.
7819 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7820 cd & k,l,(gacont(m,kk,k),m=1,3)
7822 gx(m) =ekl*gacont(m,jj,i)
7823 gx1(m)=eij*gacont(m,kk,k)
7824 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7825 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7826 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7827 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7831 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7836 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7842 c------------------------------------------------------------------------------
7843 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7844 C This subroutine calculates multi-body contributions to hydrogen-bonding
7845 implicit real*8 (a-h,o-z)
7846 include 'DIMENSIONS'
7847 include 'COMMON.IOUNITS'
7850 parameter (max_cont=maxconts)
7851 parameter (max_dim=26)
7852 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7853 double precision zapas(max_dim,maxconts,max_fg_procs),
7854 & zapas_recv(max_dim,maxconts,max_fg_procs)
7855 common /przechowalnia/ zapas
7856 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7857 & status_array(MPI_STATUS_SIZE,maxconts*2)
7859 include 'COMMON.SETUP'
7860 include 'COMMON.FFIELD'
7861 include 'COMMON.DERIV'
7862 include 'COMMON.INTERACT'
7863 include 'COMMON.CONTACTS'
7864 include 'COMMON.CONTROL'
7865 include 'COMMON.LOCAL'
7866 double precision gx(3),gx1(3),time00
7869 C Set lprn=.true. for debugging
7874 if (nfgtasks.le.1) goto 30
7876 write (iout,'(a)') 'Contact function values before RECEIVE:'
7878 write (iout,'(2i3,50(1x,i2,f5.2))')
7879 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7880 & j=1,num_cont_hb(i))
7884 do i=1,ntask_cont_from
7887 do i=1,ntask_cont_to
7890 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7892 C Make the list of contacts to send to send to other procesors
7893 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7895 do i=iturn3_start,iturn3_end
7896 c write (iout,*) "make contact list turn3",i," num_cont",
7898 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7900 do i=iturn4_start,iturn4_end
7901 c write (iout,*) "make contact list turn4",i," num_cont",
7903 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7907 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7909 do j=1,num_cont_hb(i)
7912 iproc=iint_sent_local(k,jjc,ii)
7913 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7914 if (iproc.gt.0) then
7915 ncont_sent(iproc)=ncont_sent(iproc)+1
7916 nn=ncont_sent(iproc)
7918 zapas(2,nn,iproc)=jjc
7919 zapas(3,nn,iproc)=facont_hb(j,i)
7920 zapas(4,nn,iproc)=ees0p(j,i)
7921 zapas(5,nn,iproc)=ees0m(j,i)
7922 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7923 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7924 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7925 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7926 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7927 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7928 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7929 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7930 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7931 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7932 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7933 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7934 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7935 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7936 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7937 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7938 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7939 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7940 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7941 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7942 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7949 & "Numbers of contacts to be sent to other processors",
7950 & (ncont_sent(i),i=1,ntask_cont_to)
7951 write (iout,*) "Contacts sent"
7952 do ii=1,ntask_cont_to
7954 iproc=itask_cont_to(ii)
7955 write (iout,*) nn," contacts to processor",iproc,
7956 & " of CONT_TO_COMM group"
7958 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7966 CorrelID1=nfgtasks+fg_rank+1
7968 C Receive the numbers of needed contacts from other processors
7969 do ii=1,ntask_cont_from
7970 iproc=itask_cont_from(ii)
7972 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7973 & FG_COMM,req(ireq),IERR)
7975 c write (iout,*) "IRECV ended"
7977 C Send the number of contacts needed by other processors
7978 do ii=1,ntask_cont_to
7979 iproc=itask_cont_to(ii)
7981 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7982 & FG_COMM,req(ireq),IERR)
7984 c write (iout,*) "ISEND ended"
7985 c write (iout,*) "number of requests (nn)",ireq
7988 & call MPI_Waitall(ireq,req,status_array,ierr)
7990 c & "Numbers of contacts to be received from other processors",
7991 c & (ncont_recv(i),i=1,ntask_cont_from)
7995 do ii=1,ntask_cont_from
7996 iproc=itask_cont_from(ii)
7998 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7999 c & " of CONT_TO_COMM group"
8003 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8004 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8005 c write (iout,*) "ireq,req",ireq,req(ireq)
8008 C Send the contacts to processors that need them
8009 do ii=1,ntask_cont_to
8010 iproc=itask_cont_to(ii)
8012 c write (iout,*) nn," contacts to processor",iproc,
8013 c & " of CONT_TO_COMM group"
8016 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8017 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8018 c write (iout,*) "ireq,req",ireq,req(ireq)
8020 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8024 c write (iout,*) "number of requests (contacts)",ireq
8025 c write (iout,*) "req",(req(i),i=1,4)
8028 & call MPI_Waitall(ireq,req,status_array,ierr)
8029 do iii=1,ntask_cont_from
8030 iproc=itask_cont_from(iii)
8033 write (iout,*) "Received",nn," contacts from processor",iproc,
8034 & " of CONT_FROM_COMM group"
8037 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8042 ii=zapas_recv(1,i,iii)
8043 c Flag the received contacts to prevent double-counting
8044 jj=-zapas_recv(2,i,iii)
8045 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8047 nnn=num_cont_hb(ii)+1
8050 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8051 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8052 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8053 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8054 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8055 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8056 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8057 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8058 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8059 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8060 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8061 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8062 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8063 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8064 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8065 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8066 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8067 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8068 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8069 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8070 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8071 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8072 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8073 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8078 write (iout,'(a)') 'Contact function values after receive:'
8080 write (iout,'(2i3,50(1x,i3,f5.2))')
8081 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8082 & j=1,num_cont_hb(i))
8089 write (iout,'(a)') 'Contact function values:'
8091 write (iout,'(2i3,50(1x,i3,f5.2))')
8092 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8093 & j=1,num_cont_hb(i))
8097 C Remove the loop below after debugging !!!
8104 C Calculate the local-electrostatic correlation terms
8105 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8107 num_conti=num_cont_hb(i)
8108 num_conti1=num_cont_hb(i+1)
8115 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8116 c & ' jj=',jj,' kk=',kk
8117 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8118 & .or. j.lt.0 .and. j1.gt.0) .and.
8119 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8120 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8121 C The system gains extra energy.
8122 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8123 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
8124 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
8126 else if (j1.eq.j) then
8127 C Contacts I-J and I-(J+1) occur simultaneously.
8128 C The system loses extra energy.
8129 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8134 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8135 c & ' jj=',jj,' kk=',kk
8137 C Contacts I-J and (I+1)-J occur simultaneously.
8138 C The system loses extra energy.
8139 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8146 c------------------------------------------------------------------------------
8147 subroutine add_hb_contact(ii,jj,itask)
8148 implicit real*8 (a-h,o-z)
8149 include "DIMENSIONS"
8150 include "COMMON.IOUNITS"
8153 parameter (max_cont=maxconts)
8154 parameter (max_dim=26)
8155 include "COMMON.CONTACTS"
8156 double precision zapas(max_dim,maxconts,max_fg_procs),
8157 & zapas_recv(max_dim,maxconts,max_fg_procs)
8158 common /przechowalnia/ zapas
8159 integer i,j,ii,jj,iproc,itask(4),nn
8160 c write (iout,*) "itask",itask
8163 if (iproc.gt.0) then
8164 do j=1,num_cont_hb(ii)
8166 c write (iout,*) "i",ii," j",jj," jjc",jjc
8168 ncont_sent(iproc)=ncont_sent(iproc)+1
8169 nn=ncont_sent(iproc)
8170 zapas(1,nn,iproc)=ii
8171 zapas(2,nn,iproc)=jjc
8172 zapas(3,nn,iproc)=facont_hb(j,ii)
8173 zapas(4,nn,iproc)=ees0p(j,ii)
8174 zapas(5,nn,iproc)=ees0m(j,ii)
8175 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8176 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8177 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8178 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8179 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8180 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8181 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8182 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8183 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8184 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8185 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8186 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8187 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8188 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8189 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8190 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8191 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8192 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8193 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8194 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8195 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8203 c------------------------------------------------------------------------------
8204 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8206 C This subroutine calculates multi-body contributions to hydrogen-bonding
8207 implicit real*8 (a-h,o-z)
8208 include 'DIMENSIONS'
8209 include 'COMMON.IOUNITS'
8212 parameter (max_cont=maxconts)
8213 parameter (max_dim=70)
8214 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8215 double precision zapas(max_dim,maxconts,max_fg_procs),
8216 & zapas_recv(max_dim,maxconts,max_fg_procs)
8217 common /przechowalnia/ zapas
8218 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8219 & status_array(MPI_STATUS_SIZE,maxconts*2)
8221 include 'COMMON.SETUP'
8222 include 'COMMON.FFIELD'
8223 include 'COMMON.DERIV'
8224 include 'COMMON.LOCAL'
8225 include 'COMMON.INTERACT'
8226 include 'COMMON.CONTACTS'
8227 include 'COMMON.CHAIN'
8228 include 'COMMON.CONTROL'
8229 include 'COMMON.SHIELD'
8230 double precision gx(3),gx1(3)
8231 integer num_cont_hb_old(maxres)
8233 double precision eello4,eello5,eelo6,eello_turn6
8234 external eello4,eello5,eello6,eello_turn6
8235 C Set lprn=.true. for debugging
8240 num_cont_hb_old(i)=num_cont_hb(i)
8244 if (nfgtasks.le.1) goto 30
8246 write (iout,'(a)') 'Contact function values before RECEIVE:'
8248 write (iout,'(2i3,50(1x,i2,f5.2))')
8249 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8250 & j=1,num_cont_hb(i))
8254 do i=1,ntask_cont_from
8257 do i=1,ntask_cont_to
8260 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8262 C Make the list of contacts to send to send to other procesors
8263 do i=iturn3_start,iturn3_end
8264 c write (iout,*) "make contact list turn3",i," num_cont",
8266 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8268 do i=iturn4_start,iturn4_end
8269 c write (iout,*) "make contact list turn4",i," num_cont",
8271 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8275 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8277 do j=1,num_cont_hb(i)
8280 iproc=iint_sent_local(k,jjc,ii)
8281 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8282 if (iproc.ne.0) then
8283 ncont_sent(iproc)=ncont_sent(iproc)+1
8284 nn=ncont_sent(iproc)
8286 zapas(2,nn,iproc)=jjc
8287 zapas(3,nn,iproc)=d_cont(j,i)
8291 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8296 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8304 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8315 & "Numbers of contacts to be sent to other processors",
8316 & (ncont_sent(i),i=1,ntask_cont_to)
8317 write (iout,*) "Contacts sent"
8318 do ii=1,ntask_cont_to
8320 iproc=itask_cont_to(ii)
8321 write (iout,*) nn," contacts to processor",iproc,
8322 & " of CONT_TO_COMM group"
8324 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8332 CorrelID1=nfgtasks+fg_rank+1
8334 C Receive the numbers of needed contacts from other processors
8335 do ii=1,ntask_cont_from
8336 iproc=itask_cont_from(ii)
8338 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8339 & FG_COMM,req(ireq),IERR)
8341 c write (iout,*) "IRECV ended"
8343 C Send the number of contacts needed by other processors
8344 do ii=1,ntask_cont_to
8345 iproc=itask_cont_to(ii)
8347 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8348 & FG_COMM,req(ireq),IERR)
8350 c write (iout,*) "ISEND ended"
8351 c write (iout,*) "number of requests (nn)",ireq
8354 & call MPI_Waitall(ireq,req,status_array,ierr)
8356 c & "Numbers of contacts to be received from other processors",
8357 c & (ncont_recv(i),i=1,ntask_cont_from)
8361 do ii=1,ntask_cont_from
8362 iproc=itask_cont_from(ii)
8364 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8365 c & " of CONT_TO_COMM group"
8369 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8370 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8371 c write (iout,*) "ireq,req",ireq,req(ireq)
8374 C Send the contacts to processors that need them
8375 do ii=1,ntask_cont_to
8376 iproc=itask_cont_to(ii)
8378 c write (iout,*) nn," contacts to processor",iproc,
8379 c & " of CONT_TO_COMM group"
8382 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8383 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8384 c write (iout,*) "ireq,req",ireq,req(ireq)
8386 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8390 c write (iout,*) "number of requests (contacts)",ireq
8391 c write (iout,*) "req",(req(i),i=1,4)
8394 & call MPI_Waitall(ireq,req,status_array,ierr)
8395 do iii=1,ntask_cont_from
8396 iproc=itask_cont_from(iii)
8399 write (iout,*) "Received",nn," contacts from processor",iproc,
8400 & " of CONT_FROM_COMM group"
8403 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8408 ii=zapas_recv(1,i,iii)
8409 c Flag the received contacts to prevent double-counting
8410 jj=-zapas_recv(2,i,iii)
8411 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8413 nnn=num_cont_hb(ii)+1
8416 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8420 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8425 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8433 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8442 write (iout,'(a)') 'Contact function values after receive:'
8444 write (iout,'(2i3,50(1x,i3,5f6.3))')
8445 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8446 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8453 write (iout,'(a)') 'Contact function values:'
8455 write (iout,'(2i3,50(1x,i2,5f6.3))')
8456 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8457 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8463 C Remove the loop below after debugging !!!
8470 C Calculate the dipole-dipole interaction energies
8471 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8472 do i=iatel_s,iatel_e+1
8473 num_conti=num_cont_hb(i)
8482 C Calculate the local-electrostatic correlation terms
8483 c write (iout,*) "gradcorr5 in eello5 before loop"
8485 c write (iout,'(i5,3f10.5)')
8486 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8488 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8489 c write (iout,*) "corr loop i",i
8491 num_conti=num_cont_hb(i)
8492 num_conti1=num_cont_hb(i+1)
8499 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8500 c & ' jj=',jj,' kk=',kk
8501 c if (j1.eq.j+1 .or. j1.eq.j-1) then
8502 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8503 & .or. j.lt.0 .and. j1.gt.0) .and.
8504 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8505 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8506 C The system gains extra energy.
8508 sqd1=dsqrt(d_cont(jj,i))
8509 sqd2=dsqrt(d_cont(kk,i1))
8510 sred_geom = sqd1*sqd2
8511 IF (sred_geom.lt.cutoff_corr) THEN
8512 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
8514 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8515 cd & ' jj=',jj,' kk=',kk
8516 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8517 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8519 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8520 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8523 cd write (iout,*) 'sred_geom=',sred_geom,
8524 cd & ' ekont=',ekont,' fprim=',fprimcont,
8525 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8526 cd write (iout,*) "g_contij",g_contij
8527 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8528 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8529 call calc_eello(i,jp,i+1,jp1,jj,kk)
8530 if (wcorr4.gt.0.0d0)
8531 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8532 CC & *fac_shield(i)**2*fac_shield(j)**2
8533 if (energy_dec.and.wcorr4.gt.0.0d0)
8534 1 write (iout,'(a6,4i5,0pf7.3)')
8535 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8536 c write (iout,*) "gradcorr5 before eello5"
8538 c write (iout,'(i5,3f10.5)')
8539 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8541 if (wcorr5.gt.0.0d0)
8542 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8543 c write (iout,*) "gradcorr5 after eello5"
8545 c write (iout,'(i5,3f10.5)')
8546 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8548 if (energy_dec.and.wcorr5.gt.0.0d0)
8549 1 write (iout,'(a6,4i5,0pf7.3)')
8550 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8551 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8552 cd write(2,*)'ijkl',i,jp,i+1,jp1
8553 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
8554 & .or. wturn6.eq.0.0d0))then
8555 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8556 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8557 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8558 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8559 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8560 cd & 'ecorr6=',ecorr6
8561 cd write (iout,'(4e15.5)') sred_geom,
8562 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8563 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8564 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8565 else if (wturn6.gt.0.0d0
8566 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8567 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8568 eturn6=eturn6+eello_turn6(i,jj,kk)
8569 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8570 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8571 cd write (2,*) 'multibody_eello:eturn6',eturn6
8580 num_cont_hb(i)=num_cont_hb_old(i)
8582 c write (iout,*) "gradcorr5 in eello5"
8584 c write (iout,'(i5,3f10.5)')
8585 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8589 c------------------------------------------------------------------------------
8590 subroutine add_hb_contact_eello(ii,jj,itask)
8591 implicit real*8 (a-h,o-z)
8592 include "DIMENSIONS"
8593 include "COMMON.IOUNITS"
8596 parameter (max_cont=maxconts)
8597 parameter (max_dim=70)
8598 include "COMMON.CONTACTS"
8599 double precision zapas(max_dim,maxconts,max_fg_procs),
8600 & zapas_recv(max_dim,maxconts,max_fg_procs)
8601 common /przechowalnia/ zapas
8602 integer i,j,ii,jj,iproc,itask(4),nn
8603 c write (iout,*) "itask",itask
8606 if (iproc.gt.0) then
8607 do j=1,num_cont_hb(ii)
8609 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8611 ncont_sent(iproc)=ncont_sent(iproc)+1
8612 nn=ncont_sent(iproc)
8613 zapas(1,nn,iproc)=ii
8614 zapas(2,nn,iproc)=jjc
8615 zapas(3,nn,iproc)=d_cont(j,ii)
8619 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8624 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8632 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8644 c------------------------------------------------------------------------------
8645 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8646 implicit real*8 (a-h,o-z)
8647 include 'DIMENSIONS'
8648 include 'COMMON.IOUNITS'
8649 include 'COMMON.DERIV'
8650 include 'COMMON.INTERACT'
8651 include 'COMMON.CONTACTS'
8652 include 'COMMON.SHIELD'
8653 include 'COMMON.CONTROL'
8654 double precision gx(3),gx1(3)
8657 C print *,"wchodze",fac_shield(i),shield_mode
8665 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8667 C & fac_shield(i)**2*fac_shield(j)**2
8668 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8669 C Following 4 lines for diagnostics.
8674 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8675 c & 'Contacts ',i,j,
8676 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8677 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8679 C Calculate the multi-body contribution to energy.
8680 c ecorr=ecorr+ekont*ees
8681 C Calculate multi-body contributions to the gradient.
8682 coeffpees0pij=coeffp*ees0pij
8683 coeffmees0mij=coeffm*ees0mij
8684 coeffpees0pkl=coeffp*ees0pkl
8685 coeffmees0mkl=coeffm*ees0mkl
8687 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8688 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8689 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8690 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8691 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8692 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8693 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8694 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8695 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8696 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8697 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8698 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8699 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8700 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8701 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8702 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8703 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8704 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8705 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8706 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8707 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8708 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8709 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8710 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8711 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8716 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8717 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8718 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8719 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8724 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8725 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8726 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8727 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8730 c write (iout,*) "ehbcorr",ekont*ees
8731 C print *,ekont,ees,i,k
8733 C now gradient over shielding
8735 if (shield_mode.gt.0) then
8738 C print *,i,j,fac_shield(i),fac_shield(j),
8739 C &fac_shield(k),fac_shield(l)
8740 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
8741 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8742 do ilist=1,ishield_list(i)
8743 iresshield=shield_list(ilist,i)
8745 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8747 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8749 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8750 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8754 do ilist=1,ishield_list(j)
8755 iresshield=shield_list(ilist,j)
8757 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8759 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8761 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8762 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8767 do ilist=1,ishield_list(k)
8768 iresshield=shield_list(ilist,k)
8770 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8772 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8774 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8775 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8779 do ilist=1,ishield_list(l)
8780 iresshield=shield_list(ilist,l)
8782 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8784 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8786 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8787 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8791 C print *,gshieldx(m,iresshield)
8793 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
8794 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8795 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
8796 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8797 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
8798 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8799 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
8800 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8802 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
8803 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8804 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
8805 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8806 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
8807 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8808 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
8809 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8817 C---------------------------------------------------------------------------
8818 subroutine dipole(i,j,jj)
8819 implicit real*8 (a-h,o-z)
8820 include 'DIMENSIONS'
8821 include 'COMMON.IOUNITS'
8822 include 'COMMON.CHAIN'
8823 include 'COMMON.FFIELD'
8824 include 'COMMON.DERIV'
8825 include 'COMMON.INTERACT'
8826 include 'COMMON.CONTACTS'
8827 include 'COMMON.TORSION'
8828 include 'COMMON.VAR'
8829 include 'COMMON.GEO'
8830 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8832 iti1 = itortyp(itype(i+1))
8833 if (j.lt.nres-1) then
8834 itj1 = itortyp(itype(j+1))
8839 dipi(iii,1)=Ub2(iii,i)
8840 dipderi(iii)=Ub2der(iii,i)
8841 dipi(iii,2)=b1(iii,i+1)
8842 dipj(iii,1)=Ub2(iii,j)
8843 dipderj(iii)=Ub2der(iii,j)
8844 dipj(iii,2)=b1(iii,j+1)
8848 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8851 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8858 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8862 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8867 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8868 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8870 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8872 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8874 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8879 C---------------------------------------------------------------------------
8880 subroutine calc_eello(i,j,k,l,jj,kk)
8882 C This subroutine computes matrices and vectors needed to calculate
8883 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8885 implicit real*8 (a-h,o-z)
8886 include 'DIMENSIONS'
8887 include 'COMMON.IOUNITS'
8888 include 'COMMON.CHAIN'
8889 include 'COMMON.DERIV'
8890 include 'COMMON.INTERACT'
8891 include 'COMMON.CONTACTS'
8892 include 'COMMON.TORSION'
8893 include 'COMMON.VAR'
8894 include 'COMMON.GEO'
8895 include 'COMMON.FFIELD'
8896 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8897 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8900 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8901 cd & ' jj=',jj,' kk=',kk
8902 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8903 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8904 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8907 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8908 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8911 call transpose2(aa1(1,1),aa1t(1,1))
8912 call transpose2(aa2(1,1),aa2t(1,1))
8915 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8916 & aa1tder(1,1,lll,kkk))
8917 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8918 & aa2tder(1,1,lll,kkk))
8922 C parallel orientation of the two CA-CA-CA frames.
8924 iti=itortyp(itype(i))
8928 itk1=itortyp(itype(k+1))
8929 itj=itortyp(itype(j))
8930 if (l.lt.nres-1) then
8931 itl1=itortyp(itype(l+1))
8935 C A1 kernel(j+1) A2T
8937 cd write (iout,'(3f10.5,5x,3f10.5)')
8938 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8940 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8941 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8942 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8943 C Following matrices are needed only for 6-th order cumulants
8944 IF (wcorr6.gt.0.0d0) THEN
8945 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8946 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8947 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8948 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8949 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8950 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8951 & ADtEAderx(1,1,1,1,1,1))
8953 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8954 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8955 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8956 & ADtEA1derx(1,1,1,1,1,1))
8958 C End 6-th order cumulants
8961 cd write (2,*) 'In calc_eello6'
8963 cd write (2,*) 'iii=',iii
8965 cd write (2,*) 'kkk=',kkk
8967 cd write (2,'(3(2f10.5),5x)')
8968 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8973 call transpose2(EUgder(1,1,k),auxmat(1,1))
8974 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8975 call transpose2(EUg(1,1,k),auxmat(1,1))
8976 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8977 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8981 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8982 & EAEAderx(1,1,lll,kkk,iii,1))
8986 C A1T kernel(i+1) A2
8987 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8988 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8989 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8990 C Following matrices are needed only for 6-th order cumulants
8991 IF (wcorr6.gt.0.0d0) THEN
8992 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8993 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8994 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8995 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8996 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8997 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8998 & ADtEAderx(1,1,1,1,1,2))
8999 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9000 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
9001 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9002 & ADtEA1derx(1,1,1,1,1,2))
9004 C End 6-th order cumulants
9005 call transpose2(EUgder(1,1,l),auxmat(1,1))
9006 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
9007 call transpose2(EUg(1,1,l),auxmat(1,1))
9008 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9009 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9013 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9014 & EAEAderx(1,1,lll,kkk,iii,2))
9019 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9020 C They are needed only when the fifth- or the sixth-order cumulants are
9022 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
9023 call transpose2(AEA(1,1,1),auxmat(1,1))
9024 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9025 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9026 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9027 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9028 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9029 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9030 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9031 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9032 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9033 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9034 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9035 call transpose2(AEA(1,1,2),auxmat(1,1))
9036 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
9037 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
9038 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
9039 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9040 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
9041 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
9042 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
9043 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
9044 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
9045 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
9046 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
9047 C Calculate the Cartesian derivatives of the vectors.
9051 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9052 call matvec2(auxmat(1,1),b1(1,i),
9053 & AEAb1derx(1,lll,kkk,iii,1,1))
9054 call matvec2(auxmat(1,1),Ub2(1,i),
9055 & AEAb2derx(1,lll,kkk,iii,1,1))
9056 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9057 & AEAb1derx(1,lll,kkk,iii,2,1))
9058 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9059 & AEAb2derx(1,lll,kkk,iii,2,1))
9060 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9061 call matvec2(auxmat(1,1),b1(1,j),
9062 & AEAb1derx(1,lll,kkk,iii,1,2))
9063 call matvec2(auxmat(1,1),Ub2(1,j),
9064 & AEAb2derx(1,lll,kkk,iii,1,2))
9065 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9066 & AEAb1derx(1,lll,kkk,iii,2,2))
9067 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
9068 & AEAb2derx(1,lll,kkk,iii,2,2))
9075 C Antiparallel orientation of the two CA-CA-CA frames.
9077 iti=itortyp(itype(i))
9081 itk1=itortyp(itype(k+1))
9082 itl=itortyp(itype(l))
9083 itj=itortyp(itype(j))
9084 if (j.lt.nres-1) then
9085 itj1=itortyp(itype(j+1))
9089 C A2 kernel(j-1)T A1T
9090 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9091 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
9092 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9093 C Following matrices are needed only for 6-th order cumulants
9094 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9095 & j.eq.i+4 .and. l.eq.i+3)) THEN
9096 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9097 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
9098 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9099 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9100 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
9101 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9102 & ADtEAderx(1,1,1,1,1,1))
9103 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9104 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
9105 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9106 & ADtEA1derx(1,1,1,1,1,1))
9108 C End 6-th order cumulants
9109 call transpose2(EUgder(1,1,k),auxmat(1,1))
9110 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9111 call transpose2(EUg(1,1,k),auxmat(1,1))
9112 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9113 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9117 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9118 & EAEAderx(1,1,lll,kkk,iii,1))
9122 C A2T kernel(i+1)T A1
9123 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9124 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
9125 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9126 C Following matrices are needed only for 6-th order cumulants
9127 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9128 & j.eq.i+4 .and. l.eq.i+3)) THEN
9129 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9130 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
9131 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9132 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9133 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
9134 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9135 & ADtEAderx(1,1,1,1,1,2))
9136 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9137 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
9138 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9139 & ADtEA1derx(1,1,1,1,1,2))
9141 C End 6-th order cumulants
9142 call transpose2(EUgder(1,1,j),auxmat(1,1))
9143 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9144 call transpose2(EUg(1,1,j),auxmat(1,1))
9145 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9146 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9150 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9151 & EAEAderx(1,1,lll,kkk,iii,2))
9156 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9157 C They are needed only when the fifth- or the sixth-order cumulants are
9159 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
9160 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9161 call transpose2(AEA(1,1,1),auxmat(1,1))
9162 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9163 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9164 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9165 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9166 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9167 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9168 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9169 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9170 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9171 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9172 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9173 call transpose2(AEA(1,1,2),auxmat(1,1))
9174 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
9175 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9176 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9177 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9178 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
9179 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9180 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
9181 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
9182 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9183 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9184 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9185 C Calculate the Cartesian derivatives of the vectors.
9189 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9190 call matvec2(auxmat(1,1),b1(1,i),
9191 & AEAb1derx(1,lll,kkk,iii,1,1))
9192 call matvec2(auxmat(1,1),Ub2(1,i),
9193 & AEAb2derx(1,lll,kkk,iii,1,1))
9194 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9195 & AEAb1derx(1,lll,kkk,iii,2,1))
9196 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9197 & AEAb2derx(1,lll,kkk,iii,2,1))
9198 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9199 call matvec2(auxmat(1,1),b1(1,l),
9200 & AEAb1derx(1,lll,kkk,iii,1,2))
9201 call matvec2(auxmat(1,1),Ub2(1,l),
9202 & AEAb2derx(1,lll,kkk,iii,1,2))
9203 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
9204 & AEAb1derx(1,lll,kkk,iii,2,2))
9205 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
9206 & AEAb2derx(1,lll,kkk,iii,2,2))
9215 C---------------------------------------------------------------------------
9216 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
9217 & KK,KKderg,AKA,AKAderg,AKAderx)
9221 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
9222 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
9223 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
9228 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9230 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
9233 cd if (lprn) write (2,*) 'In kernel'
9235 cd if (lprn) write (2,*) 'kkk=',kkk
9237 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
9238 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9240 cd write (2,*) 'lll=',lll
9241 cd write (2,*) 'iii=1'
9243 cd write (2,'(3(2f10.5),5x)')
9244 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9247 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
9248 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9250 cd write (2,*) 'lll=',lll
9251 cd write (2,*) 'iii=2'
9253 cd write (2,'(3(2f10.5),5x)')
9254 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9261 C---------------------------------------------------------------------------
9262 double precision function eello4(i,j,k,l,jj,kk)
9263 implicit real*8 (a-h,o-z)
9264 include 'DIMENSIONS'
9265 include 'COMMON.IOUNITS'
9266 include 'COMMON.CHAIN'
9267 include 'COMMON.DERIV'
9268 include 'COMMON.INTERACT'
9269 include 'COMMON.CONTACTS'
9270 include 'COMMON.TORSION'
9271 include 'COMMON.VAR'
9272 include 'COMMON.GEO'
9273 double precision pizda(2,2),ggg1(3),ggg2(3)
9274 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9278 cd print *,'eello4:',i,j,k,l,jj,kk
9279 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9280 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9281 cold eij=facont_hb(jj,i)
9282 cold ekl=facont_hb(kk,k)
9284 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9285 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9286 gcorr_loc(k-1)=gcorr_loc(k-1)
9287 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9289 gcorr_loc(l-1)=gcorr_loc(l-1)
9290 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9292 gcorr_loc(j-1)=gcorr_loc(j-1)
9293 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9298 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9299 & -EAEAderx(2,2,lll,kkk,iii,1)
9300 cd derx(lll,kkk,iii)=0.0d0
9304 cd gcorr_loc(l-1)=0.0d0
9305 cd gcorr_loc(j-1)=0.0d0
9306 cd gcorr_loc(k-1)=0.0d0
9308 cd write (iout,*)'Contacts have occurred for peptide groups',
9309 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9310 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9311 if (j.lt.nres-1) then
9318 if (l.lt.nres-1) then
9326 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9327 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9328 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9329 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9330 cgrad ghalf=0.5d0*ggg1(ll)
9331 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9332 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9333 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9334 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9335 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9336 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9337 cgrad ghalf=0.5d0*ggg2(ll)
9338 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9339 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9340 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9341 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9342 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9343 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9347 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9352 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9357 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9362 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9366 cd write (2,*) iii,gcorr_loc(iii)
9369 cd write (2,*) 'ekont',ekont
9370 cd write (iout,*) 'eello4',ekont*eel4
9373 C---------------------------------------------------------------------------
9374 double precision function eello5(i,j,k,l,jj,kk)
9375 implicit real*8 (a-h,o-z)
9376 include 'DIMENSIONS'
9377 include 'COMMON.IOUNITS'
9378 include 'COMMON.CHAIN'
9379 include 'COMMON.DERIV'
9380 include 'COMMON.INTERACT'
9381 include 'COMMON.CONTACTS'
9382 include 'COMMON.TORSION'
9383 include 'COMMON.VAR'
9384 include 'COMMON.GEO'
9385 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9386 double precision ggg1(3),ggg2(3)
9387 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9392 C /l\ / \ \ / \ / \ / C
9393 C / \ / \ \ / \ / \ / C
9394 C j| o |l1 | o | o| o | | o |o C
9395 C \ |/k\| |/ \| / |/ \| |/ \| C
9396 C \i/ \ / \ / / \ / \ C
9398 C (I) (II) (III) (IV) C
9400 C eello5_1 eello5_2 eello5_3 eello5_4 C
9402 C Antiparallel chains C
9405 C /j\ / \ \ / \ / \ / C
9406 C / \ / \ \ / \ / \ / C
9407 C j1| o |l | o | o| o | | o |o C
9408 C \ |/k\| |/ \| / |/ \| |/ \| C
9409 C \i/ \ / \ / / \ / \ C
9411 C (I) (II) (III) (IV) C
9413 C eello5_1 eello5_2 eello5_3 eello5_4 C
9415 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9417 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9418 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9423 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9425 itk=itortyp(itype(k))
9426 itl=itortyp(itype(l))
9427 itj=itortyp(itype(j))
9432 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9433 cd & eel5_3_num,eel5_4_num)
9437 derx(lll,kkk,iii)=0.0d0
9441 cd eij=facont_hb(jj,i)
9442 cd ekl=facont_hb(kk,k)
9444 cd write (iout,*)'Contacts have occurred for peptide groups',
9445 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9447 C Contribution from the graph I.
9448 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9449 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9450 call transpose2(EUg(1,1,k),auxmat(1,1))
9451 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9452 vv(1)=pizda(1,1)-pizda(2,2)
9453 vv(2)=pizda(1,2)+pizda(2,1)
9454 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9455 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9456 C Explicit gradient in virtual-dihedral angles.
9457 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9458 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9459 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9460 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9461 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9462 vv(1)=pizda(1,1)-pizda(2,2)
9463 vv(2)=pizda(1,2)+pizda(2,1)
9464 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9465 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9466 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9467 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9468 vv(1)=pizda(1,1)-pizda(2,2)
9469 vv(2)=pizda(1,2)+pizda(2,1)
9471 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9472 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9473 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9475 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9476 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9477 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9479 C Cartesian gradient
9483 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
9485 vv(1)=pizda(1,1)-pizda(2,2)
9486 vv(2)=pizda(1,2)+pizda(2,1)
9487 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9488 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
9489 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9495 C Contribution from graph II
9496 call transpose2(EE(1,1,itk),auxmat(1,1))
9497 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9498 vv(1)=pizda(1,1)+pizda(2,2)
9499 vv(2)=pizda(2,1)-pizda(1,2)
9500 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
9501 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9502 C Explicit gradient in virtual-dihedral angles.
9503 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9504 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9505 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9506 vv(1)=pizda(1,1)+pizda(2,2)
9507 vv(2)=pizda(2,1)-pizda(1,2)
9509 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9510 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9511 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9513 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9514 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9515 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9517 C Cartesian gradient
9521 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9523 vv(1)=pizda(1,1)+pizda(2,2)
9524 vv(2)=pizda(2,1)-pizda(1,2)
9525 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9526 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
9527 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9535 C Parallel orientation
9536 C Contribution from graph III
9537 call transpose2(EUg(1,1,l),auxmat(1,1))
9538 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9539 vv(1)=pizda(1,1)-pizda(2,2)
9540 vv(2)=pizda(1,2)+pizda(2,1)
9541 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
9542 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9543 C Explicit gradient in virtual-dihedral angles.
9544 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9545 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
9546 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9547 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9548 vv(1)=pizda(1,1)-pizda(2,2)
9549 vv(2)=pizda(1,2)+pizda(2,1)
9550 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9551 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
9552 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9553 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9554 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9555 vv(1)=pizda(1,1)-pizda(2,2)
9556 vv(2)=pizda(1,2)+pizda(2,1)
9557 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9558 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
9559 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9560 C Cartesian gradient
9564 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9566 vv(1)=pizda(1,1)-pizda(2,2)
9567 vv(2)=pizda(1,2)+pizda(2,1)
9568 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9569 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
9570 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9575 C Contribution from graph IV
9577 call transpose2(EE(1,1,itl),auxmat(1,1))
9578 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9579 vv(1)=pizda(1,1)+pizda(2,2)
9580 vv(2)=pizda(2,1)-pizda(1,2)
9581 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
9582 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9583 C Explicit gradient in virtual-dihedral angles.
9584 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9585 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9586 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9587 vv(1)=pizda(1,1)+pizda(2,2)
9588 vv(2)=pizda(2,1)-pizda(1,2)
9589 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9590 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
9591 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9592 C Cartesian gradient
9596 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9598 vv(1)=pizda(1,1)+pizda(2,2)
9599 vv(2)=pizda(2,1)-pizda(1,2)
9600 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9601 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
9602 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9607 C Antiparallel orientation
9608 C Contribution from graph III
9610 call transpose2(EUg(1,1,j),auxmat(1,1))
9611 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9612 vv(1)=pizda(1,1)-pizda(2,2)
9613 vv(2)=pizda(1,2)+pizda(2,1)
9614 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9615 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9616 C Explicit gradient in virtual-dihedral angles.
9617 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9618 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9619 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9620 call matmat2(AEAderg(1,1,2),auxmat(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(k-1)=g_corr5_loc(k-1)
9624 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9625 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9626 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9627 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9628 vv(1)=pizda(1,1)-pizda(2,2)
9629 vv(2)=pizda(1,2)+pizda(2,1)
9630 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9631 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9632 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9633 C Cartesian gradient
9637 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9639 vv(1)=pizda(1,1)-pizda(2,2)
9640 vv(2)=pizda(1,2)+pizda(2,1)
9641 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9642 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9643 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9648 C Contribution from graph IV
9650 call transpose2(EE(1,1,itj),auxmat(1,1))
9651 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9652 vv(1)=pizda(1,1)+pizda(2,2)
9653 vv(2)=pizda(2,1)-pizda(1,2)
9654 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9655 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9656 C Explicit gradient in virtual-dihedral angles.
9657 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9658 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9659 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9660 vv(1)=pizda(1,1)+pizda(2,2)
9661 vv(2)=pizda(2,1)-pizda(1,2)
9662 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9663 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9664 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9665 C Cartesian gradient
9669 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9671 vv(1)=pizda(1,1)+pizda(2,2)
9672 vv(2)=pizda(2,1)-pizda(1,2)
9673 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9674 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9675 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9681 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9682 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9683 cd write (2,*) 'ijkl',i,j,k,l
9684 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9685 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9687 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9688 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9689 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9690 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9691 if (j.lt.nres-1) then
9698 if (l.lt.nres-1) then
9708 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9709 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9710 C summed up outside the subrouine as for the other subroutines
9711 C handling long-range interactions. The old code is commented out
9712 C with "cgrad" to keep track of changes.
9714 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9715 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9716 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9717 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9718 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9719 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9720 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9721 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9722 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9723 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9725 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9726 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9727 cgrad ghalf=0.5d0*ggg1(ll)
9729 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9730 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9731 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9732 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9733 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9734 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9735 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9736 cgrad ghalf=0.5d0*ggg2(ll)
9738 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
9739 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9740 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
9741 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9742 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9743 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9748 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9749 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9754 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9755 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9761 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9766 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9770 cd write (2,*) iii,g_corr5_loc(iii)
9773 cd write (2,*) 'ekont',ekont
9774 cd write (iout,*) 'eello5',ekont*eel5
9777 c--------------------------------------------------------------------------
9778 double precision function eello6(i,j,k,l,jj,kk)
9779 implicit real*8 (a-h,o-z)
9780 include 'DIMENSIONS'
9781 include 'COMMON.IOUNITS'
9782 include 'COMMON.CHAIN'
9783 include 'COMMON.DERIV'
9784 include 'COMMON.INTERACT'
9785 include 'COMMON.CONTACTS'
9786 include 'COMMON.TORSION'
9787 include 'COMMON.VAR'
9788 include 'COMMON.GEO'
9789 include 'COMMON.FFIELD'
9790 double precision ggg1(3),ggg2(3)
9791 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9796 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9804 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9805 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9809 derx(lll,kkk,iii)=0.0d0
9813 cd eij=facont_hb(jj,i)
9814 cd ekl=facont_hb(kk,k)
9820 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9821 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9822 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9823 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9824 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9825 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9827 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9828 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9829 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9830 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9831 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9832 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9836 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9838 C If turn contributions are considered, they will be handled separately.
9839 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9840 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9841 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9842 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9843 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9844 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9845 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9847 if (j.lt.nres-1) then
9854 if (l.lt.nres-1) then
9862 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9863 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9864 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9865 cgrad ghalf=0.5d0*ggg1(ll)
9867 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9868 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9869 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9870 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9871 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9872 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9873 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9874 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9875 cgrad ghalf=0.5d0*ggg2(ll)
9876 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9878 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9879 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9880 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9881 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9882 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9883 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9888 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9889 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9894 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9895 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9901 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9906 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9910 cd write (2,*) iii,g_corr6_loc(iii)
9913 cd write (2,*) 'ekont',ekont
9914 cd write (iout,*) 'eello6',ekont*eel6
9917 c--------------------------------------------------------------------------
9918 double precision function eello6_graph1(i,j,k,l,imat,swap)
9919 implicit real*8 (a-h,o-z)
9920 include 'DIMENSIONS'
9921 include 'COMMON.IOUNITS'
9922 include 'COMMON.CHAIN'
9923 include 'COMMON.DERIV'
9924 include 'COMMON.INTERACT'
9925 include 'COMMON.CONTACTS'
9926 include 'COMMON.TORSION'
9927 include 'COMMON.VAR'
9928 include 'COMMON.GEO'
9929 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9933 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9935 C Parallel Antiparallel C
9941 C \ j|/k\| / \ |/k\|l / C
9946 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9947 itk=itortyp(itype(k))
9948 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9949 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9950 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9951 call transpose2(EUgC(1,1,k),auxmat(1,1))
9952 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9953 vv1(1)=pizda1(1,1)-pizda1(2,2)
9954 vv1(2)=pizda1(1,2)+pizda1(2,1)
9955 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9956 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9957 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9958 s5=scalar2(vv(1),Dtobr2(1,i))
9959 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9960 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9961 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9962 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9963 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9964 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9965 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9966 & +scalar2(vv(1),Dtobr2der(1,i)))
9967 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9968 vv1(1)=pizda1(1,1)-pizda1(2,2)
9969 vv1(2)=pizda1(1,2)+pizda1(2,1)
9970 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9971 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9973 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9974 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9975 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9976 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9977 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9979 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9980 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9981 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9982 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9983 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9985 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9986 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9987 vv1(1)=pizda1(1,1)-pizda1(2,2)
9988 vv1(2)=pizda1(1,2)+pizda1(2,1)
9989 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9990 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9991 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9992 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
10001 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
10002 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
10003 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
10004 call transpose2(EUgC(1,1,k),auxmat(1,1))
10005 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10007 vv1(1)=pizda1(1,1)-pizda1(2,2)
10008 vv1(2)=pizda1(1,2)+pizda1(2,1)
10009 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10010 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
10011 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
10012 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
10013 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
10014 s5=scalar2(vv(1),Dtobr2(1,i))
10015 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
10021 c----------------------------------------------------------------------------
10022 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
10023 implicit real*8 (a-h,o-z)
10024 include 'DIMENSIONS'
10025 include 'COMMON.IOUNITS'
10026 include 'COMMON.CHAIN'
10027 include 'COMMON.DERIV'
10028 include 'COMMON.INTERACT'
10029 include 'COMMON.CONTACTS'
10030 include 'COMMON.TORSION'
10031 include 'COMMON.VAR'
10032 include 'COMMON.GEO'
10034 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10035 & auxvec1(2),auxvec2(2),auxmat1(2,2)
10037 common /kutas/ lprn
10038 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10040 C Parallel Antiparallel C
10046 C \ j|/k\| \ |/k\|l C
10051 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10052 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
10053 C AL 7/4/01 s1 would occur in the sixth-order moment,
10054 C but not in a cluster cumulant
10056 s1=dip(1,jj,i)*dip(1,kk,k)
10058 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
10059 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10060 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
10061 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
10062 call transpose2(EUg(1,1,k),auxmat(1,1))
10063 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
10064 vv(1)=pizda(1,1)-pizda(2,2)
10065 vv(2)=pizda(1,2)+pizda(2,1)
10066 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10067 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10069 eello6_graph2=-(s1+s2+s3+s4)
10071 eello6_graph2=-(s2+s3+s4)
10073 c eello6_graph2=-s3
10074 C Derivatives in gamma(i-1)
10077 s1=dipderg(1,jj,i)*dip(1,kk,k)
10079 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10080 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
10081 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10082 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10084 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10086 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10088 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
10090 C Derivatives in gamma(k-1)
10092 s1=dip(1,jj,i)*dipderg(1,kk,k)
10094 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
10095 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10096 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
10097 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10098 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10099 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
10100 vv(1)=pizda(1,1)-pizda(2,2)
10101 vv(2)=pizda(1,2)+pizda(2,1)
10102 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10104 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10106 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10108 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
10109 C Derivatives in gamma(j-1) or gamma(l-1)
10112 s1=dipderg(3,jj,i)*dip(1,kk,k)
10114 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
10115 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10116 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
10117 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
10118 vv(1)=pizda(1,1)-pizda(2,2)
10119 vv(2)=pizda(1,2)+pizda(2,1)
10120 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10123 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10125 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10128 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10129 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10131 C Derivatives in gamma(l-1) or gamma(j-1)
10134 s1=dip(1,jj,i)*dipderg(3,kk,k)
10136 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10137 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10138 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10139 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10140 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10141 vv(1)=pizda(1,1)-pizda(2,2)
10142 vv(2)=pizda(1,2)+pizda(2,1)
10143 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10146 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10148 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10151 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10152 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10154 C Cartesian derivatives.
10156 write (2,*) 'In eello6_graph2'
10158 write (2,*) 'iii=',iii
10160 write (2,*) 'kkk=',kkk
10162 write (2,'(3(2f10.5),5x)')
10163 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10173 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10175 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10178 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
10180 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10181 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
10183 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10184 call transpose2(EUg(1,1,k),auxmat(1,1))
10185 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
10187 vv(1)=pizda(1,1)-pizda(2,2)
10188 vv(2)=pizda(1,2)+pizda(2,1)
10189 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10190 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10192 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10194 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10197 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10199 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10206 c----------------------------------------------------------------------------
10207 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
10208 implicit real*8 (a-h,o-z)
10209 include 'DIMENSIONS'
10210 include 'COMMON.IOUNITS'
10211 include 'COMMON.CHAIN'
10212 include 'COMMON.DERIV'
10213 include 'COMMON.INTERACT'
10214 include 'COMMON.CONTACTS'
10215 include 'COMMON.TORSION'
10216 include 'COMMON.VAR'
10217 include 'COMMON.GEO'
10218 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
10220 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10222 C Parallel Antiparallel C
10227 C /| o |o o| o |\ C
10228 C j|/k\| / |/k\|l / C
10233 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10235 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10236 C energy moment and not to the cluster cumulant.
10237 iti=itortyp(itype(i))
10238 if (j.lt.nres-1) then
10239 itj1=itortyp(itype(j+1))
10243 itk=itortyp(itype(k))
10244 itk1=itortyp(itype(k+1))
10245 if (l.lt.nres-1) then
10246 itl1=itortyp(itype(l+1))
10251 s1=dip(4,jj,i)*dip(4,kk,k)
10253 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
10254 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10255 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
10256 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10257 call transpose2(EE(1,1,itk),auxmat(1,1))
10258 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10259 vv(1)=pizda(1,1)+pizda(2,2)
10260 vv(2)=pizda(2,1)-pizda(1,2)
10261 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10262 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10263 cd & "sum",-(s2+s3+s4)
10265 eello6_graph3=-(s1+s2+s3+s4)
10267 eello6_graph3=-(s2+s3+s4)
10269 c eello6_graph3=-s4
10270 C Derivatives in gamma(k-1)
10271 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
10272 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10273 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10274 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10275 C Derivatives in gamma(l-1)
10276 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
10277 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10278 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10279 vv(1)=pizda(1,1)+pizda(2,2)
10280 vv(2)=pizda(2,1)-pizda(1,2)
10281 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10282 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10283 C Cartesian derivatives.
10289 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10291 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10294 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
10296 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10297 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
10299 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10300 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
10302 vv(1)=pizda(1,1)+pizda(2,2)
10303 vv(2)=pizda(2,1)-pizda(1,2)
10304 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10306 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10308 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10311 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10313 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10315 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10321 c----------------------------------------------------------------------------
10322 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10323 implicit real*8 (a-h,o-z)
10324 include 'DIMENSIONS'
10325 include 'COMMON.IOUNITS'
10326 include 'COMMON.CHAIN'
10327 include 'COMMON.DERIV'
10328 include 'COMMON.INTERACT'
10329 include 'COMMON.CONTACTS'
10330 include 'COMMON.TORSION'
10331 include 'COMMON.VAR'
10332 include 'COMMON.GEO'
10333 include 'COMMON.FFIELD'
10334 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10335 & auxvec1(2),auxmat1(2,2)
10337 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10339 C Parallel Antiparallel C
10344 C /| o |o o| o |\ C
10345 C \ j|/k\| \ |/k\|l C
10350 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10352 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10353 C energy moment and not to the cluster cumulant.
10354 cd write (2,*) 'eello_graph4: wturn6',wturn6
10355 iti=itortyp(itype(i))
10356 itj=itortyp(itype(j))
10357 if (j.lt.nres-1) then
10358 itj1=itortyp(itype(j+1))
10362 itk=itortyp(itype(k))
10363 if (k.lt.nres-1) then
10364 itk1=itortyp(itype(k+1))
10368 itl=itortyp(itype(l))
10369 if (l.lt.nres-1) then
10370 itl1=itortyp(itype(l+1))
10374 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10375 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10376 cd & ' itl',itl,' itl1',itl1
10378 if (imat.eq.1) then
10379 s1=dip(3,jj,i)*dip(3,kk,k)
10381 s1=dip(2,jj,j)*dip(2,kk,l)
10384 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10385 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10387 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
10388 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10390 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
10391 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10393 call transpose2(EUg(1,1,k),auxmat(1,1))
10394 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10395 vv(1)=pizda(1,1)-pizda(2,2)
10396 vv(2)=pizda(2,1)+pizda(1,2)
10397 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10398 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10400 eello6_graph4=-(s1+s2+s3+s4)
10402 eello6_graph4=-(s2+s3+s4)
10404 C Derivatives in gamma(i-1)
10407 if (imat.eq.1) then
10408 s1=dipderg(2,jj,i)*dip(3,kk,k)
10410 s1=dipderg(4,jj,j)*dip(2,kk,l)
10413 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10415 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
10416 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10418 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
10419 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10421 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10422 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10423 cd write (2,*) 'turn6 derivatives'
10425 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10427 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10431 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10433 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10437 C Derivatives in gamma(k-1)
10439 if (imat.eq.1) then
10440 s1=dip(3,jj,i)*dipderg(2,kk,k)
10442 s1=dip(2,jj,j)*dipderg(4,kk,l)
10445 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10446 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10448 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
10449 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10451 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
10452 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10454 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10455 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10456 vv(1)=pizda(1,1)-pizda(2,2)
10457 vv(2)=pizda(2,1)+pizda(1,2)
10458 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10459 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10461 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10463 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10467 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10469 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10472 C Derivatives in gamma(j-1) or gamma(l-1)
10473 if (l.eq.j+1 .and. l.gt.1) then
10474 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10475 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10476 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10477 vv(1)=pizda(1,1)-pizda(2,2)
10478 vv(2)=pizda(2,1)+pizda(1,2)
10479 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10480 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10481 else if (j.gt.1) then
10482 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10483 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10484 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10485 vv(1)=pizda(1,1)-pizda(2,2)
10486 vv(2)=pizda(2,1)+pizda(1,2)
10487 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10488 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10489 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10491 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10494 C Cartesian derivatives.
10500 if (imat.eq.1) then
10501 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10503 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10506 if (imat.eq.1) then
10507 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10509 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10513 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
10515 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10517 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10518 & b1(1,j+1),auxvec(1))
10519 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
10521 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10522 & b1(1,l+1),auxvec(1))
10523 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
10525 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10527 vv(1)=pizda(1,1)-pizda(2,2)
10528 vv(2)=pizda(2,1)+pizda(1,2)
10529 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10531 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10533 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10536 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10539 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10542 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10544 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10546 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10550 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10552 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10555 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10557 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10565 c----------------------------------------------------------------------------
10566 double precision function eello_turn6(i,jj,kk)
10567 implicit real*8 (a-h,o-z)
10568 include 'DIMENSIONS'
10569 include 'COMMON.IOUNITS'
10570 include 'COMMON.CHAIN'
10571 include 'COMMON.DERIV'
10572 include 'COMMON.INTERACT'
10573 include 'COMMON.CONTACTS'
10574 include 'COMMON.TORSION'
10575 include 'COMMON.VAR'
10576 include 'COMMON.GEO'
10577 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
10578 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
10580 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
10581 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
10582 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10583 C the respective energy moment and not to the cluster cumulant.
10592 iti=itortyp(itype(i))
10593 itk=itortyp(itype(k))
10594 itk1=itortyp(itype(k+1))
10595 itl=itortyp(itype(l))
10596 itj=itortyp(itype(j))
10597 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10598 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
10599 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10604 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10606 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10610 derx_turn(lll,kkk,iii)=0.0d0
10617 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10619 cd write (2,*) 'eello6_5',eello6_5
10621 call transpose2(AEA(1,1,1),auxmat(1,1))
10622 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10623 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10624 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10626 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10627 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10628 s2 = scalar2(b1(1,k),vtemp1(1))
10630 call transpose2(AEA(1,1,2),atemp(1,1))
10631 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10632 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10633 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10635 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10636 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10637 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10639 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10640 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10641 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10642 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10643 ss13 = scalar2(b1(1,k),vtemp4(1))
10644 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10646 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10652 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10653 C Derivatives in gamma(i+2)
10657 call transpose2(AEA(1,1,1),auxmatd(1,1))
10658 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10659 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10660 call transpose2(AEAderg(1,1,2),atempd(1,1))
10661 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10662 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10664 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10665 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10666 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10672 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10673 C Derivatives in gamma(i+3)
10675 call transpose2(AEA(1,1,1),auxmatd(1,1))
10676 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10677 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10678 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10680 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10681 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10682 s2d = scalar2(b1(1,k),vtemp1d(1))
10684 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10685 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10687 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10689 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10690 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10691 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10699 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10700 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10702 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10703 & -0.5d0*ekont*(s2d+s12d)
10705 C Derivatives in gamma(i+4)
10706 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10707 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10708 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10710 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10711 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10712 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10720 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10722 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10724 C Derivatives in gamma(i+5)
10726 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10727 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10728 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10730 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10731 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10732 s2d = scalar2(b1(1,k),vtemp1d(1))
10734 call transpose2(AEA(1,1,2),atempd(1,1))
10735 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10736 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10738 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10739 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10741 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10742 ss13d = scalar2(b1(1,k),vtemp4d(1))
10743 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10751 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10752 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10754 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10755 & -0.5d0*ekont*(s2d+s12d)
10757 C Cartesian derivatives
10762 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10763 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10764 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10766 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10767 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10769 s2d = scalar2(b1(1,k),vtemp1d(1))
10771 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10772 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10773 s8d = -(atempd(1,1)+atempd(2,2))*
10774 & scalar2(cc(1,1,itl),vtemp2(1))
10776 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10778 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10779 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10786 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10787 & - 0.5d0*(s1d+s2d)
10789 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10793 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10794 & - 0.5d0*(s8d+s12d)
10796 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10805 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10806 & achuj_tempd(1,1))
10807 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10808 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10809 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10810 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10811 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10813 ss13d = scalar2(b1(1,k),vtemp4d(1))
10814 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10815 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10819 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10820 cd & 16*eel_turn6_num
10822 if (j.lt.nres-1) then
10829 if (l.lt.nres-1) then
10837 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10838 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10839 cgrad ghalf=0.5d0*ggg1(ll)
10841 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10842 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10843 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10844 & +ekont*derx_turn(ll,2,1)
10845 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10846 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10847 & +ekont*derx_turn(ll,4,1)
10848 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10849 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10850 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10851 cgrad ghalf=0.5d0*ggg2(ll)
10853 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10854 & +ekont*derx_turn(ll,2,2)
10855 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10856 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10857 & +ekont*derx_turn(ll,4,2)
10858 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10859 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10860 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10865 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10870 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10876 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10881 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10885 cd write (2,*) iii,g_corr6_loc(iii)
10887 eello_turn6=ekont*eel_turn6
10888 cd write (2,*) 'ekont',ekont
10889 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10893 C-----------------------------------------------------------------------------
10894 double precision function scalar(u,v)
10895 !DIR$ INLINEALWAYS scalar
10897 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10900 double precision u(3),v(3)
10901 cd double precision sc
10909 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10912 crc-------------------------------------------------
10913 SUBROUTINE MATVEC2(A1,V1,V2)
10914 !DIR$ INLINEALWAYS MATVEC2
10916 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10918 implicit real*8 (a-h,o-z)
10919 include 'DIMENSIONS'
10920 DIMENSION A1(2,2),V1(2),V2(2)
10924 c 3 VI=VI+A1(I,K)*V1(K)
10928 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10929 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10934 C---------------------------------------
10935 SUBROUTINE MATMAT2(A1,A2,A3)
10937 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10939 implicit real*8 (a-h,o-z)
10940 include 'DIMENSIONS'
10941 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10942 c DIMENSION AI3(2,2)
10946 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10952 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10953 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10954 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10955 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10963 c-------------------------------------------------------------------------
10964 double precision function scalar2(u,v)
10965 !DIR$ INLINEALWAYS scalar2
10967 double precision u(2),v(2)
10968 double precision sc
10970 scalar2=u(1)*v(1)+u(2)*v(2)
10974 C-----------------------------------------------------------------------------
10976 subroutine transpose2(a,at)
10977 !DIR$ INLINEALWAYS transpose2
10979 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10982 double precision a(2,2),at(2,2)
10989 c--------------------------------------------------------------------------
10990 subroutine transpose(n,a,at)
10993 double precision a(n,n),at(n,n)
11001 C---------------------------------------------------------------------------
11002 subroutine prodmat3(a1,a2,kk,transp,prod)
11003 !DIR$ INLINEALWAYS prodmat3
11005 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
11009 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
11011 crc double precision auxmat(2,2),prod_(2,2)
11014 crc call transpose2(kk(1,1),auxmat(1,1))
11015 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
11016 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11018 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
11019 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
11020 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
11021 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
11022 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
11023 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
11024 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
11025 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
11028 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
11029 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11031 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
11032 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
11033 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
11034 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
11035 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
11036 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
11037 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
11038 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
11041 c call transpose2(a2(1,1),a2t(1,1))
11044 crc print *,((prod_(i,j),i=1,2),j=1,2)
11045 crc print *,((prod(i,j),i=1,2),j=1,2)
11049 CCC----------------------------------------------
11050 subroutine Eliptransfer(eliptran)
11051 implicit real*8 (a-h,o-z)
11052 include 'DIMENSIONS'
11053 include 'COMMON.GEO'
11054 include 'COMMON.VAR'
11055 include 'COMMON.LOCAL'
11056 include 'COMMON.CHAIN'
11057 include 'COMMON.DERIV'
11058 include 'COMMON.NAMES'
11059 include 'COMMON.INTERACT'
11060 include 'COMMON.IOUNITS'
11061 include 'COMMON.CALC'
11062 include 'COMMON.CONTROL'
11063 include 'COMMON.SPLITELE'
11064 include 'COMMON.SBRIDGE'
11065 C this is done by Adasko
11066 C print *,"wchodze"
11067 C structure of box:
11069 C--bordliptop-- buffore starts
11070 C--bufliptop--- here true lipid starts
11072 C--buflipbot--- lipid ends buffore starts
11073 C--bordlipbot--buffore ends
11075 do i=ilip_start,ilip_end
11077 if (itype(i).eq.ntyp1) cycle
11079 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
11080 if (positi.le.0) positi=positi+boxzsize
11082 C first for peptide groups
11083 c for each residue check if it is in lipid or lipid water border area
11084 if ((positi.gt.bordlipbot)
11085 &.and.(positi.lt.bordliptop)) then
11086 C the energy transfer exist
11087 if (positi.lt.buflipbot) then
11088 C what fraction I am in
11090 & ((positi-bordlipbot)/lipbufthick)
11091 C lipbufthick is thickenes of lipid buffore
11092 sslip=sscalelip(fracinbuf)
11093 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11094 eliptran=eliptran+sslip*pepliptran
11095 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11096 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11097 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11099 C print *,"doing sccale for lower part"
11100 C print *,i,sslip,fracinbuf,ssgradlip
11101 elseif (positi.gt.bufliptop) then
11102 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
11103 sslip=sscalelip(fracinbuf)
11104 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11105 eliptran=eliptran+sslip*pepliptran
11106 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11107 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11108 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11109 C print *, "doing sscalefor top part"
11110 C print *,i,sslip,fracinbuf,ssgradlip
11112 eliptran=eliptran+pepliptran
11113 C print *,"I am in true lipid"
11116 C eliptran=elpitran+0.0 ! I am in water
11119 C print *, "nic nie bylo w lipidzie?"
11120 C now multiply all by the peptide group transfer factor
11121 C eliptran=eliptran*pepliptran
11122 C now the same for side chains
11124 do i=ilip_start,ilip_end
11125 if (itype(i).eq.ntyp1) cycle
11126 positi=(mod(c(3,i+nres),boxzsize))
11127 if (positi.le.0) positi=positi+boxzsize
11128 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
11129 c for each residue check if it is in lipid or lipid water border area
11130 C respos=mod(c(3,i+nres),boxzsize)
11131 C print *,positi,bordlipbot,buflipbot
11132 if ((positi.gt.bordlipbot)
11133 & .and.(positi.lt.bordliptop)) then
11134 C the energy transfer exist
11135 if (positi.lt.buflipbot) then
11137 & ((positi-bordlipbot)/lipbufthick)
11138 C lipbufthick is thickenes of lipid buffore
11139 sslip=sscalelip(fracinbuf)
11140 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11141 eliptran=eliptran+sslip*liptranene(itype(i))
11142 gliptranx(3,i)=gliptranx(3,i)
11143 &+ssgradlip*liptranene(itype(i))
11144 gliptranc(3,i-1)= gliptranc(3,i-1)
11145 &+ssgradlip*liptranene(itype(i))
11146 C print *,"doing sccale for lower part"
11147 elseif (positi.gt.bufliptop) then
11149 &((bordliptop-positi)/lipbufthick)
11150 sslip=sscalelip(fracinbuf)
11151 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11152 eliptran=eliptran+sslip*liptranene(itype(i))
11153 gliptranx(3,i)=gliptranx(3,i)
11154 &+ssgradlip*liptranene(itype(i))
11155 gliptranc(3,i-1)= gliptranc(3,i-1)
11156 &+ssgradlip*liptranene(itype(i))
11157 C print *, "doing sscalefor top part",sslip,fracinbuf
11159 eliptran=eliptran+liptranene(itype(i))
11160 C print *,"I am in true lipid"
11162 endif ! if in lipid or buffor
11164 C eliptran=elpitran+0.0 ! I am in water
11168 C---------------------------------------------------------
11169 C AFM soubroutine for constant force
11170 subroutine AFMforce(Eafmforce)
11171 implicit real*8 (a-h,o-z)
11172 include 'DIMENSIONS'
11173 include 'COMMON.GEO'
11174 include 'COMMON.VAR'
11175 include 'COMMON.LOCAL'
11176 include 'COMMON.CHAIN'
11177 include 'COMMON.DERIV'
11178 include 'COMMON.NAMES'
11179 include 'COMMON.INTERACT'
11180 include 'COMMON.IOUNITS'
11181 include 'COMMON.CALC'
11182 include 'COMMON.CONTROL'
11183 include 'COMMON.SPLITELE'
11184 include 'COMMON.SBRIDGE'
11189 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11190 dist=dist+diffafm(i)**2
11193 Eafmforce=-forceAFMconst*(dist-distafminit)
11195 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
11196 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
11198 C print *,'AFM',Eafmforce
11201 C---------------------------------------------------------
11202 C AFM subroutine with pseudoconstant velocity
11203 subroutine AFMvel(Eafmforce)
11204 implicit real*8 (a-h,o-z)
11205 include 'DIMENSIONS'
11206 include 'COMMON.GEO'
11207 include 'COMMON.VAR'
11208 include 'COMMON.LOCAL'
11209 include 'COMMON.CHAIN'
11210 include 'COMMON.DERIV'
11211 include 'COMMON.NAMES'
11212 include 'COMMON.INTERACT'
11213 include 'COMMON.IOUNITS'
11214 include 'COMMON.CALC'
11215 include 'COMMON.CONTROL'
11216 include 'COMMON.SPLITELE'
11217 include 'COMMON.SBRIDGE'
11219 C Only for check grad COMMENT if not used for checkgrad
11221 C--------------------------------------------------------
11222 C print *,"wchodze"
11226 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11227 dist=dist+diffafm(i)**2
11230 Eafmforce=0.5d0*forceAFMconst
11231 & *(distafminit+totTafm*velAFMconst-dist)**2
11232 C Eafmforce=-forceAFMconst*(dist-distafminit)
11234 gradafm(i,afmend-1)=-forceAFMconst*
11235 &(distafminit+totTafm*velAFMconst-dist)
11237 gradafm(i,afmbeg-1)=forceAFMconst*
11238 &(distafminit+totTafm*velAFMconst-dist)
11241 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
11244 C-----------------------------------------------------------
11245 C first for shielding is setting of function of side-chains
11246 subroutine set_shield_fac
11247 implicit real*8 (a-h,o-z)
11248 include 'DIMENSIONS'
11249 include 'COMMON.CHAIN'
11250 include 'COMMON.DERIV'
11251 include 'COMMON.IOUNITS'
11252 include 'COMMON.SHIELD'
11253 include 'COMMON.INTERACT'
11254 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11255 double precision div77_81/0.974996043d0/,
11256 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11258 C the vector between center of side_chain and peptide group
11259 double precision pep_side(3),long,side_calf(3),
11260 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11261 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11262 C the line belowe needs to be changed for FGPROC>1
11264 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11266 Cif there two consequtive dummy atoms there is no peptide group between them
11267 C the line below has to be changed for FGPROC>1
11270 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11274 C first lets set vector conecting the ithe side-chain with kth side-chain
11275 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11276 C pep_side(j)=2.0d0
11277 C and vector conecting the side-chain with its proper calfa
11278 side_calf(j)=c(j,k+nres)-c(j,k)
11279 C side_calf(j)=2.0d0
11280 pept_group(j)=c(j,i)-c(j,i+1)
11281 C lets have their lenght
11282 dist_pep_side=pep_side(j)**2+dist_pep_side
11283 dist_side_calf=dist_side_calf+side_calf(j)**2
11284 dist_pept_group=dist_pept_group+pept_group(j)**2
11286 dist_pep_side=dsqrt(dist_pep_side)
11287 dist_pept_group=dsqrt(dist_pept_group)
11288 dist_side_calf=dsqrt(dist_side_calf)
11290 pep_side_norm(j)=pep_side(j)/dist_pep_side
11291 side_calf_norm(j)=dist_side_calf
11293 C now sscale fraction
11294 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
11295 C print *,buff_shield,"buff"
11297 if (sh_frac_dist.le.0.0) cycle
11298 C If we reach here it means that this side chain reaches the shielding sphere
11299 C Lets add him to the list for gradient
11300 ishield_list(i)=ishield_list(i)+1
11301 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
11302 C this list is essential otherwise problem would be O3
11303 shield_list(ishield_list(i),i)=k
11304 C Lets have the sscale value
11305 if (sh_frac_dist.gt.1.0) then
11306 scale_fac_dist=1.0d0
11308 sh_frac_dist_grad(j)=0.0d0
11311 scale_fac_dist=-sh_frac_dist*sh_frac_dist
11312 & *(2.0*sh_frac_dist-3.0d0)
11313 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
11314 & /dist_pep_side/buff_shield*0.5
11315 C remember for the final gradient multiply sh_frac_dist_grad(j)
11316 C for side_chain by factor -2 !
11318 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
11319 C print *,"jestem",scale_fac_dist,fac_help_scale,
11320 C & sh_frac_dist_grad(j)
11323 C if ((i.eq.3).and.(k.eq.2)) then
11324 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
11328 C this is what is now we have the distance scaling now volume...
11329 short=short_r_sidechain(itype(k))
11330 long=long_r_sidechain(itype(k))
11331 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
11334 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
11335 C costhet_fac=0.0d0
11337 costhet_grad(j)=costhet_fac*pep_side(j)
11339 C remember for the final gradient multiply costhet_grad(j)
11340 C for side_chain by factor -2 !
11341 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
11342 C pep_side0pept_group is vector multiplication
11343 pep_side0pept_group=0.0
11345 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
11347 cosalfa=(pep_side0pept_group/
11348 & (dist_pep_side*dist_side_calf))
11349 fac_alfa_sin=1.0-cosalfa**2
11350 fac_alfa_sin=dsqrt(fac_alfa_sin)
11351 rkprim=fac_alfa_sin*(long-short)+short
11353 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
11354 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
11357 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
11358 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11359 &*(long-short)/fac_alfa_sin*cosalfa/
11360 &((dist_pep_side*dist_side_calf))*
11361 &((side_calf(j))-cosalfa*
11362 &((pep_side(j)/dist_pep_side)*dist_side_calf))
11364 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11365 &*(long-short)/fac_alfa_sin*cosalfa
11366 &/((dist_pep_side*dist_side_calf))*
11368 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
11371 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
11373 C now the gradient...
11374 C grad_shield is gradient of Calfa for peptide groups
11375 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
11377 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
11378 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
11380 grad_shield(j,i)=grad_shield(j,i)
11381 C gradient po skalowaniu
11382 & +(sh_frac_dist_grad(j)
11383 C gradient po costhet
11384 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
11385 &-scale_fac_dist*(cosphi_grad_long(j))
11386 &/(1.0-cosphi) )*div77_81
11388 C grad_shield_side is Cbeta sidechain gradient
11389 grad_shield_side(j,ishield_list(i),i)=
11390 & (sh_frac_dist_grad(j)*-2.0d0
11391 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
11392 & +scale_fac_dist*(cosphi_grad_long(j))
11393 & *2.0d0/(1.0-cosphi))
11394 & *div77_81*VofOverlap
11396 grad_shield_loc(j,ishield_list(i),i)=
11397 & scale_fac_dist*cosphi_grad_loc(j)
11398 & *2.0d0/(1.0-cosphi)
11399 & *div77_81*VofOverlap
11401 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
11403 fac_shield(i)=VolumeTotal*div77_81+div4_81
11404 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
11408 C--------------------------------------------------------------------------
11409 double precision function tschebyshev(m,n,x,y)
11411 include "DIMENSIONS"
11413 double precision x(n),y,yy(0:maxvar),aux
11414 c Tschebyshev polynomial. Note that the first term is omitted
11415 c m=0: the constant term is included
11416 c m=1: the constant term is not included
11420 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
11429 C--------------------------------------------------------------------------
11430 double precision function gradtschebyshev(m,n,x,y)
11432 include "DIMENSIONS"
11434 double precision x(n+1),y,yy(0:maxvar),aux
11435 c Tschebyshev polynomial. Note that the first term is omitted
11436 c m=0: the constant term is included
11437 c m=1: the constant term is not included
11441 yy(i)=2*y*yy(i-1)-yy(i-2)
11445 aux=aux+x(i+1)*yy(i)*(i+1)
11446 C print *, x(i+1),yy(i),i
11448 gradtschebyshev=aux