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.eq.1) then
147 else if (shield_mode.eq.2) then
150 c print *,"Processor",myrank," left VEC_AND_DERIV"
153 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
154 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
155 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
156 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
158 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
159 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
160 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
161 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
163 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
172 write (iout,*) "Soft-spheer ELEC potential"
173 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
176 c print *,"Processor",myrank," computed UELEC"
178 C Calculate excluded-volume interaction energy between peptide groups
183 call escp(evdw2,evdw2_14)
189 c write (iout,*) "Soft-sphere SCP potential"
190 call escp_soft_sphere(evdw2,evdw2_14)
193 c Calculate the bond-stretching energy
197 C Calculate the disulfide-bridge and other energy and the contributions
198 C from other distance constraints.
199 cd print *,'Calling EHPB'
201 cd print *,'EHPB exitted succesfully.'
203 C Calculate the virtual-bond-angle energy.
205 if (wang.gt.0d0) then
206 if ((tor_mode.eq.0).or.(tor_mode.eq.2)) then
207 call ebend(ebe,ethetacnstr)
209 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
211 if ((tor_mode.eq.1).or.(tor_mode.eq.2)) then
212 call ebend_kcc(ebe,ethetacnstr)
218 c print *,"Processor",myrank," computed UB"
220 C Calculate the SC local energy.
222 C print *,"TU DOCHODZE?"
224 c print *,"Processor",myrank," computed USC"
226 C Calculate the virtual-bond torsional energy.
228 cd print *,'nterm=',nterm
229 C print *,"tor",tor_mode
231 if ((tor_mode.eq.0).or.(tor_mode.eq.2)) then
232 call etor(etors,edihcnstr)
234 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
236 if ((tor_mode.eq.1).or.(tor_mode.eq.2)) then
237 call etor_kcc(etors,edihcnstr)
243 c print *,"Processor",myrank," computed Utor"
245 C 6/23/01 Calculate double-torsional energy
247 if ((wtor_d.gt.0).and.((tor_mode.eq.0).or.(tor_mode.eq.2))) then
252 c print *,"Processor",myrank," computed Utord"
254 C 21/5/07 Calculate local sicdechain correlation energy
256 if (wsccor.gt.0.0d0) then
257 call eback_sc_corr(esccor)
261 C print *,"PRZED MULIt"
262 c print *,"Processor",myrank," computed Usccorr"
264 C 12/1/95 Multi-body terms
268 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
269 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
270 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
271 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
272 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
279 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
280 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
281 cd write (iout,*) "multibody_hb ecorr",ecorr
283 c print *,"Processor",myrank," computed Ucorr"
285 C If performing constraint dynamics, call the constraint energy
286 C after the equilibration time
287 if(usampl.and.totT.gt.eq_time) then
294 C 01/27/2015 added by adasko
295 C the energy component below is energy transfer into lipid environment
296 C based on partition function
297 C print *,"przed lipidami"
298 if (wliptran.gt.0) then
299 call Eliptransfer(eliptran)
301 C print *,"za lipidami"
302 if (AFMlog.gt.0) then
303 call AFMforce(Eafmforce)
304 else if (selfguide.gt.0) then
305 call AFMvel(Eafmforce)
308 time_enecalc=time_enecalc+MPI_Wtime()-time00
310 c print *,"Processor",myrank," computed Uconstr"
319 energia(2)=evdw2-evdw2_14
336 energia(8)=eello_turn3
337 energia(9)=eello_turn4
344 energia(19)=edihcnstr
346 energia(20)=Uconst+Uconst_back
349 energia(23)=Eafmforce
350 energia(24)=ethetacnstr
351 c Here are the energies showed per procesor if the are more processors
352 c per molecule then we sum it up in sum_energy subroutine
353 c print *," Processor",myrank," calls SUM_ENERGY"
354 call sum_energy(energia,.true.)
355 if (dyn_ss) call dyn_set_nss
356 c print *," Processor",myrank," left SUM_ENERGY"
358 time_sumene=time_sumene+MPI_Wtime()-time00
362 c-------------------------------------------------------------------------------
363 subroutine sum_energy(energia,reduce)
364 implicit real*8 (a-h,o-z)
369 cMS$ATTRIBUTES C :: proc_proc
375 include 'COMMON.SETUP'
376 include 'COMMON.IOUNITS'
377 double precision energia(0:n_ene),enebuff(0:n_ene+1)
378 include 'COMMON.FFIELD'
379 include 'COMMON.DERIV'
380 include 'COMMON.INTERACT'
381 include 'COMMON.SBRIDGE'
382 include 'COMMON.CHAIN'
384 include 'COMMON.CONTROL'
385 include 'COMMON.TIME1'
388 if (nfgtasks.gt.1 .and. reduce) then
390 write (iout,*) "energies before REDUCE"
391 call enerprint(energia)
395 enebuff(i)=energia(i)
398 call MPI_Barrier(FG_COMM,IERR)
399 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
401 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
402 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
404 write (iout,*) "energies after REDUCE"
405 call enerprint(energia)
408 time_Reduce=time_Reduce+MPI_Wtime()-time00
410 if (fg_rank.eq.0) then
414 evdw2=energia(2)+energia(18)
430 eello_turn3=energia(8)
431 eello_turn4=energia(9)
438 edihcnstr=energia(19)
443 Eafmforce=energia(23)
444 ethetacnstr=energia(24)
446 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
447 & +wang*ebe+wtor*etors+wscloc*escloc
448 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
449 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
450 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
451 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+Eafmforce
454 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
455 & +wang*ebe+wtor*etors+wscloc*escloc
456 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
457 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
458 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
459 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
467 if (isnan(etot).ne.0) energia(0)=1.0d+99
469 if (isnan(etot)) energia(0)=1.0d+99
474 idumm=proc_proc(etot,i)
476 call proc_proc(etot,i)
478 if(i.eq.1)energia(0)=1.0d+99
485 c-------------------------------------------------------------------------------
486 subroutine sum_gradient
487 implicit real*8 (a-h,o-z)
492 cMS$ATTRIBUTES C :: proc_proc
498 double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
499 & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
500 & ,gloc_scbuf(3,-1:maxres)
501 include 'COMMON.SETUP'
502 include 'COMMON.IOUNITS'
503 include 'COMMON.FFIELD'
504 include 'COMMON.DERIV'
505 include 'COMMON.INTERACT'
506 include 'COMMON.SBRIDGE'
507 include 'COMMON.CHAIN'
509 include 'COMMON.CONTROL'
510 include 'COMMON.TIME1'
511 include 'COMMON.MAXGRAD'
512 include 'COMMON.SCCOR'
517 write (iout,*) "sum_gradient gvdwc, gvdwx"
519 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
520 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
525 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
526 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
527 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
530 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
531 C in virtual-bond-vector coordinates
534 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
536 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
537 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
539 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
541 c write (iout,'(i5,3f10.5,2x,f10.5)')
542 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
544 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
546 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
547 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
555 gradbufc(j,i)=wsc*gvdwc(j,i)+
556 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
557 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
558 & wel_loc*gel_loc_long(j,i)+
559 & wcorr*gradcorr_long(j,i)+
560 & wcorr5*gradcorr5_long(j,i)+
561 & wcorr6*gradcorr6_long(j,i)+
562 & wturn6*gcorr6_turn_long(j,i)+
564 & +wliptran*gliptranc(j,i)
566 & +welec*gshieldc(j,i)
567 & +wcorr*gshieldc_ec(j,i)
568 & +wturn3*gshieldc_t3(j,i)
569 & +wturn4*gshieldc_t4(j,i)
570 & +wel_loc*gshieldc_ll(j,i)
578 gradbufc(j,i)=wsc*gvdwc(j,i)+
579 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
580 & welec*gelc_long(j,i)+
582 & wel_loc*gel_loc_long(j,i)+
583 & wcorr*gradcorr_long(j,i)+
584 & wcorr5*gradcorr5_long(j,i)+
585 & wcorr6*gradcorr6_long(j,i)+
586 & wturn6*gcorr6_turn_long(j,i)+
588 & +wliptran*gliptranc(j,i)
590 & +welec*gshieldc(j,i)
591 & +wcorr*gshieldc_ec(j,i)
592 & +wturn4*gshieldc_t4(j,i)
593 & +wel_loc*gshieldc_ll(j,i)
600 if (nfgtasks.gt.1) then
603 write (iout,*) "gradbufc before allreduce"
605 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
611 gradbufc_sum(j,i)=gradbufc(j,i)
614 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
615 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
616 c time_reduce=time_reduce+MPI_Wtime()-time00
618 c write (iout,*) "gradbufc_sum after allreduce"
620 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
625 c time_allreduce=time_allreduce+MPI_Wtime()-time00
633 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
634 write (iout,*) (i," jgrad_start",jgrad_start(i),
635 & " jgrad_end ",jgrad_end(i),
636 & i=igrad_start,igrad_end)
639 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
640 c do not parallelize this part.
642 c do i=igrad_start,igrad_end
643 c do j=jgrad_start(i),jgrad_end(i)
645 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
650 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
654 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
658 write (iout,*) "gradbufc after summing"
660 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
667 write (iout,*) "gradbufc"
669 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
675 gradbufc_sum(j,i)=gradbufc(j,i)
680 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
684 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
689 c gradbufc(k,i)=0.0d0
693 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
698 write (iout,*) "gradbufc after summing"
700 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
708 gradbufc(k,nres)=0.0d0
713 C print *,gradbufc(1,13)
714 C print *,welec*gelc(1,13)
715 C print *,wel_loc*gel_loc(1,13)
716 C print *,0.5d0*(wscp*gvdwc_scpp(1,13))
717 C print *,welec*gelc_long(1,13)+wvdwpp*gvdwpp(1,13)
718 C print *,wel_loc*gel_loc_long(1,13)
719 C print *,gradafm(1,13),"AFM"
720 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
721 & wel_loc*gel_loc(j,i)+
722 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
723 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
724 & wel_loc*gel_loc_long(j,i)+
725 & wcorr*gradcorr_long(j,i)+
726 & wcorr5*gradcorr5_long(j,i)+
727 & wcorr6*gradcorr6_long(j,i)+
728 & wturn6*gcorr6_turn_long(j,i))+
730 & wcorr*gradcorr(j,i)+
731 & wturn3*gcorr3_turn(j,i)+
732 & wturn4*gcorr4_turn(j,i)+
733 & wcorr5*gradcorr5(j,i)+
734 & wcorr6*gradcorr6(j,i)+
735 & wturn6*gcorr6_turn(j,i)+
736 & wsccor*gsccorc(j,i)
737 & +wscloc*gscloc(j,i)
738 & +wliptran*gliptranc(j,i)
740 & +welec*gshieldc(j,i)
741 & +welec*gshieldc_loc(j,i)
742 & +wcorr*gshieldc_ec(j,i)
743 & +wcorr*gshieldc_loc_ec(j,i)
744 & +wturn3*gshieldc_t3(j,i)
745 & +wturn3*gshieldc_loc_t3(j,i)
746 & +wturn4*gshieldc_t4(j,i)
747 & +wturn4*gshieldc_loc_t4(j,i)
748 & +wel_loc*gshieldc_ll(j,i)
749 & +wel_loc*gshieldc_loc_ll(j,i)
757 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
758 & wel_loc*gel_loc(j,i)+
759 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
760 & welec*gelc_long(j,i)+
761 & wel_loc*gel_loc_long(j,i)+
762 & wcorr*gcorr_long(j,i)+
763 & wcorr5*gradcorr5_long(j,i)+
764 & wcorr6*gradcorr6_long(j,i)+
765 & wturn6*gcorr6_turn_long(j,i))+
767 & wcorr*gradcorr(j,i)+
768 & wturn3*gcorr3_turn(j,i)+
769 & wturn4*gcorr4_turn(j,i)+
770 & wcorr5*gradcorr5(j,i)+
771 & wcorr6*gradcorr6(j,i)+
772 & wturn6*gcorr6_turn(j,i)+
773 & wsccor*gsccorc(j,i)
774 & +wscloc*gscloc(j,i)
775 & +wliptran*gliptranc(j,i)
777 & +welec*gshieldc(j,i)
778 & +welec*gshieldc_loc(j,i)
779 & +wcorr*gshieldc_ec(j,i)
780 & +wcorr*gshieldc_loc_ec(j,i)
781 & +wturn3*gshieldc_t3(j,i)
782 & +wturn3*gshieldc_loc_t3(j,i)
783 & +wturn4*gshieldc_t4(j,i)
784 & +wturn4*gshieldc_loc_t4(j,i)
785 & +wel_loc*gshieldc_ll(j,i)
786 & +wel_loc*gshieldc_loc_ll(j,i)
793 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
795 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
796 & wsccor*gsccorx(j,i)
797 & +wscloc*gsclocx(j,i)
798 & +wliptran*gliptranx(j,i)
799 & +welec*gshieldx(j,i)
800 & +wcorr*gshieldx_ec(j,i)
801 & +wturn3*gshieldx_t3(j,i)
802 & +wturn4*gshieldx_t4(j,i)
803 & +wel_loc*gshieldx_ll(j,i)
810 write (iout,*) "gloc before adding corr"
812 write (iout,*) i,gloc(i,icg)
816 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
817 & +wcorr5*g_corr5_loc(i)
818 & +wcorr6*g_corr6_loc(i)
819 & +wturn4*gel_loc_turn4(i)
820 & +wturn3*gel_loc_turn3(i)
821 & +wturn6*gel_loc_turn6(i)
822 & +wel_loc*gel_loc_loc(i)
825 write (iout,*) "gloc after adding corr"
827 write (iout,*) i,gloc(i,icg)
831 if (nfgtasks.gt.1) then
834 gradbufc(j,i)=gradc(j,i,icg)
835 gradbufx(j,i)=gradx(j,i,icg)
839 glocbuf(i)=gloc(i,icg)
843 write (iout,*) "gloc_sc before reduce"
846 write (iout,*) i,j,gloc_sc(j,i,icg)
853 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
857 call MPI_Barrier(FG_COMM,IERR)
858 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
860 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
861 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
862 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
863 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
864 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
865 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
866 time_reduce=time_reduce+MPI_Wtime()-time00
867 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
868 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
869 time_reduce=time_reduce+MPI_Wtime()-time00
872 write (iout,*) "gloc_sc after reduce"
875 write (iout,*) i,j,gloc_sc(j,i,icg)
881 write (iout,*) "gloc after reduce"
883 write (iout,*) i,gloc(i,icg)
888 if (gnorm_check) then
890 c Compute the maximum elements of the gradient
900 gcorr3_turn_max=0.0d0
901 gcorr4_turn_max=0.0d0
904 gcorr6_turn_max=0.0d0
914 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
915 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
916 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
917 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
918 & gvdwc_scp_max=gvdwc_scp_norm
919 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
920 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
921 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
922 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
923 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
924 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
925 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
926 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
927 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
928 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
929 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
930 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
931 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
933 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
934 & gcorr3_turn_max=gcorr3_turn_norm
935 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
937 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
938 & gcorr4_turn_max=gcorr4_turn_norm
939 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
940 if (gradcorr5_norm.gt.gradcorr5_max)
941 & gradcorr5_max=gradcorr5_norm
942 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
943 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
944 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
946 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
947 & gcorr6_turn_max=gcorr6_turn_norm
948 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
949 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
950 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
951 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
952 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
953 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
954 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
955 if (gradx_scp_norm.gt.gradx_scp_max)
956 & gradx_scp_max=gradx_scp_norm
957 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
958 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
959 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
960 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
961 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
962 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
963 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
964 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
968 open(istat,file=statname,position="append")
970 open(istat,file=statname,access="append")
972 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
973 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
974 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
975 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
976 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
977 & gsccorx_max,gsclocx_max
979 if (gvdwc_max.gt.1.0d4) then
980 write (iout,*) "gvdwc gvdwx gradb gradbx"
982 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
983 & gradb(j,i),gradbx(j,i),j=1,3)
985 call pdbout(0.0d0,'cipiszcze',iout)
991 write (iout,*) "gradc gradx gloc"
993 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
994 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
998 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
1002 c-------------------------------------------------------------------------------
1003 subroutine rescale_weights(t_bath)
1004 implicit real*8 (a-h,o-z)
1005 include 'DIMENSIONS'
1006 include 'COMMON.IOUNITS'
1007 include 'COMMON.FFIELD'
1008 include 'COMMON.SBRIDGE'
1009 include 'COMMON.CONTROL'
1010 double precision kfac /2.4d0/
1011 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
1013 c facT=2*temp0/(t_bath+temp0)
1014 if (rescale_mode.eq.0) then
1020 else if (rescale_mode.eq.1) then
1021 facT=kfac/(kfac-1.0d0+t_bath/temp0)
1022 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1023 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1024 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1025 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1026 else if (rescale_mode.eq.2) then
1032 facT=licznik/dlog(dexp(x)+dexp(-x))
1033 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
1034 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
1035 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
1036 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
1038 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1039 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1041 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1045 if (shield_mode.gt.0) then
1046 wscp=weights(2)*fact
1048 wvdwpp=weights(16)*fact
1050 welec=weights(3)*fact
1051 wcorr=weights(4)*fact3
1052 wcorr5=weights(5)*fact4
1053 wcorr6=weights(6)*fact5
1054 wel_loc=weights(7)*fact2
1055 wturn3=weights(8)*fact2
1056 wturn4=weights(9)*fact3
1057 wturn6=weights(10)*fact5
1058 wtor=weights(13)*fact
1059 wtor_d=weights(14)*fact2
1060 wsccor=weights(21)*fact
1064 C------------------------------------------------------------------------
1065 subroutine enerprint(energia)
1066 implicit real*8 (a-h,o-z)
1067 include 'DIMENSIONS'
1068 include 'COMMON.IOUNITS'
1069 include 'COMMON.FFIELD'
1070 include 'COMMON.SBRIDGE'
1072 double precision energia(0:n_ene)
1077 evdw2=energia(2)+energia(18)
1089 eello_turn3=energia(8)
1090 eello_turn4=energia(9)
1091 eello_turn6=energia(10)
1097 edihcnstr=energia(19)
1101 eliptran=energia(22)
1102 Eafmforce=energia(23)
1103 ethetacnstr=energia(24)
1105 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1106 & estr,wbond,ebe,wang,
1107 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1109 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1110 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,
1111 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1113 10 format (/'Virtual-chain energies:'//
1114 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1115 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1116 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1117 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1118 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1119 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1120 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1121 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1122 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1123 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1124 & ' (SS bridges & dist. cnstr.)'/
1125 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1126 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1127 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1128 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1129 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1130 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1131 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1132 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1133 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1134 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1135 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1136 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1137 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1138 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1139 & 'ETOT= ',1pE16.6,' (total)')
1142 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1143 & estr,wbond,ebe,wang,
1144 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1146 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1147 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1148 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1150 10 format (/'Virtual-chain energies:'//
1151 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1152 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1153 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1154 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1155 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1156 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1157 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1158 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1159 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1160 & ' (SS bridges & dist. cnstr.)'/
1161 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1162 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1163 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1164 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1165 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1166 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1167 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1168 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1169 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1170 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1171 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1172 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1173 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1174 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1175 & 'ETOT= ',1pE16.6,' (total)')
1179 C-----------------------------------------------------------------------
1180 subroutine elj(evdw)
1182 C This subroutine calculates the interaction energy of nonbonded side chains
1183 C assuming the LJ potential of interaction.
1185 implicit real*8 (a-h,o-z)
1186 include 'DIMENSIONS'
1187 parameter (accur=1.0d-10)
1188 include 'COMMON.GEO'
1189 include 'COMMON.VAR'
1190 include 'COMMON.LOCAL'
1191 include 'COMMON.CHAIN'
1192 include 'COMMON.DERIV'
1193 include 'COMMON.INTERACT'
1194 include 'COMMON.TORSION'
1195 include 'COMMON.SBRIDGE'
1196 include 'COMMON.NAMES'
1197 include 'COMMON.IOUNITS'
1198 include 'COMMON.CONTACTS'
1200 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1202 do i=iatsc_s,iatsc_e
1203 itypi=iabs(itype(i))
1204 if (itypi.eq.ntyp1) cycle
1205 itypi1=iabs(itype(i+1))
1212 C Calculate SC interaction energy.
1214 do iint=1,nint_gr(i)
1215 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1216 cd & 'iend=',iend(i,iint)
1217 do j=istart(i,iint),iend(i,iint)
1218 itypj=iabs(itype(j))
1219 if (itypj.eq.ntyp1) cycle
1223 C Change 12/1/95 to calculate four-body interactions
1224 rij=xj*xj+yj*yj+zj*zj
1226 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1227 eps0ij=eps(itypi,itypj)
1229 C have you changed here?
1233 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1234 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1235 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1236 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1237 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1238 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1241 C Calculate the components of the gradient in DC and X
1243 fac=-rrij*(e1+evdwij)
1248 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1249 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1250 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1251 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1255 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1259 C 12/1/95, revised on 5/20/97
1261 C Calculate the contact function. The ith column of the array JCONT will
1262 C contain the numbers of atoms that make contacts with the atom I (of numbers
1263 C greater than I). The arrays FACONT and GACONT will contain the values of
1264 C the contact function and its derivative.
1266 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1267 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1268 C Uncomment next line, if the correlation interactions are contact function only
1269 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1271 sigij=sigma(itypi,itypj)
1272 r0ij=rs0(itypi,itypj)
1274 C Check whether the SC's are not too far to make a contact.
1277 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1278 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1280 if (fcont.gt.0.0D0) then
1281 C If the SC-SC distance if close to sigma, apply spline.
1282 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1283 cAdam & fcont1,fprimcont1)
1284 cAdam fcont1=1.0d0-fcont1
1285 cAdam if (fcont1.gt.0.0d0) then
1286 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1287 cAdam fcont=fcont*fcont1
1289 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1290 cga eps0ij=1.0d0/dsqrt(eps0ij)
1292 cga gg(k)=gg(k)*eps0ij
1294 cga eps0ij=-evdwij*eps0ij
1295 C Uncomment for AL's type of SC correlation interactions.
1296 cadam eps0ij=-evdwij
1297 num_conti=num_conti+1
1298 jcont(num_conti,i)=j
1299 facont(num_conti,i)=fcont*eps0ij
1300 fprimcont=eps0ij*fprimcont/rij
1302 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1303 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1304 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1305 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1306 gacont(1,num_conti,i)=-fprimcont*xj
1307 gacont(2,num_conti,i)=-fprimcont*yj
1308 gacont(3,num_conti,i)=-fprimcont*zj
1309 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1310 cd write (iout,'(2i3,3f10.5)')
1311 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1317 num_cont(i)=num_conti
1321 gvdwc(j,i)=expon*gvdwc(j,i)
1322 gvdwx(j,i)=expon*gvdwx(j,i)
1325 C******************************************************************************
1329 C To save time, the factor of EXPON has been extracted from ALL components
1330 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1333 C******************************************************************************
1336 C-----------------------------------------------------------------------------
1337 subroutine eljk(evdw)
1339 C This subroutine calculates the interaction energy of nonbonded side chains
1340 C assuming the LJK potential of interaction.
1342 implicit real*8 (a-h,o-z)
1343 include 'DIMENSIONS'
1344 include 'COMMON.GEO'
1345 include 'COMMON.VAR'
1346 include 'COMMON.LOCAL'
1347 include 'COMMON.CHAIN'
1348 include 'COMMON.DERIV'
1349 include 'COMMON.INTERACT'
1350 include 'COMMON.IOUNITS'
1351 include 'COMMON.NAMES'
1354 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1356 do i=iatsc_s,iatsc_e
1357 itypi=iabs(itype(i))
1358 if (itypi.eq.ntyp1) cycle
1359 itypi1=iabs(itype(i+1))
1364 C Calculate SC interaction energy.
1366 do iint=1,nint_gr(i)
1367 do j=istart(i,iint),iend(i,iint)
1368 itypj=iabs(itype(j))
1369 if (itypj.eq.ntyp1) cycle
1373 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1374 fac_augm=rrij**expon
1375 e_augm=augm(itypi,itypj)*fac_augm
1376 r_inv_ij=dsqrt(rrij)
1378 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1379 fac=r_shift_inv**expon
1380 C have you changed here?
1384 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1385 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1386 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1387 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1388 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1389 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1390 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1393 C Calculate the components of the gradient in DC and X
1395 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1400 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1401 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1402 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1403 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1407 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1415 gvdwc(j,i)=expon*gvdwc(j,i)
1416 gvdwx(j,i)=expon*gvdwx(j,i)
1421 C-----------------------------------------------------------------------------
1422 subroutine ebp(evdw)
1424 C This subroutine calculates the interaction energy of nonbonded side chains
1425 C assuming the Berne-Pechukas potential of interaction.
1427 implicit real*8 (a-h,o-z)
1428 include 'DIMENSIONS'
1429 include 'COMMON.GEO'
1430 include 'COMMON.VAR'
1431 include 'COMMON.LOCAL'
1432 include 'COMMON.CHAIN'
1433 include 'COMMON.DERIV'
1434 include 'COMMON.NAMES'
1435 include 'COMMON.INTERACT'
1436 include 'COMMON.IOUNITS'
1437 include 'COMMON.CALC'
1438 common /srutu/ icall
1439 c double precision rrsave(maxdim)
1442 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1444 c if (icall.eq.0) then
1450 do i=iatsc_s,iatsc_e
1451 itypi=iabs(itype(i))
1452 if (itypi.eq.ntyp1) cycle
1453 itypi1=iabs(itype(i+1))
1457 dxi=dc_norm(1,nres+i)
1458 dyi=dc_norm(2,nres+i)
1459 dzi=dc_norm(3,nres+i)
1460 c dsci_inv=dsc_inv(itypi)
1461 dsci_inv=vbld_inv(i+nres)
1463 C Calculate SC interaction energy.
1465 do iint=1,nint_gr(i)
1466 do j=istart(i,iint),iend(i,iint)
1468 itypj=iabs(itype(j))
1469 if (itypj.eq.ntyp1) cycle
1470 c dscj_inv=dsc_inv(itypj)
1471 dscj_inv=vbld_inv(j+nres)
1472 chi1=chi(itypi,itypj)
1473 chi2=chi(itypj,itypi)
1480 alf12=0.5D0*(alf1+alf2)
1481 C For diagnostics only!!!
1494 dxj=dc_norm(1,nres+j)
1495 dyj=dc_norm(2,nres+j)
1496 dzj=dc_norm(3,nres+j)
1497 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1498 cd if (icall.eq.0) then
1504 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1506 C Calculate whole angle-dependent part of epsilon and contributions
1507 C to its derivatives
1508 C have you changed here?
1509 fac=(rrij*sigsq)**expon2
1512 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1513 eps2der=evdwij*eps3rt
1514 eps3der=evdwij*eps2rt
1515 evdwij=evdwij*eps2rt*eps3rt
1518 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1520 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1521 cd & restyp(itypi),i,restyp(itypj),j,
1522 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1523 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1524 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1527 C Calculate gradient components.
1528 e1=e1*eps1*eps2rt**2*eps3rt**2
1529 fac=-expon*(e1+evdwij)
1532 C Calculate radial part of the gradient
1536 C Calculate the angular part of the gradient and sum add the contributions
1537 C to the appropriate components of the Cartesian gradient.
1545 C-----------------------------------------------------------------------------
1546 subroutine egb(evdw)
1548 C This subroutine calculates the interaction energy of nonbonded side chains
1549 C assuming the Gay-Berne potential of interaction.
1551 implicit real*8 (a-h,o-z)
1552 include 'DIMENSIONS'
1553 include 'COMMON.GEO'
1554 include 'COMMON.VAR'
1555 include 'COMMON.LOCAL'
1556 include 'COMMON.CHAIN'
1557 include 'COMMON.DERIV'
1558 include 'COMMON.NAMES'
1559 include 'COMMON.INTERACT'
1560 include 'COMMON.IOUNITS'
1561 include 'COMMON.CALC'
1562 include 'COMMON.CONTROL'
1563 include 'COMMON.SPLITELE'
1564 include 'COMMON.SBRIDGE'
1566 integer xshift,yshift,zshift
1569 ccccc energy_dec=.false.
1570 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1573 c if (icall.eq.0) lprn=.false.
1575 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1576 C we have the original box)
1580 do i=iatsc_s,iatsc_e
1581 itypi=iabs(itype(i))
1582 if (itypi.eq.ntyp1) cycle
1583 itypi1=iabs(itype(i+1))
1587 C Return atom into box, boxxsize is size of box in x dimension
1589 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1590 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1591 C Condition for being inside the proper box
1592 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1593 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1597 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1598 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1599 C Condition for being inside the proper box
1600 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1601 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1605 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1606 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1607 C Condition for being inside the proper box
1608 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1609 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1613 if (xi.lt.0) xi=xi+boxxsize
1615 if (yi.lt.0) yi=yi+boxysize
1617 if (zi.lt.0) zi=zi+boxzsize
1618 C define scaling factor for lipids
1620 C if (positi.le.0) positi=positi+boxzsize
1622 C first for peptide groups
1623 c for each residue check if it is in lipid or lipid water border area
1624 if ((zi.gt.bordlipbot)
1625 &.and.(zi.lt.bordliptop)) then
1626 C the energy transfer exist
1627 if (zi.lt.buflipbot) then
1628 C what fraction I am in
1630 & ((zi-bordlipbot)/lipbufthick)
1631 C lipbufthick is thickenes of lipid buffore
1632 sslipi=sscalelip(fracinbuf)
1633 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1634 elseif (zi.gt.bufliptop) then
1635 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1636 sslipi=sscalelip(fracinbuf)
1637 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1647 C xi=xi+xshift*boxxsize
1648 C yi=yi+yshift*boxysize
1649 C zi=zi+zshift*boxzsize
1651 dxi=dc_norm(1,nres+i)
1652 dyi=dc_norm(2,nres+i)
1653 dzi=dc_norm(3,nres+i)
1654 c dsci_inv=dsc_inv(itypi)
1655 dsci_inv=vbld_inv(i+nres)
1656 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1657 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1659 C Calculate SC interaction energy.
1661 do iint=1,nint_gr(i)
1662 do j=istart(i,iint),iend(i,iint)
1663 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1665 c write(iout,*) "PRZED ZWYKLE", evdwij
1666 call dyn_ssbond_ene(i,j,evdwij)
1667 c write(iout,*) "PO ZWYKLE", evdwij
1670 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1671 & 'evdw',i,j,evdwij,' ss'
1672 C triple bond artifac removal
1673 do k=j+1,iend(i,iint)
1674 C search over all next residues
1675 if (dyn_ss_mask(k)) then
1676 C check if they are cysteins
1677 C write(iout,*) 'k=',k
1679 c write(iout,*) "PRZED TRI", evdwij
1680 evdwij_przed_tri=evdwij
1681 call triple_ssbond_ene(i,j,k,evdwij)
1682 c if(evdwij_przed_tri.ne.evdwij) then
1683 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1686 c write(iout,*) "PO TRI", evdwij
1687 C call the energy function that removes the artifical triple disulfide
1688 C bond the soubroutine is located in ssMD.F
1690 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1691 & 'evdw',i,j,evdwij,'tss'
1692 endif!dyn_ss_mask(k)
1696 itypj=iabs(itype(j))
1697 if (itypj.eq.ntyp1) cycle
1698 c dscj_inv=dsc_inv(itypj)
1699 dscj_inv=vbld_inv(j+nres)
1700 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1701 c & 1.0d0/vbld(j+nres)
1702 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1703 sig0ij=sigma(itypi,itypj)
1704 chi1=chi(itypi,itypj)
1705 chi2=chi(itypj,itypi)
1712 alf12=0.5D0*(alf1+alf2)
1713 C For diagnostics only!!!
1726 C Return atom J into box the original box
1728 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1729 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1730 C Condition for being inside the proper box
1731 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1732 c & (xj.lt.((-0.5d0)*boxxsize))) then
1736 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1737 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1738 C Condition for being inside the proper box
1739 c if ((yj.gt.((0.5d0)*boxysize)).or.
1740 c & (yj.lt.((-0.5d0)*boxysize))) then
1744 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1745 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1746 C Condition for being inside the proper box
1747 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1748 c & (zj.lt.((-0.5d0)*boxzsize))) then
1752 if (xj.lt.0) xj=xj+boxxsize
1754 if (yj.lt.0) yj=yj+boxysize
1756 if (zj.lt.0) zj=zj+boxzsize
1757 if ((zj.gt.bordlipbot)
1758 &.and.(zj.lt.bordliptop)) then
1759 C the energy transfer exist
1760 if (zj.lt.buflipbot) then
1761 C what fraction I am in
1763 & ((zj-bordlipbot)/lipbufthick)
1764 C lipbufthick is thickenes of lipid buffore
1765 sslipj=sscalelip(fracinbuf)
1766 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1767 elseif (zj.gt.bufliptop) then
1768 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1769 sslipj=sscalelip(fracinbuf)
1770 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1779 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1780 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1781 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1782 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1783 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1784 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1785 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1786 C print *,sslipi,sslipj,bordlipbot,zi,zj
1787 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1795 xj=xj_safe+xshift*boxxsize
1796 yj=yj_safe+yshift*boxysize
1797 zj=zj_safe+zshift*boxzsize
1798 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1799 if(dist_temp.lt.dist_init) then
1809 if (subchap.eq.1) then
1818 dxj=dc_norm(1,nres+j)
1819 dyj=dc_norm(2,nres+j)
1820 dzj=dc_norm(3,nres+j)
1824 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1825 c write (iout,*) "j",j," dc_norm",
1826 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1827 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1829 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1830 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1832 c write (iout,'(a7,4f8.3)')
1833 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1834 if (sss.gt.0.0d0) then
1835 C Calculate angle-dependent terms of energy and contributions to their
1839 sig=sig0ij*dsqrt(sigsq)
1840 rij_shift=1.0D0/rij-sig+sig0ij
1841 c for diagnostics; uncomment
1842 c rij_shift=1.2*sig0ij
1843 C I hate to put IF's in the loops, but here don't have another choice!!!!
1844 if (rij_shift.le.0.0D0) then
1846 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1847 cd & restyp(itypi),i,restyp(itypj),j,
1848 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1852 c---------------------------------------------------------------
1853 rij_shift=1.0D0/rij_shift
1854 fac=rij_shift**expon
1855 C here to start with
1860 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1861 eps2der=evdwij*eps3rt
1862 eps3der=evdwij*eps2rt
1863 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1864 C &((sslipi+sslipj)/2.0d0+
1865 C &(2.0d0-sslipi-sslipj)/2.0d0)
1866 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1867 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1868 evdwij=evdwij*eps2rt*eps3rt
1869 evdw=evdw+evdwij*sss
1871 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1873 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1874 & restyp(itypi),i,restyp(itypj),j,
1875 & epsi,sigm,chi1,chi2,chip1,chip2,
1876 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1877 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1881 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1884 C Calculate gradient components.
1885 e1=e1*eps1*eps2rt**2*eps3rt**2
1886 fac=-expon*(e1+evdwij)*rij_shift
1889 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1890 c & evdwij,fac,sigma(itypi,itypj),expon
1891 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1893 C Calculate the radial part of the gradient
1894 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1895 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1896 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1897 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1898 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1899 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1905 C Calculate angular part of the gradient.
1915 c write (iout,*) "Number of loop steps in EGB:",ind
1916 cccc energy_dec=.false.
1919 C-----------------------------------------------------------------------------
1920 subroutine egbv(evdw)
1922 C This subroutine calculates the interaction energy of nonbonded side chains
1923 C assuming the Gay-Berne-Vorobjev potential of interaction.
1925 implicit real*8 (a-h,o-z)
1926 include 'DIMENSIONS'
1927 include 'COMMON.GEO'
1928 include 'COMMON.VAR'
1929 include 'COMMON.LOCAL'
1930 include 'COMMON.CHAIN'
1931 include 'COMMON.DERIV'
1932 include 'COMMON.NAMES'
1933 include 'COMMON.INTERACT'
1934 include 'COMMON.IOUNITS'
1935 include 'COMMON.CALC'
1936 common /srutu/ icall
1939 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1942 c if (icall.eq.0) lprn=.true.
1944 do i=iatsc_s,iatsc_e
1945 itypi=iabs(itype(i))
1946 if (itypi.eq.ntyp1) cycle
1947 itypi1=iabs(itype(i+1))
1952 if (xi.lt.0) xi=xi+boxxsize
1954 if (yi.lt.0) yi=yi+boxysize
1956 if (zi.lt.0) zi=zi+boxzsize
1957 C define scaling factor for lipids
1959 C if (positi.le.0) positi=positi+boxzsize
1961 C first for peptide groups
1962 c for each residue check if it is in lipid or lipid water border area
1963 if ((zi.gt.bordlipbot)
1964 &.and.(zi.lt.bordliptop)) then
1965 C the energy transfer exist
1966 if (zi.lt.buflipbot) then
1967 C what fraction I am in
1969 & ((zi-bordlipbot)/lipbufthick)
1970 C lipbufthick is thickenes of lipid buffore
1971 sslipi=sscalelip(fracinbuf)
1972 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1973 elseif (zi.gt.bufliptop) then
1974 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1975 sslipi=sscalelip(fracinbuf)
1976 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1986 dxi=dc_norm(1,nres+i)
1987 dyi=dc_norm(2,nres+i)
1988 dzi=dc_norm(3,nres+i)
1989 c dsci_inv=dsc_inv(itypi)
1990 dsci_inv=vbld_inv(i+nres)
1992 C Calculate SC interaction energy.
1994 do iint=1,nint_gr(i)
1995 do j=istart(i,iint),iend(i,iint)
1997 itypj=iabs(itype(j))
1998 if (itypj.eq.ntyp1) cycle
1999 c dscj_inv=dsc_inv(itypj)
2000 dscj_inv=vbld_inv(j+nres)
2001 sig0ij=sigma(itypi,itypj)
2002 r0ij=r0(itypi,itypj)
2003 chi1=chi(itypi,itypj)
2004 chi2=chi(itypj,itypi)
2011 alf12=0.5D0*(alf1+alf2)
2012 C For diagnostics only!!!
2026 if (xj.lt.0) xj=xj+boxxsize
2028 if (yj.lt.0) yj=yj+boxysize
2030 if (zj.lt.0) zj=zj+boxzsize
2031 if ((zj.gt.bordlipbot)
2032 &.and.(zj.lt.bordliptop)) then
2033 C the energy transfer exist
2034 if (zj.lt.buflipbot) then
2035 C what fraction I am in
2037 & ((zj-bordlipbot)/lipbufthick)
2038 C lipbufthick is thickenes of lipid buffore
2039 sslipj=sscalelip(fracinbuf)
2040 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
2041 elseif (zj.gt.bufliptop) then
2042 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
2043 sslipj=sscalelip(fracinbuf)
2044 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
2053 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
2054 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2055 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
2056 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2057 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
2058 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
2059 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2067 xj=xj_safe+xshift*boxxsize
2068 yj=yj_safe+yshift*boxysize
2069 zj=zj_safe+zshift*boxzsize
2070 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2071 if(dist_temp.lt.dist_init) then
2081 if (subchap.eq.1) then
2090 dxj=dc_norm(1,nres+j)
2091 dyj=dc_norm(2,nres+j)
2092 dzj=dc_norm(3,nres+j)
2093 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2095 C Calculate angle-dependent terms of energy and contributions to their
2099 sig=sig0ij*dsqrt(sigsq)
2100 rij_shift=1.0D0/rij-sig+r0ij
2101 C I hate to put IF's in the loops, but here don't have another choice!!!!
2102 if (rij_shift.le.0.0D0) then
2107 c---------------------------------------------------------------
2108 rij_shift=1.0D0/rij_shift
2109 fac=rij_shift**expon
2112 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2113 eps2der=evdwij*eps3rt
2114 eps3der=evdwij*eps2rt
2115 fac_augm=rrij**expon
2116 e_augm=augm(itypi,itypj)*fac_augm
2117 evdwij=evdwij*eps2rt*eps3rt
2118 evdw=evdw+evdwij+e_augm
2120 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2122 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2123 & restyp(itypi),i,restyp(itypj),j,
2124 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2125 & chi1,chi2,chip1,chip2,
2126 & eps1,eps2rt**2,eps3rt**2,
2127 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2130 C Calculate gradient components.
2131 e1=e1*eps1*eps2rt**2*eps3rt**2
2132 fac=-expon*(e1+evdwij)*rij_shift
2134 fac=rij*fac-2*expon*rrij*e_augm
2135 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2136 C Calculate the radial part of the gradient
2140 C Calculate angular part of the gradient.
2146 C-----------------------------------------------------------------------------
2147 subroutine sc_angular
2148 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2149 C om12. Called by ebp, egb, and egbv.
2151 include 'COMMON.CALC'
2152 include 'COMMON.IOUNITS'
2156 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2157 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2158 om12=dxi*dxj+dyi*dyj+dzi*dzj
2160 C Calculate eps1(om12) and its derivative in om12
2161 faceps1=1.0D0-om12*chiom12
2162 faceps1_inv=1.0D0/faceps1
2163 eps1=dsqrt(faceps1_inv)
2164 C Following variable is eps1*deps1/dom12
2165 eps1_om12=faceps1_inv*chiom12
2170 c write (iout,*) "om12",om12," eps1",eps1
2171 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2176 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2177 sigsq=1.0D0-facsig*faceps1_inv
2178 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2179 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2180 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2186 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2187 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2189 C Calculate eps2 and its derivatives in om1, om2, and om12.
2192 chipom12=chip12*om12
2193 facp=1.0D0-om12*chipom12
2195 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2196 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2197 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2198 C Following variable is the square root of eps2
2199 eps2rt=1.0D0-facp1*facp_inv
2200 C Following three variables are the derivatives of the square root of eps
2201 C in om1, om2, and om12.
2202 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2203 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2204 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2205 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2206 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2207 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2208 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2209 c & " eps2rt_om12",eps2rt_om12
2210 C Calculate whole angle-dependent part of epsilon and contributions
2211 C to its derivatives
2214 C----------------------------------------------------------------------------
2216 implicit real*8 (a-h,o-z)
2217 include 'DIMENSIONS'
2218 include 'COMMON.CHAIN'
2219 include 'COMMON.DERIV'
2220 include 'COMMON.CALC'
2221 include 'COMMON.IOUNITS'
2222 double precision dcosom1(3),dcosom2(3)
2223 cc print *,'sss=',sss
2224 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2225 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2226 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2227 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2231 c eom12=evdwij*eps1_om12
2233 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2234 c & " sigder",sigder
2235 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2236 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2238 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2239 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2242 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2244 c write (iout,*) "gg",(gg(k),k=1,3)
2246 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2247 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2248 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2249 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2250 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2251 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2252 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2253 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2254 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2255 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2258 C Calculate the components of the gradient in DC and X
2262 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2266 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2267 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2271 C-----------------------------------------------------------------------
2272 subroutine e_softsphere(evdw)
2274 C This subroutine calculates the interaction energy of nonbonded side chains
2275 C assuming the LJ potential of interaction.
2277 implicit real*8 (a-h,o-z)
2278 include 'DIMENSIONS'
2279 parameter (accur=1.0d-10)
2280 include 'COMMON.GEO'
2281 include 'COMMON.VAR'
2282 include 'COMMON.LOCAL'
2283 include 'COMMON.CHAIN'
2284 include 'COMMON.DERIV'
2285 include 'COMMON.INTERACT'
2286 include 'COMMON.TORSION'
2287 include 'COMMON.SBRIDGE'
2288 include 'COMMON.NAMES'
2289 include 'COMMON.IOUNITS'
2290 include 'COMMON.CONTACTS'
2292 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2294 do i=iatsc_s,iatsc_e
2295 itypi=iabs(itype(i))
2296 if (itypi.eq.ntyp1) cycle
2297 itypi1=iabs(itype(i+1))
2302 C Calculate SC interaction energy.
2304 do iint=1,nint_gr(i)
2305 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2306 cd & 'iend=',iend(i,iint)
2307 do j=istart(i,iint),iend(i,iint)
2308 itypj=iabs(itype(j))
2309 if (itypj.eq.ntyp1) cycle
2313 rij=xj*xj+yj*yj+zj*zj
2314 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2315 r0ij=r0(itypi,itypj)
2317 c print *,i,j,r0ij,dsqrt(rij)
2318 if (rij.lt.r0ijsq) then
2319 evdwij=0.25d0*(rij-r0ijsq)**2
2327 C Calculate the components of the gradient in DC and X
2333 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2334 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2335 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2336 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2340 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2348 C--------------------------------------------------------------------------
2349 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2352 C Soft-sphere potential of p-p interaction
2354 implicit real*8 (a-h,o-z)
2355 include 'DIMENSIONS'
2356 include 'COMMON.CONTROL'
2357 include 'COMMON.IOUNITS'
2358 include 'COMMON.GEO'
2359 include 'COMMON.VAR'
2360 include 'COMMON.LOCAL'
2361 include 'COMMON.CHAIN'
2362 include 'COMMON.DERIV'
2363 include 'COMMON.INTERACT'
2364 include 'COMMON.CONTACTS'
2365 include 'COMMON.TORSION'
2366 include 'COMMON.VECTORS'
2367 include 'COMMON.FFIELD'
2369 C write(iout,*) 'In EELEC_soft_sphere'
2376 do i=iatel_s,iatel_e
2377 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2381 xmedi=c(1,i)+0.5d0*dxi
2382 ymedi=c(2,i)+0.5d0*dyi
2383 zmedi=c(3,i)+0.5d0*dzi
2384 xmedi=mod(xmedi,boxxsize)
2385 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2386 ymedi=mod(ymedi,boxysize)
2387 if (ymedi.lt.0) ymedi=ymedi+boxysize
2388 zmedi=mod(zmedi,boxzsize)
2389 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2391 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2392 do j=ielstart(i),ielend(i)
2393 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2397 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2398 r0ij=rpp(iteli,itelj)
2407 if (xj.lt.0) xj=xj+boxxsize
2409 if (yj.lt.0) yj=yj+boxysize
2411 if (zj.lt.0) zj=zj+boxzsize
2412 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2420 xj=xj_safe+xshift*boxxsize
2421 yj=yj_safe+yshift*boxysize
2422 zj=zj_safe+zshift*boxzsize
2423 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2424 if(dist_temp.lt.dist_init) then
2434 if (isubchap.eq.1) then
2443 rij=xj*xj+yj*yj+zj*zj
2444 sss=sscale(sqrt(rij))
2445 sssgrad=sscagrad(sqrt(rij))
2446 if (rij.lt.r0ijsq) then
2447 evdw1ij=0.25d0*(rij-r0ijsq)**2
2453 evdw1=evdw1+evdw1ij*sss
2455 C Calculate contributions to the Cartesian gradient.
2457 ggg(1)=fac*xj*sssgrad
2458 ggg(2)=fac*yj*sssgrad
2459 ggg(3)=fac*zj*sssgrad
2461 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2462 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2465 * Loop over residues i+1 thru j-1.
2469 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2474 cgrad do i=nnt,nct-1
2476 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2478 cgrad do j=i+1,nct-1
2480 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2486 c------------------------------------------------------------------------------
2487 subroutine vec_and_deriv
2488 implicit real*8 (a-h,o-z)
2489 include 'DIMENSIONS'
2493 include 'COMMON.IOUNITS'
2494 include 'COMMON.GEO'
2495 include 'COMMON.VAR'
2496 include 'COMMON.LOCAL'
2497 include 'COMMON.CHAIN'
2498 include 'COMMON.VECTORS'
2499 include 'COMMON.SETUP'
2500 include 'COMMON.TIME1'
2501 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2502 C Compute the local reference systems. For reference system (i), the
2503 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2504 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2506 do i=ivec_start,ivec_end
2510 if (i.eq.nres-1) then
2511 C Case of the last full residue
2512 C Compute the Z-axis
2513 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2514 costh=dcos(pi-theta(nres))
2515 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2519 C Compute the derivatives of uz
2521 uzder(2,1,1)=-dc_norm(3,i-1)
2522 uzder(3,1,1)= dc_norm(2,i-1)
2523 uzder(1,2,1)= dc_norm(3,i-1)
2525 uzder(3,2,1)=-dc_norm(1,i-1)
2526 uzder(1,3,1)=-dc_norm(2,i-1)
2527 uzder(2,3,1)= dc_norm(1,i-1)
2530 uzder(2,1,2)= dc_norm(3,i)
2531 uzder(3,1,2)=-dc_norm(2,i)
2532 uzder(1,2,2)=-dc_norm(3,i)
2534 uzder(3,2,2)= dc_norm(1,i)
2535 uzder(1,3,2)= dc_norm(2,i)
2536 uzder(2,3,2)=-dc_norm(1,i)
2538 C Compute the Y-axis
2541 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2543 C Compute the derivatives of uy
2546 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2547 & -dc_norm(k,i)*dc_norm(j,i-1)
2548 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2550 uyder(j,j,1)=uyder(j,j,1)-costh
2551 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2556 uygrad(l,k,j,i)=uyder(l,k,j)
2557 uzgrad(l,k,j,i)=uzder(l,k,j)
2561 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2562 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2563 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2564 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2567 C Compute the Z-axis
2568 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2569 costh=dcos(pi-theta(i+2))
2570 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2574 C Compute the derivatives of uz
2576 uzder(2,1,1)=-dc_norm(3,i+1)
2577 uzder(3,1,1)= dc_norm(2,i+1)
2578 uzder(1,2,1)= dc_norm(3,i+1)
2580 uzder(3,2,1)=-dc_norm(1,i+1)
2581 uzder(1,3,1)=-dc_norm(2,i+1)
2582 uzder(2,3,1)= dc_norm(1,i+1)
2585 uzder(2,1,2)= dc_norm(3,i)
2586 uzder(3,1,2)=-dc_norm(2,i)
2587 uzder(1,2,2)=-dc_norm(3,i)
2589 uzder(3,2,2)= dc_norm(1,i)
2590 uzder(1,3,2)= dc_norm(2,i)
2591 uzder(2,3,2)=-dc_norm(1,i)
2593 C Compute the Y-axis
2596 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2598 C Compute the derivatives of uy
2601 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2602 & -dc_norm(k,i)*dc_norm(j,i+1)
2603 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2605 uyder(j,j,1)=uyder(j,j,1)-costh
2606 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2611 uygrad(l,k,j,i)=uyder(l,k,j)
2612 uzgrad(l,k,j,i)=uzder(l,k,j)
2616 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2617 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2618 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2619 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2623 vbld_inv_temp(1)=vbld_inv(i+1)
2624 if (i.lt.nres-1) then
2625 vbld_inv_temp(2)=vbld_inv(i+2)
2627 vbld_inv_temp(2)=vbld_inv(i)
2632 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2633 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2638 #if defined(PARVEC) && defined(MPI)
2639 if (nfgtasks1.gt.1) then
2641 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2642 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2643 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2644 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2645 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2647 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2648 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2650 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2651 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2652 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2653 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2654 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2655 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2656 time_gather=time_gather+MPI_Wtime()-time00
2658 c if (fg_rank.eq.0) then
2659 c write (iout,*) "Arrays UY and UZ"
2661 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2668 C-----------------------------------------------------------------------------
2669 subroutine check_vecgrad
2670 implicit real*8 (a-h,o-z)
2671 include 'DIMENSIONS'
2672 include 'COMMON.IOUNITS'
2673 include 'COMMON.GEO'
2674 include 'COMMON.VAR'
2675 include 'COMMON.LOCAL'
2676 include 'COMMON.CHAIN'
2677 include 'COMMON.VECTORS'
2678 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2679 dimension uyt(3,maxres),uzt(3,maxres)
2680 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2681 double precision delta /1.0d-7/
2684 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2685 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2686 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2687 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2688 cd & (dc_norm(if90,i),if90=1,3)
2689 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2690 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2691 cd write(iout,'(a)')
2697 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2698 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2711 cd write (iout,*) 'i=',i
2713 erij(k)=dc_norm(k,i)
2717 dc_norm(k,i)=erij(k)
2719 dc_norm(j,i)=dc_norm(j,i)+delta
2720 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2722 c dc_norm(k,i)=dc_norm(k,i)/fac
2724 c write (iout,*) (dc_norm(k,i),k=1,3)
2725 c write (iout,*) (erij(k),k=1,3)
2728 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2729 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2730 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2731 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2733 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2734 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2735 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2738 dc_norm(k,i)=erij(k)
2741 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2742 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2743 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2744 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2745 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2746 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2747 cd write (iout,'(a)')
2752 C--------------------------------------------------------------------------
2753 subroutine set_matrices
2754 implicit real*8 (a-h,o-z)
2755 include 'DIMENSIONS'
2758 include "COMMON.SETUP"
2760 integer status(MPI_STATUS_SIZE)
2762 include 'COMMON.IOUNITS'
2763 include 'COMMON.GEO'
2764 include 'COMMON.VAR'
2765 include 'COMMON.LOCAL'
2766 include 'COMMON.CHAIN'
2767 include 'COMMON.DERIV'
2768 include 'COMMON.INTERACT'
2769 include 'COMMON.CONTACTS'
2770 include 'COMMON.TORSION'
2771 include 'COMMON.VECTORS'
2772 include 'COMMON.FFIELD'
2773 double precision auxvec(2),auxmat(2,2)
2775 C Compute the virtual-bond-torsional-angle dependent quantities needed
2776 C to calculate the el-loc multibody terms of various order.
2778 c write(iout,*) 'nphi=',nphi,nres
2780 do i=ivec_start+2,ivec_end+2
2785 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2786 iti = itortyp(itype(i-2))
2790 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2791 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2792 iti1 = itortyp(itype(i-1))
2797 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2798 & +bnew1(2,1,iti)*dsin(theta(i-1))
2799 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2800 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2801 & +bnew1(2,1,iti)*dcos(theta(i-1))
2802 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2803 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2804 c &*(cos(theta(i)/2.0)
2805 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2806 & +bnew2(2,1,iti)*dsin(theta(i-1))
2807 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2808 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2809 c &*(cos(theta(i)/2.0)
2810 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2811 & +bnew2(2,1,iti)*dcos(theta(i-1))
2812 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2813 c if (ggb1(1,i).eq.0.0d0) then
2814 c write(iout,*) 'i=',i,ggb1(1,i),
2815 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2816 c &bnew1(2,1,iti)*cos(theta(i)),
2817 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2819 b1(2,i-2)=bnew1(1,2,iti)
2821 b2(2,i-2)=bnew2(1,2,iti)
2823 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2824 EE(1,2,i-2)=eeold(1,2,iti)
2825 EE(2,1,i-2)=eeold(2,1,iti)
2826 EE(2,2,i-2)=eeold(2,2,iti)
2827 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2832 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2833 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2834 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2835 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2836 b1tilde(1,i-2)=b1(1,i-2)
2837 b1tilde(2,i-2)=-b1(2,i-2)
2838 b2tilde(1,i-2)=b2(1,i-2)
2839 b2tilde(2,i-2)=-b2(2,i-2)
2840 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2841 c write(iout,*) 'b1=',b1(1,i-2)
2842 c write (iout,*) 'theta=', theta(i-1)
2845 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2846 iti = itortyp(itype(i-2))
2850 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2851 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2852 iti1 = itortyp(itype(i-1))
2860 b1tilde(1,i-2)=b1(1,i-2)
2861 b1tilde(2,i-2)=-b1(2,i-2)
2862 b2tilde(1,i-2)=b2(1,i-2)
2863 b2tilde(2,i-2)=-b2(2,i-2)
2864 EE(1,2,i-2)=eeold(1,2,iti)
2865 EE(2,1,i-2)=eeold(2,1,iti)
2866 EE(2,2,i-2)=eeold(2,2,iti)
2867 EE(1,1,i-2)=eeold(1,1,iti)
2871 do i=ivec_start+2,ivec_end+2
2875 if (i .lt. nres+1) then
2912 if (i .gt. 3 .and. i .lt. nres+1) then
2913 obrot_der(1,i-2)=-sin1
2914 obrot_der(2,i-2)= cos1
2915 Ugder(1,1,i-2)= sin1
2916 Ugder(1,2,i-2)=-cos1
2917 Ugder(2,1,i-2)=-cos1
2918 Ugder(2,2,i-2)=-sin1
2921 obrot2_der(1,i-2)=-dwasin2
2922 obrot2_der(2,i-2)= dwacos2
2923 Ug2der(1,1,i-2)= dwasin2
2924 Ug2der(1,2,i-2)=-dwacos2
2925 Ug2der(2,1,i-2)=-dwacos2
2926 Ug2der(2,2,i-2)=-dwasin2
2928 obrot_der(1,i-2)=0.0d0
2929 obrot_der(2,i-2)=0.0d0
2930 Ugder(1,1,i-2)=0.0d0
2931 Ugder(1,2,i-2)=0.0d0
2932 Ugder(2,1,i-2)=0.0d0
2933 Ugder(2,2,i-2)=0.0d0
2934 obrot2_der(1,i-2)=0.0d0
2935 obrot2_der(2,i-2)=0.0d0
2936 Ug2der(1,1,i-2)=0.0d0
2937 Ug2der(1,2,i-2)=0.0d0
2938 Ug2der(2,1,i-2)=0.0d0
2939 Ug2der(2,2,i-2)=0.0d0
2941 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2942 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2943 iti = itortyp(itype(i-2))
2947 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2948 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2949 iti1 = itortyp(itype(i-1))
2953 cd write (iout,*) '*******i',i,' iti1',iti
2954 cd write (iout,*) 'b1',b1(:,iti)
2955 cd write (iout,*) 'b2',b2(:,iti)
2956 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2957 c if (i .gt. iatel_s+2) then
2958 if (i .gt. nnt+2) then
2959 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2961 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2962 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2964 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2965 c & EE(1,2,iti),EE(2,2,iti)
2966 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2967 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2968 c write(iout,*) "Macierz EUG",
2969 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2971 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2973 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2974 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2975 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2976 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2977 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2988 DtUg2(l,k,i-2)=0.0d0
2992 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2993 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2995 muder(k,i-2)=Ub2der(k,i-2)
2997 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2998 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2999 if (itype(i-1).le.ntyp) then
3000 iti1 = itortyp(itype(i-1))
3008 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
3010 C write (iout,*) 'mumu',i,b1(1,i-1),Ub2(1,i-2)
3011 c write (iout,*) 'mu ',mu(:,i-2),i-2
3012 cd write (iout,*) 'mu1',mu1(:,i-2)
3013 cd write (iout,*) 'mu2',mu2(:,i-2)
3014 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3016 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3017 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
3018 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3019 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
3020 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3021 C Vectors and matrices dependent on a single virtual-bond dihedral.
3022 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
3023 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3024 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3025 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
3026 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
3027 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3028 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3029 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3030 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3033 C Matrices dependent on two consecutive virtual-bond dihedrals.
3034 C The order of matrices is from left to right.
3035 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3037 c do i=max0(ivec_start,2),ivec_end
3039 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3040 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3041 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3042 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3043 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3044 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3045 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3046 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3049 #if defined(MPI) && defined(PARMAT)
3051 c if (fg_rank.eq.0) then
3052 write (iout,*) "Arrays UG and UGDER before GATHER"
3054 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3055 & ((ug(l,k,i),l=1,2),k=1,2),
3056 & ((ugder(l,k,i),l=1,2),k=1,2)
3058 write (iout,*) "Arrays UG2 and UG2DER"
3060 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3061 & ((ug2(l,k,i),l=1,2),k=1,2),
3062 & ((ug2der(l,k,i),l=1,2),k=1,2)
3064 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3066 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3067 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3068 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3070 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3072 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3073 & costab(i),sintab(i),costab2(i),sintab2(i)
3075 write (iout,*) "Array MUDER"
3077 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3081 if (nfgtasks.gt.1) then
3083 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
3084 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
3085 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
3087 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
3088 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3090 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
3091 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3093 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
3094 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3096 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
3097 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3099 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
3100 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3102 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
3103 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3105 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
3106 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
3107 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3108 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
3109 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
3110 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3111 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
3112 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
3113 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3114 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
3115 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
3116 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3117 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3119 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
3120 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3122 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
3123 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3125 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
3126 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3128 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3129 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3131 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3132 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3134 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3135 & ivec_count(fg_rank1),
3136 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3138 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3139 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3141 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3142 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3144 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3145 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3147 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3148 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3150 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3151 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3153 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3154 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3156 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3157 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3159 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3160 & ivec_count(fg_rank1),
3161 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3163 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3164 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3166 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3167 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3169 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3170 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3172 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3173 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3175 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3176 & ivec_count(fg_rank1),
3177 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3179 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3180 & ivec_count(fg_rank1),
3181 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3183 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3184 & ivec_count(fg_rank1),
3185 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3186 & MPI_MAT2,FG_COMM1,IERR)
3187 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3188 & ivec_count(fg_rank1),
3189 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3190 & MPI_MAT2,FG_COMM1,IERR)
3193 c Passes matrix info through the ring
3196 if (irecv.lt.0) irecv=nfgtasks1-1
3199 if (inext.ge.nfgtasks1) inext=0
3201 c write (iout,*) "isend",isend," irecv",irecv
3203 lensend=lentyp(isend)
3204 lenrecv=lentyp(irecv)
3205 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3206 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3207 c & MPI_ROTAT1(lensend),inext,2200+isend,
3208 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3209 c & iprev,2200+irecv,FG_COMM,status,IERR)
3210 c write (iout,*) "Gather ROTAT1"
3212 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3213 c & MPI_ROTAT2(lensend),inext,3300+isend,
3214 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3215 c & iprev,3300+irecv,FG_COMM,status,IERR)
3216 c write (iout,*) "Gather ROTAT2"
3218 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3219 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3220 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3221 & iprev,4400+irecv,FG_COMM,status,IERR)
3222 c write (iout,*) "Gather ROTAT_OLD"
3224 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3225 & MPI_PRECOMP11(lensend),inext,5500+isend,
3226 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3227 & iprev,5500+irecv,FG_COMM,status,IERR)
3228 c write (iout,*) "Gather PRECOMP11"
3230 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3231 & MPI_PRECOMP12(lensend),inext,6600+isend,
3232 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3233 & iprev,6600+irecv,FG_COMM,status,IERR)
3234 c write (iout,*) "Gather PRECOMP12"
3236 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3238 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3239 & MPI_ROTAT2(lensend),inext,7700+isend,
3240 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3241 & iprev,7700+irecv,FG_COMM,status,IERR)
3242 c write (iout,*) "Gather PRECOMP21"
3244 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3245 & MPI_PRECOMP22(lensend),inext,8800+isend,
3246 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3247 & iprev,8800+irecv,FG_COMM,status,IERR)
3248 c write (iout,*) "Gather PRECOMP22"
3250 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3251 & MPI_PRECOMP23(lensend),inext,9900+isend,
3252 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3253 & MPI_PRECOMP23(lenrecv),
3254 & iprev,9900+irecv,FG_COMM,status,IERR)
3255 c write (iout,*) "Gather PRECOMP23"
3260 if (irecv.lt.0) irecv=nfgtasks1-1
3263 time_gather=time_gather+MPI_Wtime()-time00
3266 c if (fg_rank.eq.0) then
3267 write (iout,*) "Arrays UG and UGDER"
3269 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3270 & ((ug(l,k,i),l=1,2),k=1,2),
3271 & ((ugder(l,k,i),l=1,2),k=1,2)
3273 write (iout,*) "Arrays UG2 and UG2DER"
3275 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3276 & ((ug2(l,k,i),l=1,2),k=1,2),
3277 & ((ug2der(l,k,i),l=1,2),k=1,2)
3279 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3281 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3282 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3283 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3285 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3287 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3288 & costab(i),sintab(i),costab2(i),sintab2(i)
3290 write (iout,*) "Array MUDER"
3292 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3298 cd iti = itortyp(itype(i))
3301 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3302 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3307 C--------------------------------------------------------------------------
3308 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3310 C This subroutine calculates the average interaction energy and its gradient
3311 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3312 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3313 C The potential depends both on the distance of peptide-group centers and on
3314 C the orientation of the CA-CA virtual bonds.
3316 implicit real*8 (a-h,o-z)
3320 include 'DIMENSIONS'
3321 include 'COMMON.CONTROL'
3322 include 'COMMON.SETUP'
3323 include 'COMMON.IOUNITS'
3324 include 'COMMON.GEO'
3325 include 'COMMON.VAR'
3326 include 'COMMON.LOCAL'
3327 include 'COMMON.CHAIN'
3328 include 'COMMON.DERIV'
3329 include 'COMMON.INTERACT'
3330 include 'COMMON.CONTACTS'
3331 include 'COMMON.TORSION'
3332 include 'COMMON.VECTORS'
3333 include 'COMMON.FFIELD'
3334 include 'COMMON.TIME1'
3335 include 'COMMON.SPLITELE'
3336 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3337 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3338 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3339 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3340 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3341 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3343 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3345 double precision scal_el /1.0d0/
3347 double precision scal_el /0.5d0/
3350 C 13-go grudnia roku pamietnego...
3351 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3352 & 0.0d0,1.0d0,0.0d0,
3353 & 0.0d0,0.0d0,1.0d0/
3354 cd write(iout,*) 'In EELEC'
3356 cd write(iout,*) 'Type',i
3357 cd write(iout,*) 'B1',B1(:,i)
3358 cd write(iout,*) 'B2',B2(:,i)
3359 cd write(iout,*) 'CC',CC(:,:,i)
3360 cd write(iout,*) 'DD',DD(:,:,i)
3361 cd write(iout,*) 'EE',EE(:,:,i)
3363 cd call check_vecgrad
3365 if (icheckgrad.eq.1) then
3367 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3369 dc_norm(k,i)=dc(k,i)*fac
3371 c write (iout,*) 'i',i,' fac',fac
3374 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3375 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3376 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3377 c call vec_and_deriv
3383 time_mat=time_mat+MPI_Wtime()-time01
3387 cd write (iout,*) 'i=',i
3389 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3392 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3393 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3406 cd print '(a)','Enter EELEC'
3407 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3409 gel_loc_loc(i)=0.0d0
3414 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3416 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3418 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3419 do i=iturn3_start,iturn3_end
3421 C write(iout,*) "tu jest i",i
3422 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3423 C changes suggested by Ana to avoid out of bounds
3424 & .or.((i+4).gt.nres)
3426 C end of changes by Ana
3427 & .or. itype(i+2).eq.ntyp1
3428 & .or. itype(i+3).eq.ntyp1) cycle
3430 if(itype(i-1).eq.ntyp1)cycle
3433 if (itype(i+4).eq.ntyp1) cycle
3438 dx_normi=dc_norm(1,i)
3439 dy_normi=dc_norm(2,i)
3440 dz_normi=dc_norm(3,i)
3441 xmedi=c(1,i)+0.5d0*dxi
3442 ymedi=c(2,i)+0.5d0*dyi
3443 zmedi=c(3,i)+0.5d0*dzi
3444 xmedi=mod(xmedi,boxxsize)
3445 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3446 ymedi=mod(ymedi,boxysize)
3447 if (ymedi.lt.0) ymedi=ymedi+boxysize
3448 zmedi=mod(zmedi,boxzsize)
3449 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3451 call eelecij(i,i+2,ees,evdw1,eel_loc)
3452 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3453 num_cont_hb(i)=num_conti
3455 do i=iturn4_start,iturn4_end
3457 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3458 C changes suggested by Ana to avoid out of bounds
3459 & .or.((i+5).gt.nres)
3461 C end of changes suggested by Ana
3462 & .or. itype(i+3).eq.ntyp1
3463 & .or. itype(i+4).eq.ntyp1
3464 & .or. itype(i+5).eq.ntyp1
3465 & .or. itype(i).eq.ntyp1
3466 & .or. itype(i-1).eq.ntyp1
3471 dx_normi=dc_norm(1,i)
3472 dy_normi=dc_norm(2,i)
3473 dz_normi=dc_norm(3,i)
3474 xmedi=c(1,i)+0.5d0*dxi
3475 ymedi=c(2,i)+0.5d0*dyi
3476 zmedi=c(3,i)+0.5d0*dzi
3477 C Return atom into box, boxxsize is size of box in x dimension
3479 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3480 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3481 C Condition for being inside the proper box
3482 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3483 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3487 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3488 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3489 C Condition for being inside the proper box
3490 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3491 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3495 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3496 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3497 C Condition for being inside the proper box
3498 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3499 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3502 xmedi=mod(xmedi,boxxsize)
3503 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3504 ymedi=mod(ymedi,boxysize)
3505 if (ymedi.lt.0) ymedi=ymedi+boxysize
3506 zmedi=mod(zmedi,boxzsize)
3507 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3509 num_conti=num_cont_hb(i)
3510 c write(iout,*) "JESTEM W PETLI"
3511 call eelecij(i,i+3,ees,evdw1,eel_loc)
3512 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3513 & call eturn4(i,eello_turn4)
3514 num_cont_hb(i)=num_conti
3516 C Loop over all neighbouring boxes
3521 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3524 do i=iatel_s,iatel_e
3527 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3528 C changes suggested by Ana to avoid out of bounds
3529 & .or.((i+2).gt.nres)
3531 C end of changes by Ana
3532 & .or. itype(i+2).eq.ntyp1
3533 & .or. itype(i-1).eq.ntyp1
3538 dx_normi=dc_norm(1,i)
3539 dy_normi=dc_norm(2,i)
3540 dz_normi=dc_norm(3,i)
3541 xmedi=c(1,i)+0.5d0*dxi
3542 ymedi=c(2,i)+0.5d0*dyi
3543 zmedi=c(3,i)+0.5d0*dzi
3544 xmedi=mod(xmedi,boxxsize)
3545 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3546 ymedi=mod(ymedi,boxysize)
3547 if (ymedi.lt.0) ymedi=ymedi+boxysize
3548 zmedi=mod(zmedi,boxzsize)
3549 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3550 C xmedi=xmedi+xshift*boxxsize
3551 C ymedi=ymedi+yshift*boxysize
3552 C zmedi=zmedi+zshift*boxzsize
3554 C Return tom into box, boxxsize is size of box in x dimension
3556 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3557 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3558 C Condition for being inside the proper box
3559 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3560 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3564 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3565 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3566 C Condition for being inside the proper box
3567 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3568 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3572 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3573 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3574 cC Condition for being inside the proper box
3575 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3576 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3580 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3581 num_conti=num_cont_hb(i)
3583 do j=ielstart(i),ielend(i)
3585 C write (iout,*) i,j
3587 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3588 C changes suggested by Ana to avoid out of bounds
3589 & .or.((j+2).gt.nres)
3591 C end of changes by Ana
3592 & .or.itype(j+2).eq.ntyp1
3593 & .or.itype(j-1).eq.ntyp1
3595 call eelecij(i,j,ees,evdw1,eel_loc)
3597 num_cont_hb(i)=num_conti
3603 c write (iout,*) "Number of loop steps in EELEC:",ind
3605 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3606 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3608 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3609 ccc eel_loc=eel_loc+eello_turn3
3610 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3613 C-------------------------------------------------------------------------------
3614 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3615 implicit real*8 (a-h,o-z)
3616 include 'DIMENSIONS'
3620 include 'COMMON.CONTROL'
3621 include 'COMMON.IOUNITS'
3622 include 'COMMON.GEO'
3623 include 'COMMON.VAR'
3624 include 'COMMON.LOCAL'
3625 include 'COMMON.CHAIN'
3626 include 'COMMON.DERIV'
3627 include 'COMMON.INTERACT'
3628 include 'COMMON.CONTACTS'
3629 include 'COMMON.TORSION'
3630 include 'COMMON.VECTORS'
3631 include 'COMMON.FFIELD'
3632 include 'COMMON.TIME1'
3633 include 'COMMON.SPLITELE'
3634 include 'COMMON.SHIELD'
3635 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3636 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3637 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3638 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3639 & gmuij2(4),gmuji2(4)
3640 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3641 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3643 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3645 double precision scal_el /1.0d0/
3647 double precision scal_el /0.5d0/
3650 C 13-go grudnia roku pamietnego...
3651 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3652 & 0.0d0,1.0d0,0.0d0,
3653 & 0.0d0,0.0d0,1.0d0/
3654 c time00=MPI_Wtime()
3655 cd write (iout,*) "eelecij",i,j
3659 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3660 aaa=app(iteli,itelj)
3661 bbb=bpp(iteli,itelj)
3662 ael6i=ael6(iteli,itelj)
3663 ael3i=ael3(iteli,itelj)
3667 dx_normj=dc_norm(1,j)
3668 dy_normj=dc_norm(2,j)
3669 dz_normj=dc_norm(3,j)
3670 C xj=c(1,j)+0.5D0*dxj-xmedi
3671 C yj=c(2,j)+0.5D0*dyj-ymedi
3672 C zj=c(3,j)+0.5D0*dzj-zmedi
3677 if (xj.lt.0) xj=xj+boxxsize
3679 if (yj.lt.0) yj=yj+boxysize
3681 if (zj.lt.0) zj=zj+boxzsize
3682 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3683 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3691 xj=xj_safe+xshift*boxxsize
3692 yj=yj_safe+yshift*boxysize
3693 zj=zj_safe+zshift*boxzsize
3694 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3695 if(dist_temp.lt.dist_init) then
3705 if (isubchap.eq.1) then
3714 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3716 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3717 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3718 C Condition for being inside the proper box
3719 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3720 c & (xj.lt.((-0.5d0)*boxxsize))) then
3724 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3725 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3726 C Condition for being inside the proper box
3727 c if ((yj.gt.((0.5d0)*boxysize)).or.
3728 c & (yj.lt.((-0.5d0)*boxysize))) then
3732 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3733 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3734 C Condition for being inside the proper box
3735 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3736 c & (zj.lt.((-0.5d0)*boxzsize))) then
3739 C endif !endPBC condintion
3743 rij=xj*xj+yj*yj+zj*zj
3745 sss=sscale(sqrt(rij))
3746 sssgrad=sscagrad(sqrt(rij))
3747 c if (sss.gt.0.0d0) then
3753 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3754 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3755 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3756 fac=cosa-3.0D0*cosb*cosg
3758 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3759 if (j.eq.i+2) ev1=scal_el*ev1
3764 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3768 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3769 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3770 if (shield_mode.gt.0) then
3773 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3774 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3783 evdw1=evdw1+evdwij*sss
3784 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3785 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3786 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3787 cd & xmedi,ymedi,zmedi,xj,yj,zj
3789 if (energy_dec) then
3790 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3792 &,iteli,itelj,aaa,evdw1
3793 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
3794 &fac_shield(i),fac_shield(j)
3798 C Calculate contributions to the Cartesian gradient.
3801 facvdw=-6*rrmij*(ev1+evdwij)*sss
3802 facel=-3*rrmij*(el1+eesij)
3809 * Radial derivatives. First process both termini of the fragment (i,j)
3814 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3815 & (shield_mode.gt.0)) then
3817 do ilist=1,ishield_list(i)
3818 iresshield=shield_list(ilist,i)
3820 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
3822 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3824 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
3825 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3826 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3827 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3828 C if (iresshield.gt.i) then
3829 C do ishi=i+1,iresshield-1
3830 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3831 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3835 C do ishi=iresshield,i
3836 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3837 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3843 do ilist=1,ishield_list(j)
3844 iresshield=shield_list(ilist,j)
3846 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
3848 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3850 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
3851 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3853 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3854 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3855 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3856 C if (iresshield.gt.j) then
3857 C do ishi=j+1,iresshield-1
3858 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3859 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3863 C do ishi=iresshield,j
3864 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3865 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3872 gshieldc(k,i)=gshieldc(k,i)+
3873 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
3874 gshieldc(k,j)=gshieldc(k,j)+
3875 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
3876 gshieldc(k,i-1)=gshieldc(k,i-1)+
3877 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
3878 gshieldc(k,j-1)=gshieldc(k,j-1)+
3879 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
3884 c ghalf=0.5D0*ggg(k)
3885 c gelc(k,i)=gelc(k,i)+ghalf
3886 c gelc(k,j)=gelc(k,j)+ghalf
3888 c 9/28/08 AL Gradient compotents will be summed only at the end
3889 C print *,"before", gelc_long(1,i), gelc_long(1,j)
3891 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3892 C & +grad_shield(k,j)*eesij/fac_shield(j)
3893 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3894 C & +grad_shield(k,i)*eesij/fac_shield(i)
3895 C gelc_long(k,i-1)=gelc_long(k,i-1)
3896 C & +grad_shield(k,i)*eesij/fac_shield(i)
3897 C gelc_long(k,j-1)=gelc_long(k,j-1)
3898 C & +grad_shield(k,j)*eesij/fac_shield(j)
3900 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
3903 * Loop over residues i+1 thru j-1.
3907 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3910 if (sss.gt.0.0) then
3911 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3912 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3913 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3920 c ghalf=0.5D0*ggg(k)
3921 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3922 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3924 c 9/28/08 AL Gradient compotents will be summed only at the end
3926 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3927 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3930 * Loop over residues i+1 thru j-1.
3934 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3939 facvdw=(ev1+evdwij)*sss
3942 fac=-3*rrmij*(facvdw+facvdw+facel)
3947 * Radial derivatives. First process both termini of the fragment (i,j)
3950 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
3952 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
3954 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
3956 c ghalf=0.5D0*ggg(k)
3957 c gelc(k,i)=gelc(k,i)+ghalf
3958 c gelc(k,j)=gelc(k,j)+ghalf
3960 c 9/28/08 AL Gradient compotents will be summed only at the end
3962 gelc_long(k,j)=gelc(k,j)+ggg(k)
3963 gelc_long(k,i)=gelc(k,i)-ggg(k)
3966 * Loop over residues i+1 thru j-1.
3970 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3973 c 9/28/08 AL Gradient compotents will be summed only at the end
3974 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3975 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3976 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3978 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3979 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3985 ecosa=2.0D0*fac3*fac1+fac4
3988 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3989 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3991 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3992 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3994 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3995 cd & (dcosg(k),k=1,3)
3997 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
3998 & fac_shield(i)**2*fac_shield(j)**2
4001 c ghalf=0.5D0*ggg(k)
4002 c gelc(k,i)=gelc(k,i)+ghalf
4003 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4004 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4005 c gelc(k,j)=gelc(k,j)+ghalf
4006 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4007 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4011 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4014 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
4017 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4018 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
4019 & *fac_shield(i)**2*fac_shield(j)**2
4021 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4022 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
4023 & *fac_shield(i)**2*fac_shield(j)**2
4024 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4025 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4027 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
4031 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
4032 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
4033 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4035 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
4036 C energy of a peptide unit is assumed in the form of a second-order
4037 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
4038 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
4039 C are computed for EVERY pair of non-contiguous peptide groups.
4042 if (j.lt.nres-1) then
4054 muij(kkk)=mu(k,i)*mu(l,j)
4055 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
4057 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
4058 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
4059 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
4060 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
4061 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
4062 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4066 cd write (iout,*) 'EELEC: i',i,' j',j
4067 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
4068 cd write(iout,*) 'muij',muij
4069 ury=scalar(uy(1,i),erij)
4070 urz=scalar(uz(1,i),erij)
4071 vry=scalar(uy(1,j),erij)
4072 vrz=scalar(uz(1,j),erij)
4073 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4074 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4075 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4076 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4077 fac=dsqrt(-ael6i)*r3ij
4082 cd write (iout,'(4i5,4f10.5)')
4083 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
4084 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4085 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4086 cd & uy(:,j),uz(:,j)
4087 cd write (iout,'(4f10.5)')
4088 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4089 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4090 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
4091 cd write (iout,'(9f10.5/)')
4092 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4093 C Derivatives of the elements of A in virtual-bond vectors
4094 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4096 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4097 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4098 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4099 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4100 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4101 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4102 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4103 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4104 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4105 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4106 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4107 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4109 C Compute radial contributions to the gradient
4127 C Add the contributions coming from er
4130 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4131 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4132 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4133 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4136 C Derivatives in DC(i)
4137 cgrad ghalf1=0.5d0*agg(k,1)
4138 cgrad ghalf2=0.5d0*agg(k,2)
4139 cgrad ghalf3=0.5d0*agg(k,3)
4140 cgrad ghalf4=0.5d0*agg(k,4)
4141 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
4142 & -3.0d0*uryg(k,2)*vry)!+ghalf1
4143 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
4144 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
4145 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
4146 & -3.0d0*urzg(k,2)*vry)!+ghalf3
4147 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
4148 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
4149 C Derivatives in DC(i+1)
4150 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
4151 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4152 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
4153 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4154 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
4155 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4156 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
4157 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4158 C Derivatives in DC(j)
4159 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
4160 & -3.0d0*vryg(k,2)*ury)!+ghalf1
4161 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4162 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4163 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4164 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4165 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4166 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4167 C Derivatives in DC(j+1) or DC(nres-1)
4168 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4169 & -3.0d0*vryg(k,3)*ury)
4170 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4171 & -3.0d0*vrzg(k,3)*ury)
4172 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4173 & -3.0d0*vryg(k,3)*urz)
4174 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4175 & -3.0d0*vrzg(k,3)*urz)
4176 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4178 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4191 aggi(k,l)=-aggi(k,l)
4192 aggi1(k,l)=-aggi1(k,l)
4193 aggj(k,l)=-aggj(k,l)
4194 aggj1(k,l)=-aggj1(k,l)
4197 if (j.lt.nres-1) then
4203 aggi(k,l)=-aggi(k,l)
4204 aggi1(k,l)=-aggi1(k,l)
4205 aggj(k,l)=-aggj(k,l)
4206 aggj1(k,l)=-aggj1(k,l)
4217 aggi(k,l)=-aggi(k,l)
4218 aggi1(k,l)=-aggi1(k,l)
4219 aggj(k,l)=-aggj(k,l)
4220 aggj1(k,l)=-aggj1(k,l)
4225 IF (wel_loc.gt.0.0d0) THEN
4226 C Contribution to the local-electrostatic energy coming from the i-j pair
4227 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4229 if (shield_mode.eq.0) then
4236 eel_loc_ij=eel_loc_ij
4237 & *fac_shield(i)*fac_shield(j)
4238 C Now derivative over eel_loc
4239 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4240 & (shield_mode.gt.0)) then
4243 do ilist=1,ishield_list(i)
4244 iresshield=shield_list(ilist,i)
4246 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
4249 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4251 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
4252 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4256 do ilist=1,ishield_list(j)
4257 iresshield=shield_list(ilist,j)
4259 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
4262 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4264 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
4265 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4272 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
4273 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4274 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
4275 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4276 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
4277 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4278 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
4279 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4284 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4285 c & ' eel_loc_ij',eel_loc_ij
4286 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4287 C Calculate patrial derivative for theta angle
4289 geel_loc_ij=(a22*gmuij1(1)
4293 & *fac_shield(i)*fac_shield(j)
4294 c write(iout,*) "derivative over thatai"
4295 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4297 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4298 & geel_loc_ij*wel_loc
4299 c write(iout,*) "derivative over thatai-1"
4300 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4307 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4308 & geel_loc_ij*wel_loc
4309 & *fac_shield(i)*fac_shield(j)
4311 c Derivative over j residue
4312 geel_loc_ji=a22*gmuji1(1)
4316 c write(iout,*) "derivative over thataj"
4317 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4320 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4321 & geel_loc_ji*wel_loc
4322 & *fac_shield(i)*fac_shield(j)
4329 c write(iout,*) "derivative over thataj-1"
4330 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4332 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4333 & geel_loc_ji*wel_loc
4334 & *fac_shield(i)*fac_shield(j)
4336 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4338 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4339 & 'eelloc',i,j,eel_loc_ij
4340 c if (eel_loc_ij.ne.0)
4341 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4342 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4344 eel_loc=eel_loc+eel_loc_ij
4345 C Partial derivatives in virtual-bond dihedral angles gamma
4347 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4348 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4349 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
4350 & *fac_shield(i)*fac_shield(j)
4352 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4353 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4354 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
4355 & *fac_shield(i)*fac_shield(j)
4356 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4358 ggg(l)=(agg(l,1)*muij(1)+
4359 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
4360 & *fac_shield(i)*fac_shield(j)
4361 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4362 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4363 cgrad ghalf=0.5d0*ggg(l)
4364 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4365 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4369 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4372 C Remaining derivatives of eello
4374 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4375 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4376 & *fac_shield(i)*fac_shield(j)
4378 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4379 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4380 & *fac_shield(i)*fac_shield(j)
4382 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4383 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4384 & *fac_shield(i)*fac_shield(j)
4386 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4387 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4388 & *fac_shield(i)*fac_shield(j)
4392 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4393 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4394 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4395 & .and. num_conti.le.maxconts) then
4396 c write (iout,*) i,j," entered corr"
4398 C Calculate the contact function. The ith column of the array JCONT will
4399 C contain the numbers of atoms that make contacts with the atom I (of numbers
4400 C greater than I). The arrays FACONT and GACONT will contain the values of
4401 C the contact function and its derivative.
4402 c r0ij=1.02D0*rpp(iteli,itelj)
4403 c r0ij=1.11D0*rpp(iteli,itelj)
4404 r0ij=2.20D0*rpp(iteli,itelj)
4405 c r0ij=1.55D0*rpp(iteli,itelj)
4406 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4407 if (fcont.gt.0.0D0) then
4408 num_conti=num_conti+1
4409 if (num_conti.gt.maxconts) then
4410 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4411 & ' will skip next contacts for this conf.'
4413 jcont_hb(num_conti,i)=j
4414 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4415 cd & " jcont_hb",jcont_hb(num_conti,i)
4416 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4417 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4418 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4420 d_cont(num_conti,i)=rij
4421 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4422 C --- Electrostatic-interaction matrix ---
4423 a_chuj(1,1,num_conti,i)=a22
4424 a_chuj(1,2,num_conti,i)=a23
4425 a_chuj(2,1,num_conti,i)=a32
4426 a_chuj(2,2,num_conti,i)=a33
4427 C --- Gradient of rij
4429 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4436 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4437 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4438 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4439 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4440 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4445 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4446 C Calculate contact energies
4448 wij=cosa-3.0D0*cosb*cosg
4451 c fac3=dsqrt(-ael6i)/r0ij**3
4452 fac3=dsqrt(-ael6i)*r3ij
4453 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4454 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4455 if (ees0tmp.gt.0) then
4456 ees0pij=dsqrt(ees0tmp)
4460 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4461 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4462 if (ees0tmp.gt.0) then
4463 ees0mij=dsqrt(ees0tmp)
4468 if (shield_mode.eq.0) then
4472 ees0plist(num_conti,i)=j
4473 C fac_shield(i)=0.4d0
4474 C fac_shield(j)=0.6d0
4476 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4477 & *fac_shield(i)*fac_shield(j)
4478 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4479 & *fac_shield(i)*fac_shield(j)
4480 C Diagnostics. Comment out or remove after debugging!
4481 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4482 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4483 c ees0m(num_conti,i)=0.0D0
4485 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4486 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4487 C Angular derivatives of the contact function
4488 ees0pij1=fac3/ees0pij
4489 ees0mij1=fac3/ees0mij
4490 fac3p=-3.0D0*fac3*rrmij
4491 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4492 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4494 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4495 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4496 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4497 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4498 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4499 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4500 ecosap=ecosa1+ecosa2
4501 ecosbp=ecosb1+ecosb2
4502 ecosgp=ecosg1+ecosg2
4503 ecosam=ecosa1-ecosa2
4504 ecosbm=ecosb1-ecosb2
4505 ecosgm=ecosg1-ecosg2
4514 facont_hb(num_conti,i)=fcont
4515 fprimcont=fprimcont/rij
4516 cd facont_hb(num_conti,i)=1.0D0
4517 C Following line is for diagnostics.
4520 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4521 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4524 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4525 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4527 gggp(1)=gggp(1)+ees0pijp*xj
4528 gggp(2)=gggp(2)+ees0pijp*yj
4529 gggp(3)=gggp(3)+ees0pijp*zj
4530 gggm(1)=gggm(1)+ees0mijp*xj
4531 gggm(2)=gggm(2)+ees0mijp*yj
4532 gggm(3)=gggm(3)+ees0mijp*zj
4533 C Derivatives due to the contact function
4534 gacont_hbr(1,num_conti,i)=fprimcont*xj
4535 gacont_hbr(2,num_conti,i)=fprimcont*yj
4536 gacont_hbr(3,num_conti,i)=fprimcont*zj
4539 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4540 c following the change of gradient-summation algorithm.
4542 cgrad ghalfp=0.5D0*gggp(k)
4543 cgrad ghalfm=0.5D0*gggm(k)
4544 gacontp_hb1(k,num_conti,i)=!ghalfp
4545 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4546 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4547 & *fac_shield(i)*fac_shield(j)
4549 gacontp_hb2(k,num_conti,i)=!ghalfp
4550 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4551 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4552 & *fac_shield(i)*fac_shield(j)
4554 gacontp_hb3(k,num_conti,i)=gggp(k)
4555 & *fac_shield(i)*fac_shield(j)
4557 gacontm_hb1(k,num_conti,i)=!ghalfm
4558 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4559 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4560 & *fac_shield(i)*fac_shield(j)
4562 gacontm_hb2(k,num_conti,i)=!ghalfm
4563 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4564 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4565 & *fac_shield(i)*fac_shield(j)
4567 gacontm_hb3(k,num_conti,i)=gggm(k)
4568 & *fac_shield(i)*fac_shield(j)
4571 C Diagnostics. Comment out or remove after debugging!
4573 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4574 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4575 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4576 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4577 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4578 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4581 endif ! num_conti.le.maxconts
4584 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4587 ghalf=0.5d0*agg(l,k)
4588 aggi(l,k)=aggi(l,k)+ghalf
4589 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4590 aggj(l,k)=aggj(l,k)+ghalf
4593 if (j.eq.nres-1 .and. i.lt.j-2) then
4596 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4601 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4604 C-----------------------------------------------------------------------------
4605 subroutine eturn3(i,eello_turn3)
4606 C Third- and fourth-order contributions from turns
4607 implicit real*8 (a-h,o-z)
4608 include 'DIMENSIONS'
4609 include 'COMMON.IOUNITS'
4610 include 'COMMON.GEO'
4611 include 'COMMON.VAR'
4612 include 'COMMON.LOCAL'
4613 include 'COMMON.CHAIN'
4614 include 'COMMON.DERIV'
4615 include 'COMMON.INTERACT'
4616 include 'COMMON.CONTACTS'
4617 include 'COMMON.TORSION'
4618 include 'COMMON.VECTORS'
4619 include 'COMMON.FFIELD'
4620 include 'COMMON.CONTROL'
4621 include 'COMMON.SHIELD'
4623 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4624 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4625 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4626 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4627 & auxgmat2(2,2),auxgmatt2(2,2)
4628 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4629 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4630 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4631 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4634 c write (iout,*) "eturn3",i,j,j1,j2
4639 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4641 C Third-order contributions
4648 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4649 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4650 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4651 c auxalary matices for theta gradient
4652 c auxalary matrix for i+1 and constant i+2
4653 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4654 c auxalary matrix for i+2 and constant i+1
4655 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4656 call transpose2(auxmat(1,1),auxmat1(1,1))
4657 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4658 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4659 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4660 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4661 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4662 if (shield_mode.eq.0) then
4669 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4670 & *fac_shield(i)*fac_shield(j)
4671 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
4672 & *fac_shield(i)*fac_shield(j)
4673 C Derivatives in theta
4674 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4675 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4676 & *fac_shield(i)*fac_shield(j)
4677 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4678 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4679 & *fac_shield(i)*fac_shield(j)
4682 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4683 C Derivatives in shield mode
4684 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4685 & (shield_mode.gt.0)) then
4688 do ilist=1,ishield_list(i)
4689 iresshield=shield_list(ilist,i)
4691 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4693 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4695 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4696 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4700 do ilist=1,ishield_list(j)
4701 iresshield=shield_list(ilist,j)
4703 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4705 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4707 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4708 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4715 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
4716 & grad_shield(k,i)*eello_t3/fac_shield(i)
4717 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
4718 & grad_shield(k,j)*eello_t3/fac_shield(j)
4719 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
4720 & grad_shield(k,i)*eello_t3/fac_shield(i)
4721 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
4722 & grad_shield(k,j)*eello_t3/fac_shield(j)
4726 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4727 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4728 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4729 cd & ' eello_turn3_num',4*eello_turn3_num
4730 C Derivatives in gamma(i)
4731 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4732 call transpose2(auxmat2(1,1),auxmat3(1,1))
4733 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4734 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4735 & *fac_shield(i)*fac_shield(j)
4736 C Derivatives in gamma(i+1)
4737 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4738 call transpose2(auxmat2(1,1),auxmat3(1,1))
4739 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4740 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4741 & +0.5d0*(pizda(1,1)+pizda(2,2))
4742 & *fac_shield(i)*fac_shield(j)
4743 C Cartesian derivatives
4745 c ghalf1=0.5d0*agg(l,1)
4746 c ghalf2=0.5d0*agg(l,2)
4747 c ghalf3=0.5d0*agg(l,3)
4748 c ghalf4=0.5d0*agg(l,4)
4749 a_temp(1,1)=aggi(l,1)!+ghalf1
4750 a_temp(1,2)=aggi(l,2)!+ghalf2
4751 a_temp(2,1)=aggi(l,3)!+ghalf3
4752 a_temp(2,2)=aggi(l,4)!+ghalf4
4753 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4754 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4755 & +0.5d0*(pizda(1,1)+pizda(2,2))
4756 & *fac_shield(i)*fac_shield(j)
4758 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4759 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4760 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4761 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4762 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4763 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4764 & +0.5d0*(pizda(1,1)+pizda(2,2))
4765 & *fac_shield(i)*fac_shield(j)
4766 a_temp(1,1)=aggj(l,1)!+ghalf1
4767 a_temp(1,2)=aggj(l,2)!+ghalf2
4768 a_temp(2,1)=aggj(l,3)!+ghalf3
4769 a_temp(2,2)=aggj(l,4)!+ghalf4
4770 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4771 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4772 & +0.5d0*(pizda(1,1)+pizda(2,2))
4773 & *fac_shield(i)*fac_shield(j)
4774 a_temp(1,1)=aggj1(l,1)
4775 a_temp(1,2)=aggj1(l,2)
4776 a_temp(2,1)=aggj1(l,3)
4777 a_temp(2,2)=aggj1(l,4)
4778 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4779 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4780 & +0.5d0*(pizda(1,1)+pizda(2,2))
4781 & *fac_shield(i)*fac_shield(j)
4785 C-------------------------------------------------------------------------------
4786 subroutine eturn4(i,eello_turn4)
4787 C Third- and fourth-order contributions from turns
4788 implicit real*8 (a-h,o-z)
4789 include 'DIMENSIONS'
4790 include 'COMMON.IOUNITS'
4791 include 'COMMON.GEO'
4792 include 'COMMON.VAR'
4793 include 'COMMON.LOCAL'
4794 include 'COMMON.CHAIN'
4795 include 'COMMON.DERIV'
4796 include 'COMMON.INTERACT'
4797 include 'COMMON.CONTACTS'
4798 include 'COMMON.TORSION'
4799 include 'COMMON.VECTORS'
4800 include 'COMMON.FFIELD'
4801 include 'COMMON.CONTROL'
4802 include 'COMMON.SHIELD'
4804 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4805 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4806 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4807 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4808 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4809 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4810 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4811 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4812 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4813 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4814 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4817 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4819 C Fourth-order contributions
4827 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4828 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4829 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4830 c write(iout,*)"WCHODZE W PROGRAM"
4835 iti1=itortyp(itype(i+1))
4836 iti2=itortyp(itype(i+2))
4837 iti3=itortyp(itype(i+3))
4838 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4839 call transpose2(EUg(1,1,i+1),e1t(1,1))
4840 call transpose2(Eug(1,1,i+2),e2t(1,1))
4841 call transpose2(Eug(1,1,i+3),e3t(1,1))
4842 C Ematrix derivative in theta
4843 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4844 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4845 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4846 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4847 c eta1 in derivative theta
4848 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4849 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4850 c auxgvec is derivative of Ub2 so i+3 theta
4851 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4852 c auxalary matrix of E i+1
4853 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4856 s1=scalar2(b1(1,i+2),auxvec(1))
4857 c derivative of theta i+2 with constant i+3
4858 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4859 c derivative of theta i+2 with constant i+2
4860 gs32=scalar2(b1(1,i+2),auxgvec(1))
4861 c derivative of E matix in theta of i+1
4862 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4864 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4865 c ea31 in derivative theta
4866 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4867 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4868 c auxilary matrix auxgvec of Ub2 with constant E matirx
4869 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4870 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4871 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4875 s2=scalar2(b1(1,i+1),auxvec(1))
4876 c derivative of theta i+1 with constant i+3
4877 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4878 c derivative of theta i+2 with constant i+1
4879 gs21=scalar2(b1(1,i+1),auxgvec(1))
4880 c derivative of theta i+3 with constant i+1
4881 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4882 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4884 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4885 c two derivatives over diffetent matrices
4886 c gtae3e2 is derivative over i+3
4887 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4888 c ae3gte2 is derivative over i+2
4889 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4890 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4891 c three possible derivative over theta E matices
4893 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4895 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4897 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4898 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4900 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4901 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4902 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4903 if (shield_mode.eq.0) then
4910 eello_turn4=eello_turn4-(s1+s2+s3)
4911 & *fac_shield(i)*fac_shield(j)
4912 eello_t4=-(s1+s2+s3)
4913 & *fac_shield(i)*fac_shield(j)
4914 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4915 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4916 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4917 C Now derivative over shield:
4918 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4919 & (shield_mode.gt.0)) then
4922 do ilist=1,ishield_list(i)
4923 iresshield=shield_list(ilist,i)
4925 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
4927 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
4929 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
4930 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
4934 do ilist=1,ishield_list(j)
4935 iresshield=shield_list(ilist,j)
4937 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
4939 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
4941 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
4942 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
4949 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
4950 & grad_shield(k,i)*eello_t4/fac_shield(i)
4951 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
4952 & grad_shield(k,j)*eello_t4/fac_shield(j)
4953 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
4954 & grad_shield(k,i)*eello_t4/fac_shield(i)
4955 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
4956 & grad_shield(k,j)*eello_t4/fac_shield(j)
4965 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4966 cd & ' eello_turn4_num',8*eello_turn4_num
4968 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4969 & -(gs13+gsE13+gsEE1)*wturn4
4970 & *fac_shield(i)*fac_shield(j)
4971 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4972 & -(gs23+gs21+gsEE2)*wturn4
4973 & *fac_shield(i)*fac_shield(j)
4975 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4976 & -(gs32+gsE31+gsEE3)*wturn4
4977 & *fac_shield(i)*fac_shield(j)
4979 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4982 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4983 & 'eturn4',i,j,-(s1+s2+s3)
4984 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4985 c & ' eello_turn4_num',8*eello_turn4_num
4986 C Derivatives in gamma(i)
4987 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4988 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4989 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4990 s1=scalar2(b1(1,i+2),auxvec(1))
4991 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4992 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4993 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4994 & *fac_shield(i)*fac_shield(j)
4995 C Derivatives in gamma(i+1)
4996 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4997 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4998 s2=scalar2(b1(1,i+1),auxvec(1))
4999 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5000 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5001 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5002 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
5003 & *fac_shield(i)*fac_shield(j)
5004 C Derivatives in gamma(i+2)
5005 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5006 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5007 s1=scalar2(b1(1,i+2),auxvec(1))
5008 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5009 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5010 s2=scalar2(b1(1,i+1),auxvec(1))
5011 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5012 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5013 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5014 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
5015 & *fac_shield(i)*fac_shield(j)
5016 C Cartesian derivatives
5017 C Derivatives of this turn contributions in DC(i+2)
5018 if (j.lt.nres-1) then
5020 a_temp(1,1)=agg(l,1)
5021 a_temp(1,2)=agg(l,2)
5022 a_temp(2,1)=agg(l,3)
5023 a_temp(2,2)=agg(l,4)
5024 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5025 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5026 s1=scalar2(b1(1,i+2),auxvec(1))
5027 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5028 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5029 s2=scalar2(b1(1,i+1),auxvec(1))
5030 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5031 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5032 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5034 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
5035 & *fac_shield(i)*fac_shield(j)
5038 C Remaining derivatives of this turn contribution
5040 a_temp(1,1)=aggi(l,1)
5041 a_temp(1,2)=aggi(l,2)
5042 a_temp(2,1)=aggi(l,3)
5043 a_temp(2,2)=aggi(l,4)
5044 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5045 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5046 s1=scalar2(b1(1,i+2),auxvec(1))
5047 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5048 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5049 s2=scalar2(b1(1,i+1),auxvec(1))
5050 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5051 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5052 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5053 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
5054 & *fac_shield(i)*fac_shield(j)
5055 a_temp(1,1)=aggi1(l,1)
5056 a_temp(1,2)=aggi1(l,2)
5057 a_temp(2,1)=aggi1(l,3)
5058 a_temp(2,2)=aggi1(l,4)
5059 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5060 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5061 s1=scalar2(b1(1,i+2),auxvec(1))
5062 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5063 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5064 s2=scalar2(b1(1,i+1),auxvec(1))
5065 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5066 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5067 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5068 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
5069 & *fac_shield(i)*fac_shield(j)
5070 a_temp(1,1)=aggj(l,1)
5071 a_temp(1,2)=aggj(l,2)
5072 a_temp(2,1)=aggj(l,3)
5073 a_temp(2,2)=aggj(l,4)
5074 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5075 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5076 s1=scalar2(b1(1,i+2),auxvec(1))
5077 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5078 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5079 s2=scalar2(b1(1,i+1),auxvec(1))
5080 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5081 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5082 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5083 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
5084 & *fac_shield(i)*fac_shield(j)
5085 a_temp(1,1)=aggj1(l,1)
5086 a_temp(1,2)=aggj1(l,2)
5087 a_temp(2,1)=aggj1(l,3)
5088 a_temp(2,2)=aggj1(l,4)
5089 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5090 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5091 s1=scalar2(b1(1,i+2),auxvec(1))
5092 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5093 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5094 s2=scalar2(b1(1,i+1),auxvec(1))
5095 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5096 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5097 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5098 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5099 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
5100 & *fac_shield(i)*fac_shield(j)
5104 C-----------------------------------------------------------------------------
5105 subroutine vecpr(u,v,w)
5106 implicit real*8(a-h,o-z)
5107 dimension u(3),v(3),w(3)
5108 w(1)=u(2)*v(3)-u(3)*v(2)
5109 w(2)=-u(1)*v(3)+u(3)*v(1)
5110 w(3)=u(1)*v(2)-u(2)*v(1)
5113 C-----------------------------------------------------------------------------
5114 subroutine unormderiv(u,ugrad,unorm,ungrad)
5115 C This subroutine computes the derivatives of a normalized vector u, given
5116 C the derivatives computed without normalization conditions, ugrad. Returns
5119 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
5120 double precision vec(3)
5121 double precision scalar
5123 c write (2,*) 'ugrad',ugrad
5126 vec(i)=scalar(ugrad(1,i),u(1))
5128 c write (2,*) 'vec',vec
5131 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5134 c write (2,*) 'ungrad',ungrad
5137 C-----------------------------------------------------------------------------
5138 subroutine escp_soft_sphere(evdw2,evdw2_14)
5140 C This subroutine calculates the excluded-volume interaction energy between
5141 C peptide-group centers and side chains and its gradient in virtual-bond and
5142 C side-chain vectors.
5144 implicit real*8 (a-h,o-z)
5145 include 'DIMENSIONS'
5146 include 'COMMON.GEO'
5147 include 'COMMON.VAR'
5148 include 'COMMON.LOCAL'
5149 include 'COMMON.CHAIN'
5150 include 'COMMON.DERIV'
5151 include 'COMMON.INTERACT'
5152 include 'COMMON.FFIELD'
5153 include 'COMMON.IOUNITS'
5154 include 'COMMON.CONTROL'
5159 cd print '(a)','Enter ESCP'
5160 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5164 do i=iatscp_s,iatscp_e
5165 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5167 xi=0.5D0*(c(1,i)+c(1,i+1))
5168 yi=0.5D0*(c(2,i)+c(2,i+1))
5169 zi=0.5D0*(c(3,i)+c(3,i+1))
5170 C Return atom into box, boxxsize is size of box in x dimension
5172 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5173 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5174 C Condition for being inside the proper box
5175 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5176 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5180 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5181 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5182 C Condition for being inside the proper box
5183 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5184 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5188 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5189 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5190 cC Condition for being inside the proper box
5191 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5192 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5196 if (xi.lt.0) xi=xi+boxxsize
5198 if (yi.lt.0) yi=yi+boxysize
5200 if (zi.lt.0) zi=zi+boxzsize
5201 C xi=xi+xshift*boxxsize
5202 C yi=yi+yshift*boxysize
5203 C zi=zi+zshift*boxzsize
5204 do iint=1,nscp_gr(i)
5206 do j=iscpstart(i,iint),iscpend(i,iint)
5207 if (itype(j).eq.ntyp1) cycle
5208 itypj=iabs(itype(j))
5209 C Uncomment following three lines for SC-p interactions
5213 C Uncomment following three lines for Ca-p interactions
5218 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5219 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5220 C Condition for being inside the proper box
5221 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5222 c & (xj.lt.((-0.5d0)*boxxsize))) then
5226 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5227 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5228 cC Condition for being inside the proper box
5229 c if ((yj.gt.((0.5d0)*boxysize)).or.
5230 c & (yj.lt.((-0.5d0)*boxysize))) then
5234 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5235 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5236 C Condition for being inside the proper box
5237 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5238 c & (zj.lt.((-0.5d0)*boxzsize))) then
5241 if (xj.lt.0) xj=xj+boxxsize
5243 if (yj.lt.0) yj=yj+boxysize
5245 if (zj.lt.0) zj=zj+boxzsize
5246 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5254 xj=xj_safe+xshift*boxxsize
5255 yj=yj_safe+yshift*boxysize
5256 zj=zj_safe+zshift*boxzsize
5257 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5258 if(dist_temp.lt.dist_init) then
5268 if (subchap.eq.1) then
5281 rij=xj*xj+yj*yj+zj*zj
5285 if (rij.lt.r0ijsq) then
5286 evdwij=0.25d0*(rij-r0ijsq)**2
5294 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5299 cgrad if (j.lt.i) then
5300 cd write (iout,*) 'j<i'
5301 C Uncomment following three lines for SC-p interactions
5303 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5306 cd write (iout,*) 'j>i'
5308 cgrad ggg(k)=-ggg(k)
5309 C Uncomment following line for SC-p interactions
5310 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5314 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5316 cgrad kstart=min0(i+1,j)
5317 cgrad kend=max0(i-1,j-1)
5318 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5319 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5320 cgrad do k=kstart,kend
5322 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5326 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5327 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5338 C-----------------------------------------------------------------------------
5339 subroutine escp(evdw2,evdw2_14)
5341 C This subroutine calculates the excluded-volume interaction energy between
5342 C peptide-group centers and side chains and its gradient in virtual-bond and
5343 C side-chain vectors.
5345 implicit real*8 (a-h,o-z)
5346 include 'DIMENSIONS'
5347 include 'COMMON.GEO'
5348 include 'COMMON.VAR'
5349 include 'COMMON.LOCAL'
5350 include 'COMMON.CHAIN'
5351 include 'COMMON.DERIV'
5352 include 'COMMON.INTERACT'
5353 include 'COMMON.FFIELD'
5354 include 'COMMON.IOUNITS'
5355 include 'COMMON.CONTROL'
5356 include 'COMMON.SPLITELE'
5360 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
5361 cd print '(a)','Enter ESCP'
5362 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5366 do i=iatscp_s,iatscp_e
5367 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5369 xi=0.5D0*(c(1,i)+c(1,i+1))
5370 yi=0.5D0*(c(2,i)+c(2,i+1))
5371 zi=0.5D0*(c(3,i)+c(3,i+1))
5373 if (xi.lt.0) xi=xi+boxxsize
5375 if (yi.lt.0) yi=yi+boxysize
5377 if (zi.lt.0) zi=zi+boxzsize
5378 c xi=xi+xshift*boxxsize
5379 c yi=yi+yshift*boxysize
5380 c zi=zi+zshift*boxzsize
5381 c print *,xi,yi,zi,'polozenie i'
5382 C Return atom into box, boxxsize is size of box in x dimension
5384 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5385 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5386 C Condition for being inside the proper box
5387 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5388 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5392 c print *,xi,boxxsize,"pierwszy"
5394 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5395 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5396 C Condition for being inside the proper box
5397 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5398 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5402 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5403 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5404 C Condition for being inside the proper box
5405 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5406 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5409 do iint=1,nscp_gr(i)
5411 do j=iscpstart(i,iint),iscpend(i,iint)
5412 itypj=iabs(itype(j))
5413 if (itypj.eq.ntyp1) cycle
5414 C Uncomment following three lines for SC-p interactions
5418 C Uncomment following three lines for Ca-p interactions
5423 if (xj.lt.0) xj=xj+boxxsize
5425 if (yj.lt.0) yj=yj+boxysize
5427 if (zj.lt.0) zj=zj+boxzsize
5429 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5430 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5431 C Condition for being inside the proper box
5432 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5433 c & (xj.lt.((-0.5d0)*boxxsize))) then
5437 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5438 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5439 cC Condition for being inside the proper box
5440 c if ((yj.gt.((0.5d0)*boxysize)).or.
5441 c & (yj.lt.((-0.5d0)*boxysize))) then
5445 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5446 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5447 C Condition for being inside the proper box
5448 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5449 c & (zj.lt.((-0.5d0)*boxzsize))) then
5452 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5453 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5461 xj=xj_safe+xshift*boxxsize
5462 yj=yj_safe+yshift*boxysize
5463 zj=zj_safe+zshift*boxzsize
5464 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5465 if(dist_temp.lt.dist_init) then
5475 if (subchap.eq.1) then
5484 c print *,xj,yj,zj,'polozenie j'
5485 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5487 sss=sscale(1.0d0/(dsqrt(rrij)))
5488 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5489 c if (sss.eq.0) print *,'czasem jest OK'
5490 if (sss.le.0.0d0) cycle
5491 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5493 e1=fac*fac*aad(itypj,iteli)
5494 e2=fac*bad(itypj,iteli)
5495 if (iabs(j-i) .le. 2) then
5498 evdw2_14=evdw2_14+(e1+e2)*sss
5501 evdw2=evdw2+evdwij*sss
5502 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5503 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5506 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5508 fac=-(evdwij+e1)*rrij*sss
5509 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5513 cgrad if (j.lt.i) then
5514 cd write (iout,*) 'j<i'
5515 C Uncomment following three lines for SC-p interactions
5517 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5520 cd write (iout,*) 'j>i'
5522 cgrad ggg(k)=-ggg(k)
5523 C Uncomment following line for SC-p interactions
5524 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5525 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5529 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5531 cgrad kstart=min0(i+1,j)
5532 cgrad kend=max0(i-1,j-1)
5533 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5534 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5535 cgrad do k=kstart,kend
5537 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5541 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5542 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5544 c endif !endif for sscale cutoff
5554 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5555 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5556 gradx_scp(j,i)=expon*gradx_scp(j,i)
5559 C******************************************************************************
5563 C To save time the factor EXPON has been extracted from ALL components
5564 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5567 C******************************************************************************
5570 C--------------------------------------------------------------------------
5571 subroutine edis(ehpb)
5573 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5575 implicit real*8 (a-h,o-z)
5576 include 'DIMENSIONS'
5577 include 'COMMON.SBRIDGE'
5578 include 'COMMON.CHAIN'
5579 include 'COMMON.DERIV'
5580 include 'COMMON.VAR'
5581 include 'COMMON.INTERACT'
5582 include 'COMMON.IOUNITS'
5583 include 'COMMON.CONTROL'
5589 C write (iout,*) ,"link_end",link_end,constr_dist
5590 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5591 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5592 if (link_end.eq.0) return
5593 do i=link_start,link_end
5594 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5595 C CA-CA distance used in regularization of structure.
5598 C iii and jjj point to the residues for which the distance is assigned.
5599 if (ii.gt.nres) then
5606 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5607 c & dhpb(i),dhpb1(i),forcon(i)
5608 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5609 C distance and angle dependent SS bond potential.
5610 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5611 C & iabs(itype(jjj)).eq.1) then
5612 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5613 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5614 if (.not.dyn_ss .and. i.le.nss) then
5615 C 15/02/13 CC dynamic SSbond - additional check
5616 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5617 & iabs(itype(jjj)).eq.1) then
5618 call ssbond_ene(iii,jjj,eij)
5621 cd write (iout,*) "eij",eij
5622 cd & ' waga=',waga,' fac=',fac
5623 else if (ii.gt.nres .and. jj.gt.nres) then
5624 c Restraints from contact prediction
5626 if (constr_dist.eq.11) then
5627 ehpb=ehpb+fordepth(i)**4.0d0
5628 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5629 fac=fordepth(i)**4.0d0
5630 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5631 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5632 & ehpb,fordepth(i),dd
5634 if (dhpb1(i).gt.0.0d0) then
5635 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5636 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5637 c write (iout,*) "beta nmr",
5638 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5642 C Get the force constant corresponding to this distance.
5644 C Calculate the contribution to energy.
5645 ehpb=ehpb+waga*rdis*rdis
5646 c write (iout,*) "beta reg",dd,waga*rdis*rdis
5648 C Evaluate gradient.
5654 ggg(j)=fac*(c(j,jj)-c(j,ii))
5657 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5658 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5661 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5662 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5665 C Calculate the distance between the two points and its difference from the
5668 if (constr_dist.eq.11) then
5669 ehpb=ehpb+fordepth(i)**4.0d0
5670 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5671 fac=fordepth(i)**4.0d0
5672 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5673 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5674 & ehpb,fordepth(i),dd
5676 if (dhpb1(i).gt.0.0d0) then
5677 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5678 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5679 c write (iout,*) "alph nmr",
5680 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5683 C Get the force constant corresponding to this distance.
5685 C Calculate the contribution to energy.
5686 ehpb=ehpb+waga*rdis*rdis
5687 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5689 C Evaluate gradient.
5695 ggg(j)=fac*(c(j,jj)-c(j,ii))
5697 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5698 C If this is a SC-SC distance, we need to calculate the contributions to the
5699 C Cartesian gradient in the SC vectors (ghpbx).
5702 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5703 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5706 cgrad do j=iii,jjj-1
5708 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5712 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5713 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5717 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5720 C--------------------------------------------------------------------------
5721 subroutine ssbond_ene(i,j,eij)
5723 C Calculate the distance and angle dependent SS-bond potential energy
5724 C using a free-energy function derived based on RHF/6-31G** ab initio
5725 C calculations of diethyl disulfide.
5727 C A. Liwo and U. Kozlowska, 11/24/03
5729 implicit real*8 (a-h,o-z)
5730 include 'DIMENSIONS'
5731 include 'COMMON.SBRIDGE'
5732 include 'COMMON.CHAIN'
5733 include 'COMMON.DERIV'
5734 include 'COMMON.LOCAL'
5735 include 'COMMON.INTERACT'
5736 include 'COMMON.VAR'
5737 include 'COMMON.IOUNITS'
5738 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5739 itypi=iabs(itype(i))
5743 dxi=dc_norm(1,nres+i)
5744 dyi=dc_norm(2,nres+i)
5745 dzi=dc_norm(3,nres+i)
5746 c dsci_inv=dsc_inv(itypi)
5747 dsci_inv=vbld_inv(nres+i)
5748 itypj=iabs(itype(j))
5749 c dscj_inv=dsc_inv(itypj)
5750 dscj_inv=vbld_inv(nres+j)
5754 dxj=dc_norm(1,nres+j)
5755 dyj=dc_norm(2,nres+j)
5756 dzj=dc_norm(3,nres+j)
5757 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5762 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5763 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5764 om12=dxi*dxj+dyi*dyj+dzi*dzj
5766 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5767 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5773 deltat12=om2-om1+2.0d0
5775 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5776 & +akct*deltad*deltat12
5777 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5778 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5779 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5780 c & " deltat12",deltat12," eij",eij
5781 ed=2*akcm*deltad+akct*deltat12
5783 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5784 eom1=-2*akth*deltat1-pom1-om2*pom2
5785 eom2= 2*akth*deltat2+pom1-om1*pom2
5788 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5789 ghpbx(k,i)=ghpbx(k,i)-ggk
5790 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5791 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5792 ghpbx(k,j)=ghpbx(k,j)+ggk
5793 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5794 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5795 ghpbc(k,i)=ghpbc(k,i)-ggk
5796 ghpbc(k,j)=ghpbc(k,j)+ggk
5799 C Calculate the components of the gradient in DC and X
5803 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5808 C--------------------------------------------------------------------------
5809 subroutine ebond(estr)
5811 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5813 implicit real*8 (a-h,o-z)
5814 include 'DIMENSIONS'
5815 include 'COMMON.LOCAL'
5816 include 'COMMON.GEO'
5817 include 'COMMON.INTERACT'
5818 include 'COMMON.DERIV'
5819 include 'COMMON.VAR'
5820 include 'COMMON.CHAIN'
5821 include 'COMMON.IOUNITS'
5822 include 'COMMON.NAMES'
5823 include 'COMMON.FFIELD'
5824 include 'COMMON.CONTROL'
5825 include 'COMMON.SETUP'
5826 double precision u(3),ud(3)
5829 do i=ibondp_start,ibondp_end
5830 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5831 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5833 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5834 c & *dc(j,i-1)/vbld(i)
5836 c if (energy_dec) write(iout,*)
5837 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5839 C Checking if it involves dummy (NH3+ or COO-) group
5840 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5841 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5842 diff = vbld(i)-vbldpDUM
5844 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5845 diff = vbld(i)-vbldp0
5847 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5848 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5851 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5853 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5856 estr=0.5d0*AKP*estr+estr1
5858 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5860 do i=ibond_start,ibond_end
5862 if (iti.ne.10 .and. iti.ne.ntyp1) then
5865 diff=vbld(i+nres)-vbldsc0(1,iti)
5866 if (energy_dec) write (iout,*)
5867 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5868 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5869 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5871 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5875 diff=vbld(i+nres)-vbldsc0(j,iti)
5876 ud(j)=aksc(j,iti)*diff
5877 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5891 uprod2=uprod2*u(k)*u(k)
5895 usumsqder=usumsqder+ud(j)*uprod2
5897 estr=estr+uprod/usum
5899 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5907 C--------------------------------------------------------------------------
5908 subroutine ebend(etheta,ethetacnstr)
5910 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5911 C angles gamma and its derivatives in consecutive thetas and gammas.
5913 implicit real*8 (a-h,o-z)
5914 include 'DIMENSIONS'
5915 include 'COMMON.LOCAL'
5916 include 'COMMON.GEO'
5917 include 'COMMON.INTERACT'
5918 include 'COMMON.DERIV'
5919 include 'COMMON.VAR'
5920 include 'COMMON.CHAIN'
5921 include 'COMMON.IOUNITS'
5922 include 'COMMON.NAMES'
5923 include 'COMMON.FFIELD'
5924 include 'COMMON.CONTROL'
5925 include 'COMMON.TORCNSTR'
5926 common /calcthet/ term1,term2,termm,diffak,ratak,
5927 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5928 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5929 double precision y(2),z(2)
5931 c time11=dexp(-2*time)
5934 c write (*,'(a,i2)') 'EBEND ICG=',icg
5935 do i=ithet_start,ithet_end
5936 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5937 & .or.itype(i).eq.ntyp1) cycle
5938 C Zero the energy function and its derivative at 0 or pi.
5939 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5941 ichir1=isign(1,itype(i-2))
5942 ichir2=isign(1,itype(i))
5943 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5944 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5945 if (itype(i-1).eq.10) then
5946 itype1=isign(10,itype(i-2))
5947 ichir11=isign(1,itype(i-2))
5948 ichir12=isign(1,itype(i-2))
5949 itype2=isign(10,itype(i))
5950 ichir21=isign(1,itype(i))
5951 ichir22=isign(1,itype(i))
5954 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5957 if (phii.ne.phii) phii=150.0
5967 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5970 if (phii1.ne.phii1) phii1=150.0
5982 C Calculate the "mean" value of theta from the part of the distribution
5983 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5984 C In following comments this theta will be referred to as t_c.
5985 thet_pred_mean=0.0d0
5987 athetk=athet(k,it,ichir1,ichir2)
5988 bthetk=bthet(k,it,ichir1,ichir2)
5990 athetk=athet(k,itype1,ichir11,ichir12)
5991 bthetk=bthet(k,itype2,ichir21,ichir22)
5993 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5994 c write(iout,*) 'chuj tu', y(k),z(k)
5996 dthett=thet_pred_mean*ssd
5997 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5998 C Derivatives of the "mean" values in gamma1 and gamma2.
5999 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
6000 &+athet(2,it,ichir1,ichir2)*y(1))*ss
6001 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
6002 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
6004 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
6005 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
6006 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
6007 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
6009 if (theta(i).gt.pi-delta) then
6010 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
6012 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
6013 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6014 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
6016 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
6018 else if (theta(i).lt.delta) then
6019 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
6020 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6021 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
6023 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
6024 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
6027 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
6030 etheta=etheta+ethetai
6031 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
6032 & 'ebend',i,ethetai,theta(i),itype(i)
6033 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
6034 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
6035 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
6038 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6039 do i=ithetaconstr_start,ithetaconstr_end
6040 itheta=itheta_constr(i)
6041 thetiii=theta(itheta)
6042 difi=pinorm(thetiii-theta_constr0(i))
6043 if (difi.gt.theta_drange(i)) then
6044 difi=difi-theta_drange(i)
6045 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6046 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6047 & +for_thet_constr(i)*difi**3
6048 else if (difi.lt.-drange(i)) then
6050 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6051 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6052 & +for_thet_constr(i)*difi**3
6056 if (energy_dec) then
6057 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6058 & i,itheta,rad2deg*thetiii,
6059 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6060 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6061 & gloc(itheta+nphi-2,icg)
6065 C Ufff.... We've done all this!!!
6068 C---------------------------------------------------------------------------
6069 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
6071 implicit real*8 (a-h,o-z)
6072 include 'DIMENSIONS'
6073 include 'COMMON.LOCAL'
6074 include 'COMMON.IOUNITS'
6075 common /calcthet/ term1,term2,termm,diffak,ratak,
6076 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6077 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6078 C Calculate the contributions to both Gaussian lobes.
6079 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6080 C The "polynomial part" of the "standard deviation" of this part of
6081 C the distributioni.
6082 ccc write (iout,*) thetai,thet_pred_mean
6085 sig=sig*thet_pred_mean+polthet(j,it)
6087 C Derivative of the "interior part" of the "standard deviation of the"
6088 C gamma-dependent Gaussian lobe in t_c.
6089 sigtc=3*polthet(3,it)
6091 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6094 C Set the parameters of both Gaussian lobes of the distribution.
6095 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6096 fac=sig*sig+sigc0(it)
6099 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6100 sigsqtc=-4.0D0*sigcsq*sigtc
6101 c print *,i,sig,sigtc,sigsqtc
6102 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
6103 sigtc=-sigtc/(fac*fac)
6104 C Following variable is sigma(t_c)**(-2)
6105 sigcsq=sigcsq*sigcsq
6107 sig0inv=1.0D0/sig0i**2
6108 delthec=thetai-thet_pred_mean
6109 delthe0=thetai-theta0i
6110 term1=-0.5D0*sigcsq*delthec*delthec
6111 term2=-0.5D0*sig0inv*delthe0*delthe0
6112 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
6113 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6114 C NaNs in taking the logarithm. We extract the largest exponent which is added
6115 C to the energy (this being the log of the distribution) at the end of energy
6116 C term evaluation for this virtual-bond angle.
6117 if (term1.gt.term2) then
6119 term2=dexp(term2-termm)
6123 term1=dexp(term1-termm)
6126 C The ratio between the gamma-independent and gamma-dependent lobes of
6127 C the distribution is a Gaussian function of thet_pred_mean too.
6128 diffak=gthet(2,it)-thet_pred_mean
6129 ratak=diffak/gthet(3,it)**2
6130 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6131 C Let's differentiate it in thet_pred_mean NOW.
6133 C Now put together the distribution terms to make complete distribution.
6134 termexp=term1+ak*term2
6135 termpre=sigc+ak*sig0i
6136 C Contribution of the bending energy from this theta is just the -log of
6137 C the sum of the contributions from the two lobes and the pre-exponential
6138 C factor. Simple enough, isn't it?
6139 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6140 C write (iout,*) 'termexp',termexp,termm,termpre,i
6141 C NOW the derivatives!!!
6142 C 6/6/97 Take into account the deformation.
6143 E_theta=(delthec*sigcsq*term1
6144 & +ak*delthe0*sig0inv*term2)/termexp
6145 E_tc=((sigtc+aktc*sig0i)/termpre
6146 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
6147 & aktc*term2)/termexp)
6150 c-----------------------------------------------------------------------------
6151 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
6152 implicit real*8 (a-h,o-z)
6153 include 'DIMENSIONS'
6154 include 'COMMON.LOCAL'
6155 include 'COMMON.IOUNITS'
6156 common /calcthet/ term1,term2,termm,diffak,ratak,
6157 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6158 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6159 delthec=thetai-thet_pred_mean
6160 delthe0=thetai-theta0i
6161 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
6162 t3 = thetai-thet_pred_mean
6166 t14 = t12+t6*sigsqtc
6168 t21 = thetai-theta0i
6174 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
6175 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
6176 & *(-t12*t9-ak*sig0inv*t27)
6180 C--------------------------------------------------------------------------
6181 subroutine ebend(etheta,ethetacnstr)
6183 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6184 C angles gamma and its derivatives in consecutive thetas and gammas.
6185 C ab initio-derived potentials from
6186 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6188 implicit real*8 (a-h,o-z)
6189 include 'DIMENSIONS'
6190 include 'COMMON.LOCAL'
6191 include 'COMMON.GEO'
6192 include 'COMMON.INTERACT'
6193 include 'COMMON.DERIV'
6194 include 'COMMON.VAR'
6195 include 'COMMON.CHAIN'
6196 include 'COMMON.IOUNITS'
6197 include 'COMMON.NAMES'
6198 include 'COMMON.FFIELD'
6199 include 'COMMON.CONTROL'
6200 include 'COMMON.TORCNSTR'
6201 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
6202 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
6203 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
6204 & sinph1ph2(maxdouble,maxdouble)
6205 logical lprn /.false./, lprn1 /.false./
6207 do i=ithet_start,ithet_end
6208 c print *,i,itype(i-1),itype(i),itype(i-2)
6209 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6210 & .or.itype(i).eq.ntyp1) cycle
6211 C print *,i,theta(i)
6212 if (iabs(itype(i+1)).eq.20) iblock=2
6213 if (iabs(itype(i+1)).ne.20) iblock=1
6217 theti2=0.5d0*theta(i)
6218 ityp2=ithetyp((itype(i-1)))
6220 coskt(k)=dcos(k*theti2)
6221 sinkt(k)=dsin(k*theti2)
6224 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
6227 if (phii.ne.phii) phii=150.0
6231 ityp1=ithetyp((itype(i-2)))
6232 C propagation of chirality for glycine type
6234 cosph1(k)=dcos(k*phii)
6235 sinph1(k)=dsin(k*phii)
6240 ityp1=ithetyp((itype(i-2)))
6245 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6248 if (phii1.ne.phii1) phii1=150.0
6253 ityp3=ithetyp((itype(i)))
6255 cosph2(k)=dcos(k*phii1)
6256 sinph2(k)=dsin(k*phii1)
6260 ityp3=ithetyp((itype(i)))
6266 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
6269 ccl=cosph1(l)*cosph2(k-l)
6270 ssl=sinph1(l)*sinph2(k-l)
6271 scl=sinph1(l)*cosph2(k-l)
6272 csl=cosph1(l)*sinph2(k-l)
6273 cosph1ph2(l,k)=ccl-ssl
6274 cosph1ph2(k,l)=ccl+ssl
6275 sinph1ph2(l,k)=scl+csl
6276 sinph1ph2(k,l)=scl-csl
6280 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
6281 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6282 write (iout,*) "coskt and sinkt"
6284 write (iout,*) k,coskt(k),sinkt(k)
6288 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6289 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
6292 & write (iout,*) "k",k,"
6293 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
6294 & " ethetai",ethetai
6297 write (iout,*) "cosph and sinph"
6299 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6301 write (iout,*) "cosph1ph2 and sinph2ph2"
6304 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6305 & sinph1ph2(l,k),sinph1ph2(k,l)
6308 write(iout,*) "ethetai",ethetai
6313 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
6314 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
6315 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
6316 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6317 ethetai=ethetai+sinkt(m)*aux
6318 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6319 dephii=dephii+k*sinkt(m)*(
6320 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
6321 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6322 dephii1=dephii1+k*sinkt(m)*(
6323 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
6324 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6326 & write (iout,*) "m",m," k",k," bbthet",
6327 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
6328 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
6329 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
6330 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6331 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6334 C print *,"cosph1", (cosph1(k), k=1,nsingle)
6335 C print *,"cosph2", (cosph2(k), k=1,nsingle)
6336 C print *,"sinph1", (sinph1(k), k=1,nsingle)
6337 C print *,"sinph2", (sinph2(k), k=1,nsingle)
6339 & write(iout,*) "ethetai",ethetai
6340 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6344 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6345 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
6346 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6347 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6348 ethetai=ethetai+sinkt(m)*aux
6349 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6350 dephii=dephii+l*sinkt(m)*(
6351 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
6352 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6353 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6354 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6355 dephii1=dephii1+(k-l)*sinkt(m)*(
6356 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6357 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6358 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
6359 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6361 write (iout,*) "m",m," k",k," l",l," ffthet",
6362 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6363 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
6364 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6365 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
6366 & " ethetai",ethetai
6367 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6368 & cosph1ph2(k,l)*sinkt(m),
6369 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6378 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6379 & i,theta(i)*rad2deg,phii*rad2deg,
6380 & phii1*rad2deg,ethetai
6382 etheta=etheta+ethetai
6383 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6384 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6385 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
6389 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6390 do i=ithetaconstr_start,ithetaconstr_end
6391 itheta=itheta_constr(i)
6392 thetiii=theta(itheta)
6393 difi=pinorm(thetiii-theta_constr0(i))
6394 if (difi.gt.theta_drange(i)) then
6395 difi=difi-theta_drange(i)
6396 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6397 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6398 & +for_thet_constr(i)*difi**3
6399 else if (difi.lt.-drange(i)) then
6401 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6402 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6403 & +for_thet_constr(i)*difi**3
6407 if (energy_dec) then
6408 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6409 & i,itheta,rad2deg*thetiii,
6410 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6411 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6412 & gloc(itheta+nphi-2,icg)
6420 c-----------------------------------------------------------------------------
6421 subroutine esc(escloc)
6422 C Calculate the local energy of a side chain and its derivatives in the
6423 C corresponding virtual-bond valence angles THETA and the spherical angles
6425 implicit real*8 (a-h,o-z)
6426 include 'DIMENSIONS'
6427 include 'COMMON.GEO'
6428 include 'COMMON.LOCAL'
6429 include 'COMMON.VAR'
6430 include 'COMMON.INTERACT'
6431 include 'COMMON.DERIV'
6432 include 'COMMON.CHAIN'
6433 include 'COMMON.IOUNITS'
6434 include 'COMMON.NAMES'
6435 include 'COMMON.FFIELD'
6436 include 'COMMON.CONTROL'
6437 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6438 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6439 common /sccalc/ time11,time12,time112,theti,it,nlobit
6442 c write (iout,'(a)') 'ESC'
6443 do i=loc_start,loc_end
6445 if (it.eq.ntyp1) cycle
6446 if (it.eq.10) goto 1
6447 nlobit=nlob(iabs(it))
6448 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6449 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6450 theti=theta(i+1)-pipol
6455 if (x(2).gt.pi-delta) then
6459 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6461 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6462 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6464 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6465 & ddersc0(1),dersc(1))
6466 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6467 & ddersc0(3),dersc(3))
6469 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6471 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6472 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6473 & dersc0(2),esclocbi,dersc02)
6474 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6476 call splinthet(x(2),0.5d0*delta,ss,ssd)
6481 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6483 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6484 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6486 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6488 c write (iout,*) escloci
6489 else if (x(2).lt.delta) then
6493 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6495 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6496 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6498 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6499 & ddersc0(1),dersc(1))
6500 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6501 & ddersc0(3),dersc(3))
6503 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6505 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6506 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6507 & dersc0(2),esclocbi,dersc02)
6508 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6513 call splinthet(x(2),0.5d0*delta,ss,ssd)
6515 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6517 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6518 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6520 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6521 c write (iout,*) escloci
6523 call enesc(x,escloci,dersc,ddummy,.false.)
6526 escloc=escloc+escloci
6527 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6528 & 'escloc',i,escloci
6529 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6531 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6533 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6534 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6539 C---------------------------------------------------------------------------
6540 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6541 implicit real*8 (a-h,o-z)
6542 include 'DIMENSIONS'
6543 include 'COMMON.GEO'
6544 include 'COMMON.LOCAL'
6545 include 'COMMON.IOUNITS'
6546 common /sccalc/ time11,time12,time112,theti,it,nlobit
6547 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6548 double precision contr(maxlob,-1:1)
6550 c write (iout,*) 'it=',it,' nlobit=',nlobit
6554 if (mixed) ddersc(j)=0.0d0
6558 C Because of periodicity of the dependence of the SC energy in omega we have
6559 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6560 C To avoid underflows, first compute & store the exponents.
6568 z(k)=x(k)-censc(k,j,it)
6573 Axk=Axk+gaussc(l,k,j,it)*z(l)
6579 expfac=expfac+Ax(k,j,iii)*z(k)
6587 C As in the case of ebend, we want to avoid underflows in exponentiation and
6588 C subsequent NaNs and INFs in energy calculation.
6589 C Find the largest exponent
6593 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6597 cd print *,'it=',it,' emin=',emin
6599 C Compute the contribution to SC energy and derivatives
6604 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6605 if(adexp.ne.adexp) adexp=1.0
6608 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6610 cd print *,'j=',j,' expfac=',expfac
6611 escloc_i=escloc_i+expfac
6613 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6617 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6618 & +gaussc(k,2,j,it))*expfac
6625 dersc(1)=dersc(1)/cos(theti)**2
6626 ddersc(1)=ddersc(1)/cos(theti)**2
6629 escloci=-(dlog(escloc_i)-emin)
6631 dersc(j)=dersc(j)/escloc_i
6635 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6640 C------------------------------------------------------------------------------
6641 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6642 implicit real*8 (a-h,o-z)
6643 include 'DIMENSIONS'
6644 include 'COMMON.GEO'
6645 include 'COMMON.LOCAL'
6646 include 'COMMON.IOUNITS'
6647 common /sccalc/ time11,time12,time112,theti,it,nlobit
6648 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6649 double precision contr(maxlob)
6660 z(k)=x(k)-censc(k,j,it)
6666 Axk=Axk+gaussc(l,k,j,it)*z(l)
6672 expfac=expfac+Ax(k,j)*z(k)
6677 C As in the case of ebend, we want to avoid underflows in exponentiation and
6678 C subsequent NaNs and INFs in energy calculation.
6679 C Find the largest exponent
6682 if (emin.gt.contr(j)) emin=contr(j)
6686 C Compute the contribution to SC energy and derivatives
6690 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6691 escloc_i=escloc_i+expfac
6693 dersc(k)=dersc(k)+Ax(k,j)*expfac
6695 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6696 & +gaussc(1,2,j,it))*expfac
6700 dersc(1)=dersc(1)/cos(theti)**2
6701 dersc12=dersc12/cos(theti)**2
6702 escloci=-(dlog(escloc_i)-emin)
6704 dersc(j)=dersc(j)/escloc_i
6706 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6710 c----------------------------------------------------------------------------------
6711 subroutine esc(escloc)
6712 C Calculate the local energy of a side chain and its derivatives in the
6713 C corresponding virtual-bond valence angles THETA and the spherical angles
6714 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6715 C added by Urszula Kozlowska. 07/11/2007
6717 implicit real*8 (a-h,o-z)
6718 include 'DIMENSIONS'
6719 include 'COMMON.GEO'
6720 include 'COMMON.LOCAL'
6721 include 'COMMON.VAR'
6722 include 'COMMON.SCROT'
6723 include 'COMMON.INTERACT'
6724 include 'COMMON.DERIV'
6725 include 'COMMON.CHAIN'
6726 include 'COMMON.IOUNITS'
6727 include 'COMMON.NAMES'
6728 include 'COMMON.FFIELD'
6729 include 'COMMON.CONTROL'
6730 include 'COMMON.VECTORS'
6731 double precision x_prime(3),y_prime(3),z_prime(3)
6732 & , sumene,dsc_i,dp2_i,x(65),
6733 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6734 & de_dxx,de_dyy,de_dzz,de_dt
6735 double precision s1_t,s1_6_t,s2_t,s2_6_t
6737 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6738 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6739 & dt_dCi(3),dt_dCi1(3)
6740 common /sccalc/ time11,time12,time112,theti,it,nlobit
6743 do i=loc_start,loc_end
6744 if (itype(i).eq.ntyp1) cycle
6745 costtab(i+1) =dcos(theta(i+1))
6746 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6747 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6748 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6749 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6750 cosfac=dsqrt(cosfac2)
6751 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6752 sinfac=dsqrt(sinfac2)
6754 if (it.eq.10) goto 1
6756 C Compute the axes of tghe local cartesian coordinates system; store in
6757 c x_prime, y_prime and z_prime
6764 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6765 C & dc_norm(3,i+nres)
6767 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6768 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6771 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6774 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6775 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6776 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6777 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6778 c & " xy",scalar(x_prime(1),y_prime(1)),
6779 c & " xz",scalar(x_prime(1),z_prime(1)),
6780 c & " yy",scalar(y_prime(1),y_prime(1)),
6781 c & " yz",scalar(y_prime(1),z_prime(1)),
6782 c & " zz",scalar(z_prime(1),z_prime(1))
6784 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6785 C to local coordinate system. Store in xx, yy, zz.
6791 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6792 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6793 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6800 C Compute the energy of the ith side cbain
6802 c write (2,*) "xx",xx," yy",yy," zz",zz
6805 x(j) = sc_parmin(j,it)
6808 Cc diagnostics - remove later
6810 yy1 = dsin(alph(2))*dcos(omeg(2))
6811 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6812 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6813 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6815 C," --- ", xx_w,yy_w,zz_w
6818 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6819 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6821 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6822 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6824 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6825 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6826 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6827 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6828 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6830 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6831 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6832 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6833 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6834 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6836 dsc_i = 0.743d0+x(61)
6838 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6839 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6840 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6841 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6842 s1=(1+x(63))/(0.1d0 + dscp1)
6843 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6844 s2=(1+x(65))/(0.1d0 + dscp2)
6845 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6846 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6847 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6848 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6850 c & dscp1,dscp2,sumene
6851 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6852 escloc = escloc + sumene
6853 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6858 C This section to check the numerical derivatives of the energy of ith side
6859 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6860 C #define DEBUG in the code to turn it on.
6862 write (2,*) "sumene =",sumene
6866 write (2,*) xx,yy,zz
6867 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6868 de_dxx_num=(sumenep-sumene)/aincr
6870 write (2,*) "xx+ sumene from enesc=",sumenep
6873 write (2,*) xx,yy,zz
6874 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6875 de_dyy_num=(sumenep-sumene)/aincr
6877 write (2,*) "yy+ sumene from enesc=",sumenep
6880 write (2,*) xx,yy,zz
6881 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6882 de_dzz_num=(sumenep-sumene)/aincr
6884 write (2,*) "zz+ sumene from enesc=",sumenep
6885 costsave=cost2tab(i+1)
6886 sintsave=sint2tab(i+1)
6887 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6888 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6889 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6890 de_dt_num=(sumenep-sumene)/aincr
6891 write (2,*) " t+ sumene from enesc=",sumenep
6892 cost2tab(i+1)=costsave
6893 sint2tab(i+1)=sintsave
6894 C End of diagnostics section.
6897 C Compute the gradient of esc
6899 c zz=zz*dsign(1.0,dfloat(itype(i)))
6900 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6901 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6902 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6903 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6904 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6905 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6906 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6907 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6908 pom1=(sumene3*sint2tab(i+1)+sumene1)
6909 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6910 pom2=(sumene4*cost2tab(i+1)+sumene2)
6911 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6912 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6913 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6914 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6916 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6917 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6918 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6920 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6921 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6922 & +(pom1+pom2)*pom_dx
6924 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6927 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6928 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6929 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6931 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6932 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6933 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6934 & +x(59)*zz**2 +x(60)*xx*zz
6935 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6936 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6937 & +(pom1-pom2)*pom_dy
6939 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6942 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6943 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6944 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6945 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6946 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6947 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6948 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6949 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6951 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6954 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6955 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6956 & +pom1*pom_dt1+pom2*pom_dt2
6958 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6963 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6964 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6965 cosfac2xx=cosfac2*xx
6966 sinfac2yy=sinfac2*yy
6968 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6970 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6972 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6973 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6974 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6975 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6976 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6977 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6978 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6979 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6980 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6981 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6985 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6986 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6987 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6988 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6991 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6992 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6993 dZZ_XYZ(k)=vbld_inv(i+nres)*
6994 & (z_prime(k)-zz*dC_norm(k,i+nres))
6996 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6997 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
7001 dXX_Ctab(k,i)=dXX_Ci(k)
7002 dXX_C1tab(k,i)=dXX_Ci1(k)
7003 dYY_Ctab(k,i)=dYY_Ci(k)
7004 dYY_C1tab(k,i)=dYY_Ci1(k)
7005 dZZ_Ctab(k,i)=dZZ_Ci(k)
7006 dZZ_C1tab(k,i)=dZZ_Ci1(k)
7007 dXX_XYZtab(k,i)=dXX_XYZ(k)
7008 dYY_XYZtab(k,i)=dYY_XYZ(k)
7009 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
7013 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
7014 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
7015 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
7016 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
7017 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
7019 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
7020 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
7021 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
7022 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
7023 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
7024 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
7025 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
7026 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
7028 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
7029 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
7031 C to check gradient call subroutine check_grad
7037 c------------------------------------------------------------------------------
7038 double precision function enesc(x,xx,yy,zz,cost2,sint2)
7040 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
7041 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
7042 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7043 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7045 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7046 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7048 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7049 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7050 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7051 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7052 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7054 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7055 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7056 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7057 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7058 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7060 dsc_i = 0.743d0+x(61)
7062 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7063 & *(xx*cost2+yy*sint2))
7064 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7065 & *(xx*cost2-yy*sint2))
7066 s1=(1+x(63))/(0.1d0 + dscp1)
7067 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7068 s2=(1+x(65))/(0.1d0 + dscp2)
7069 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7070 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
7071 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
7076 c------------------------------------------------------------------------------
7077 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
7079 C This procedure calculates two-body contact function g(rij) and its derivative:
7082 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
7085 C where x=(rij-r0ij)/delta
7087 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
7090 double precision rij,r0ij,eps0ij,fcont,fprimcont
7091 double precision x,x2,x4,delta
7095 if (x.lt.-1.0D0) then
7098 else if (x.le.1.0D0) then
7101 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
7102 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7109 c------------------------------------------------------------------------------
7110 subroutine splinthet(theti,delta,ss,ssder)
7111 implicit real*8 (a-h,o-z)
7112 include 'DIMENSIONS'
7113 include 'COMMON.VAR'
7114 include 'COMMON.GEO'
7117 if (theti.gt.pipol) then
7118 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7120 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7125 c------------------------------------------------------------------------------
7126 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7128 double precision x,x0,delta,f0,f1,fprim0,f,fprim
7129 double precision ksi,ksi2,ksi3,a1,a2,a3
7130 a1=fprim0*delta/(f1-f0)
7136 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7137 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7140 c------------------------------------------------------------------------------
7141 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7143 double precision x,x0,delta,f0x,f1x,fprim0x,fx
7144 double precision ksi,ksi2,ksi3,a1,a2,a3
7149 a2=3*(f1x-f0x)-2*fprim0x*delta
7150 a3=fprim0x*delta-2*(f1x-f0x)
7151 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7154 C-----------------------------------------------------------------------------
7156 C-----------------------------------------------------------------------------
7157 subroutine etor(etors,edihcnstr)
7158 implicit real*8 (a-h,o-z)
7159 include 'DIMENSIONS'
7160 include 'COMMON.VAR'
7161 include 'COMMON.GEO'
7162 include 'COMMON.LOCAL'
7163 include 'COMMON.TORSION'
7164 include 'COMMON.INTERACT'
7165 include 'COMMON.DERIV'
7166 include 'COMMON.CHAIN'
7167 include 'COMMON.NAMES'
7168 include 'COMMON.IOUNITS'
7169 include 'COMMON.FFIELD'
7170 include 'COMMON.TORCNSTR'
7171 include 'COMMON.CONTROL'
7173 C Set lprn=.true. for debugging
7177 do i=iphi_start,iphi_end
7179 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7180 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7181 itori=itortyp(itype(i-2))
7182 itori1=itortyp(itype(i-1))
7185 C Proline-Proline pair is a special case...
7186 if (itori.eq.3 .and. itori1.eq.3) then
7187 if (phii.gt.-dwapi3) then
7189 fac=1.0D0/(1.0D0-cosphi)
7190 etorsi=v1(1,3,3)*fac
7191 etorsi=etorsi+etorsi
7192 etors=etors+etorsi-v1(1,3,3)
7193 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
7194 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7197 v1ij=v1(j+1,itori,itori1)
7198 v2ij=v2(j+1,itori,itori1)
7201 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7202 if (energy_dec) etors_ii=etors_ii+
7203 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7204 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7208 v1ij=v1(j,itori,itori1)
7209 v2ij=v2(j,itori,itori1)
7212 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7213 if (energy_dec) etors_ii=etors_ii+
7214 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7215 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7218 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7221 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7222 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7223 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7224 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7225 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7227 ! 6/20/98 - dihedral angle constraints
7230 itori=idih_constr(i)
7233 if (difi.gt.drange(i)) then
7235 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7236 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7237 else if (difi.lt.-drange(i)) then
7239 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
7240 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7242 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
7243 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7245 ! write (iout,*) 'edihcnstr',edihcnstr
7248 c------------------------------------------------------------------------------
7249 subroutine etor_d(etors_d)
7253 c----------------------------------------------------------------------------
7255 subroutine etor(etors,edihcnstr)
7256 implicit real*8 (a-h,o-z)
7257 include 'DIMENSIONS'
7258 include 'COMMON.VAR'
7259 include 'COMMON.GEO'
7260 include 'COMMON.LOCAL'
7261 include 'COMMON.TORSION'
7262 include 'COMMON.INTERACT'
7263 include 'COMMON.DERIV'
7264 include 'COMMON.CHAIN'
7265 include 'COMMON.NAMES'
7266 include 'COMMON.IOUNITS'
7267 include 'COMMON.FFIELD'
7268 include 'COMMON.TORCNSTR'
7269 include 'COMMON.CONTROL'
7271 C Set lprn=.true. for debugging
7275 do i=iphi_start,iphi_end
7276 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7277 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7278 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7279 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7280 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7281 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7282 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7283 C For introducing the NH3+ and COO- group please check the etor_d for reference
7286 if (iabs(itype(i)).eq.20) then
7291 itori=itortyp(itype(i-2))
7292 itori1=itortyp(itype(i-1))
7295 C Regular cosine and sine terms
7296 do j=1,nterm(itori,itori1,iblock)
7297 v1ij=v1(j,itori,itori1,iblock)
7298 v2ij=v2(j,itori,itori1,iblock)
7301 etors=etors+v1ij*cosphi+v2ij*sinphi
7302 if (energy_dec) etors_ii=etors_ii+
7303 & v1ij*cosphi+v2ij*sinphi
7304 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7308 C E = SUM ----------------------------------- - v1
7309 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7311 cosphi=dcos(0.5d0*phii)
7312 sinphi=dsin(0.5d0*phii)
7313 do j=1,nlor(itori,itori1,iblock)
7314 vl1ij=vlor1(j,itori,itori1)
7315 vl2ij=vlor2(j,itori,itori1)
7316 vl3ij=vlor3(j,itori,itori1)
7317 pom=vl2ij*cosphi+vl3ij*sinphi
7318 pom1=1.0d0/(pom*pom+1.0d0)
7319 etors=etors+vl1ij*pom1
7320 if (energy_dec) etors_ii=etors_ii+
7323 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7325 C Subtract the constant term
7326 etors=etors-v0(itori,itori1,iblock)
7327 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7328 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
7330 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7331 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7332 & (v1(j,itori,itori1,iblock),j=1,6),
7333 & (v2(j,itori,itori1,iblock),j=1,6)
7334 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7335 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7337 ! 6/20/98 - dihedral angle constraints
7339 c do i=1,ndih_constr
7340 do i=idihconstr_start,idihconstr_end
7341 itori=idih_constr(i)
7343 difi=pinorm(phii-phi0(i))
7344 if (difi.gt.drange(i)) then
7346 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7347 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7348 else if (difi.lt.-drange(i)) then
7350 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7351 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7355 if (energy_dec) then
7356 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
7357 & i,itori,rad2deg*phii,
7358 & rad2deg*phi0(i), rad2deg*drange(i),
7359 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
7362 cd write (iout,*) 'edihcnstr',edihcnstr
7365 c----------------------------------------------------------------------------
7366 subroutine etor_d(etors_d)
7367 C 6/23/01 Compute double torsional energy
7368 implicit real*8 (a-h,o-z)
7369 include 'DIMENSIONS'
7370 include 'COMMON.VAR'
7371 include 'COMMON.GEO'
7372 include 'COMMON.LOCAL'
7373 include 'COMMON.TORSION'
7374 include 'COMMON.INTERACT'
7375 include 'COMMON.DERIV'
7376 include 'COMMON.CHAIN'
7377 include 'COMMON.NAMES'
7378 include 'COMMON.IOUNITS'
7379 include 'COMMON.FFIELD'
7380 include 'COMMON.TORCNSTR'
7382 C Set lprn=.true. for debugging
7386 c write(iout,*) "a tu??"
7387 do i=iphid_start,iphid_end
7388 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7389 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7390 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7391 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7392 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7393 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7394 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7395 & (itype(i+1).eq.ntyp1)) cycle
7396 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7397 itori=itortyp(itype(i-2))
7398 itori1=itortyp(itype(i-1))
7399 itori2=itortyp(itype(i))
7405 if (iabs(itype(i+1)).eq.20) iblock=2
7406 C Iblock=2 Proline type
7407 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7408 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7409 C if (itype(i+1).eq.ntyp1) iblock=3
7410 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7411 C IS or IS NOT need for this
7412 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7413 C is (itype(i-3).eq.ntyp1) ntblock=2
7414 C ntblock is N-terminal blocking group
7416 C Regular cosine and sine terms
7417 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7418 C Example of changes for NH3+ blocking group
7419 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7420 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7421 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7422 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7423 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7424 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7425 cosphi1=dcos(j*phii)
7426 sinphi1=dsin(j*phii)
7427 cosphi2=dcos(j*phii1)
7428 sinphi2=dsin(j*phii1)
7429 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7430 & v2cij*cosphi2+v2sij*sinphi2
7431 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7432 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7434 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7436 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7437 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7438 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7439 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7440 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7441 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7442 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7443 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7444 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7445 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7446 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7447 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7448 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7449 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7452 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7453 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7458 C----------------------------------------------------------------------------------
7459 C The rigorous attempt to derive energy function
7460 subroutine etor_kcc(etors,edihcnstr)
7461 implicit real*8 (a-h,o-z)
7462 include 'DIMENSIONS'
7463 include 'COMMON.VAR'
7464 include 'COMMON.GEO'
7465 include 'COMMON.LOCAL'
7466 include 'COMMON.TORSION'
7467 include 'COMMON.INTERACT'
7468 include 'COMMON.DERIV'
7469 include 'COMMON.CHAIN'
7470 include 'COMMON.NAMES'
7471 include 'COMMON.IOUNITS'
7472 include 'COMMON.FFIELD'
7473 include 'COMMON.TORCNSTR'
7474 include 'COMMON.CONTROL'
7476 double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
7477 C Set lprn=.true. for debugging
7480 C print *,"wchodze kcc"
7481 if (tor_mode.ne.2) then
7484 do i=iphi_start,iphi_end
7485 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7486 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7487 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7488 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7489 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7490 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7491 itori=itortyp_kcc(itype(i-2))
7492 itori1=itortyp_kcc(itype(i-1))
7497 sumnonchebyshev=0.0d0
7499 C to avoid multiple devision by 2
7500 theti22=0.5d0*theta(i)
7501 C theta 12 is the theta_1 /2
7502 C theta 22 is theta_2 /2
7503 theti12=0.5d0*theta(i-1)
7504 C and appropriate sinus function
7505 sinthet2=dsin(theta(i))
7506 sinthet1=dsin(theta(i-1))
7507 costhet1=dcos(theta(i-1))
7508 costhet2=dcos(theta(i))
7509 C to speed up lets store its mutliplication
7510 sint1t2=sinthet2*sinthet1
7511 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
7512 C +d_n*sin(n*gamma)) *
7513 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
7514 C we have two sum 1) Non-Chebyshev which is with n and gamma
7515 do j=1,nterm_kcc(itori,itori1)
7517 v1ij=v1_kcc(j,itori,itori1)
7518 v2ij=v2_kcc(j,itori,itori1)
7519 C v1ij is c_n and d_n in euation above
7524 & sint1t2n*(v1ij*cosphi+v2ij*sinphi)
7525 actval=sint1t2n*(v1ij*cosphi+v2ij*sinphi)
7526 C etors=etors+sint1t2n*(v1ij*cosphi+v2ij*sinphi)
7527 C if (energy_dec) etors_ii=etors_ii+
7528 C & v1ij*cosphi+v2ij*sinphi
7529 C glocig is the gradient local i site in gamma
7530 glocig=j*(v2ij*cosphi-v1ij*sinphi)*sint1t2n
7531 C now gradient over theta_1
7532 glocit1=actval/sinthet1*j*costhet1
7533 glocit2=actval/sinthet2*j*costhet2
7535 C now the Czebyshev polinominal sum
7536 do k=1,nterm_kcc_Tb(itori,itori1)
7537 thybt1(k)=v1_chyb(k,j,itori,itori1)
7538 thybt2(k)=v2_chyb(k,j,itori,itori1)
7542 sumth1thyb=tschebyshev
7543 & (1,nterm_kcc_Tb(itori,itori1),thybt1(1),dcos(theti12)**2)
7544 gradthybt1=gradtschebyshev
7545 & (0,nterm_kcc_Tb(itori,itori1)-1,thybt1(1),
7547 & *dcos(theti12)*(-dsin(theti12))
7548 sumth2thyb=tschebyshev
7549 & (1,nterm_kcc_Tb(itori,itori1),thybt2(1),dcos(theti22)**2)
7550 gradthybt2=gradtschebyshev
7551 & (0,nterm_kcc_Tb(itori,itori1)-1,thybt2(1),
7553 & *dcos(theti22)*(-dsin(theti22))
7554 C print *, sumth1thyb, gradthybt1, sumth2thyb, gradthybt2,
7556 C & (0,nterm_kcc_Tb(itori,itori1)-1,thybt2(1),
7557 C & dcos(theti22)**2),
7560 C now overal sumation
7561 etors=etors+(1.0d0+sumth1thyb+sumth2thyb)*sumnonchebyshev
7562 C print *,"sumnon", sumnonchebyshev,sumth1thyb+sumth2thyb
7563 C derivative over gamma
7564 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
7565 & *(1.0d0+sumth1thyb+sumth2thyb)
7566 C derivative over theta1
7567 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*
7568 & (glocit1*(1.0d0+sumth1thyb+sumth2thyb)+
7569 & sumnonchebyshev*gradthybt1)
7570 C now derivative over theta2
7571 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*
7572 & (glocit2*(1.0d0+sumth1thyb+sumth2thyb)+
7573 & sumnonchebyshev*gradthybt2)
7577 C gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7578 ! 6/20/98 - dihedral angle constraints
7579 if (tor_mode.ne.2) then
7581 c do i=1,ndih_constr
7582 do i=idihconstr_start,idihconstr_end
7583 itori=idih_constr(i)
7585 difi=pinorm(phii-phi0(i))
7586 if (difi.gt.drange(i)) then
7588 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7589 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7590 else if (difi.lt.-drange(i)) then
7592 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7593 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7602 C The rigorous attempt to derive energy function
7603 subroutine ebend_kcc(etheta,ethetacnstr)
7605 implicit real*8 (a-h,o-z)
7606 include 'DIMENSIONS'
7607 include 'COMMON.VAR'
7608 include 'COMMON.GEO'
7609 include 'COMMON.LOCAL'
7610 include 'COMMON.TORSION'
7611 include 'COMMON.INTERACT'
7612 include 'COMMON.DERIV'
7613 include 'COMMON.CHAIN'
7614 include 'COMMON.NAMES'
7615 include 'COMMON.IOUNITS'
7616 include 'COMMON.FFIELD'
7617 include 'COMMON.TORCNSTR'
7618 include 'COMMON.CONTROL'
7620 double precision thybt1(maxtermkcc)
7621 C Set lprn=.true. for debugging
7624 C print *,"wchodze kcc"
7625 if (tormode.ne.2) etheta=0.0D0
7626 do i=ithet_start,ithet_end
7627 c print *,i,itype(i-1),itype(i),itype(i-2)
7628 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
7629 & .or.itype(i).eq.ntyp1) cycle
7630 iti=itortyp_kcc(itype(i-1))
7631 sinthet=dsin(theta(i)/2.0d0)
7632 costhet=dcos(theta(i)/2.0d0)
7633 do j=1,nbend_kcc_Tb(iti)
7634 thybt1(j)=v1bend_chyb(j,iti)
7636 sumth1thyb=tschebyshev
7637 & (1,nbend_kcc_Tb(iti),thybt1(1),costhet)
7638 ihelp=nbend_kcc_Tb(iti)-1
7639 gradthybt1=gradtschebyshev
7640 & (0,ihelp,thybt1(1),costhet)
7641 etheta=etheta+sumth1thyb
7642 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
7643 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*
7644 & gradthybt1*sinthet*(-0.5d0)
7646 if (tormode.ne.2) then
7648 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
7649 do i=ithetaconstr_start,ithetaconstr_end
7650 itheta=itheta_constr(i)
7651 thetiii=theta(itheta)
7652 difi=pinorm(thetiii-theta_constr0(i))
7653 if (difi.gt.theta_drange(i)) then
7654 difi=difi-theta_drange(i)
7655 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7656 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7657 & +for_thet_constr(i)*difi**3
7658 else if (difi.lt.-drange(i)) then
7660 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7661 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7662 & +for_thet_constr(i)*difi**3
7666 if (energy_dec) then
7667 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
7668 & i,itheta,rad2deg*thetiii,
7669 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
7670 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
7671 & gloc(itheta+nphi-2,icg)
7677 c------------------------------------------------------------------------------
7678 subroutine eback_sc_corr(esccor)
7679 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7680 c conformational states; temporarily implemented as differences
7681 c between UNRES torsional potentials (dependent on three types of
7682 c residues) and the torsional potentials dependent on all 20 types
7683 c of residues computed from AM1 energy surfaces of terminally-blocked
7684 c amino-acid residues.
7685 implicit real*8 (a-h,o-z)
7686 include 'DIMENSIONS'
7687 include 'COMMON.VAR'
7688 include 'COMMON.GEO'
7689 include 'COMMON.LOCAL'
7690 include 'COMMON.TORSION'
7691 include 'COMMON.SCCOR'
7692 include 'COMMON.INTERACT'
7693 include 'COMMON.DERIV'
7694 include 'COMMON.CHAIN'
7695 include 'COMMON.NAMES'
7696 include 'COMMON.IOUNITS'
7697 include 'COMMON.FFIELD'
7698 include 'COMMON.CONTROL'
7700 C Set lprn=.true. for debugging
7703 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7705 do i=itau_start,itau_end
7706 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7708 isccori=isccortyp(itype(i-2))
7709 isccori1=isccortyp(itype(i-1))
7710 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7712 do intertyp=1,3 !intertyp
7713 cc Added 09 May 2012 (Adasko)
7714 cc Intertyp means interaction type of backbone mainchain correlation:
7715 c 1 = SC...Ca...Ca...Ca
7716 c 2 = Ca...Ca...Ca...SC
7717 c 3 = SC...Ca...Ca...SCi
7719 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7720 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7721 & (itype(i-1).eq.ntyp1)))
7722 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7723 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7724 & .or.(itype(i).eq.ntyp1)))
7725 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7726 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7727 & (itype(i-3).eq.ntyp1)))) cycle
7728 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7729 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7731 do j=1,nterm_sccor(isccori,isccori1)
7732 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7733 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7734 cosphi=dcos(j*tauangle(intertyp,i))
7735 sinphi=dsin(j*tauangle(intertyp,i))
7736 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7737 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7739 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7740 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7742 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7743 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
7744 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
7745 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7746 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7752 c----------------------------------------------------------------------------
7753 subroutine multibody(ecorr)
7754 C This subroutine calculates multi-body contributions to energy following
7755 C the idea of Skolnick et al. If side chains I and J make a contact and
7756 C at the same time side chains I+1 and J+1 make a contact, an extra
7757 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7758 implicit real*8 (a-h,o-z)
7759 include 'DIMENSIONS'
7760 include 'COMMON.IOUNITS'
7761 include 'COMMON.DERIV'
7762 include 'COMMON.INTERACT'
7763 include 'COMMON.CONTACTS'
7764 double precision gx(3),gx1(3)
7767 C Set lprn=.true. for debugging
7771 write (iout,'(a)') 'Contact function values:'
7773 write (iout,'(i2,20(1x,i2,f10.5))')
7774 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7789 num_conti=num_cont(i)
7790 num_conti1=num_cont(i1)
7795 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7796 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7797 cd & ' ishift=',ishift
7798 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7799 C The system gains extra energy.
7800 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7801 endif ! j1==j+-ishift
7810 c------------------------------------------------------------------------------
7811 double precision function esccorr(i,j,k,l,jj,kk)
7812 implicit real*8 (a-h,o-z)
7813 include 'DIMENSIONS'
7814 include 'COMMON.IOUNITS'
7815 include 'COMMON.DERIV'
7816 include 'COMMON.INTERACT'
7817 include 'COMMON.CONTACTS'
7818 include 'COMMON.SHIELD'
7819 double precision gx(3),gx1(3)
7824 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7825 C Calculate the multi-body contribution to energy.
7826 C Calculate multi-body contributions to the gradient.
7827 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7828 cd & k,l,(gacont(m,kk,k),m=1,3)
7830 gx(m) =ekl*gacont(m,jj,i)
7831 gx1(m)=eij*gacont(m,kk,k)
7832 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7833 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7834 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7835 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7839 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7844 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7850 c------------------------------------------------------------------------------
7851 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7852 C This subroutine calculates multi-body contributions to hydrogen-bonding
7853 implicit real*8 (a-h,o-z)
7854 include 'DIMENSIONS'
7855 include 'COMMON.IOUNITS'
7858 parameter (max_cont=maxconts)
7859 parameter (max_dim=26)
7860 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7861 double precision zapas(max_dim,maxconts,max_fg_procs),
7862 & zapas_recv(max_dim,maxconts,max_fg_procs)
7863 common /przechowalnia/ zapas
7864 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7865 & status_array(MPI_STATUS_SIZE,maxconts*2)
7867 include 'COMMON.SETUP'
7868 include 'COMMON.FFIELD'
7869 include 'COMMON.DERIV'
7870 include 'COMMON.INTERACT'
7871 include 'COMMON.CONTACTS'
7872 include 'COMMON.CONTROL'
7873 include 'COMMON.LOCAL'
7874 double precision gx(3),gx1(3),time00
7877 C Set lprn=.true. for debugging
7882 if (nfgtasks.le.1) goto 30
7884 write (iout,'(a)') 'Contact function values before RECEIVE:'
7886 write (iout,'(2i3,50(1x,i2,f5.2))')
7887 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7888 & j=1,num_cont_hb(i))
7892 do i=1,ntask_cont_from
7895 do i=1,ntask_cont_to
7898 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7900 C Make the list of contacts to send to send to other procesors
7901 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7903 do i=iturn3_start,iturn3_end
7904 c write (iout,*) "make contact list turn3",i," num_cont",
7906 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7908 do i=iturn4_start,iturn4_end
7909 c write (iout,*) "make contact list turn4",i," num_cont",
7911 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7915 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7917 do j=1,num_cont_hb(i)
7920 iproc=iint_sent_local(k,jjc,ii)
7921 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7922 if (iproc.gt.0) then
7923 ncont_sent(iproc)=ncont_sent(iproc)+1
7924 nn=ncont_sent(iproc)
7926 zapas(2,nn,iproc)=jjc
7927 zapas(3,nn,iproc)=facont_hb(j,i)
7928 zapas(4,nn,iproc)=ees0p(j,i)
7929 zapas(5,nn,iproc)=ees0m(j,i)
7930 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7931 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7932 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7933 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7934 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7935 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7936 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7937 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7938 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7939 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7940 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7941 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7942 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7943 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7944 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7945 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7946 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7947 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7948 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7949 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7950 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7957 & "Numbers of contacts to be sent to other processors",
7958 & (ncont_sent(i),i=1,ntask_cont_to)
7959 write (iout,*) "Contacts sent"
7960 do ii=1,ntask_cont_to
7962 iproc=itask_cont_to(ii)
7963 write (iout,*) nn," contacts to processor",iproc,
7964 & " of CONT_TO_COMM group"
7966 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7974 CorrelID1=nfgtasks+fg_rank+1
7976 C Receive the numbers of needed contacts from other processors
7977 do ii=1,ntask_cont_from
7978 iproc=itask_cont_from(ii)
7980 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7981 & FG_COMM,req(ireq),IERR)
7983 c write (iout,*) "IRECV ended"
7985 C Send the number of contacts needed by other processors
7986 do ii=1,ntask_cont_to
7987 iproc=itask_cont_to(ii)
7989 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7990 & FG_COMM,req(ireq),IERR)
7992 c write (iout,*) "ISEND ended"
7993 c write (iout,*) "number of requests (nn)",ireq
7996 & call MPI_Waitall(ireq,req,status_array,ierr)
7998 c & "Numbers of contacts to be received from other processors",
7999 c & (ncont_recv(i),i=1,ntask_cont_from)
8003 do ii=1,ntask_cont_from
8004 iproc=itask_cont_from(ii)
8006 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8007 c & " of CONT_TO_COMM group"
8011 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8012 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8013 c write (iout,*) "ireq,req",ireq,req(ireq)
8016 C Send the contacts to processors that need them
8017 do ii=1,ntask_cont_to
8018 iproc=itask_cont_to(ii)
8020 c write (iout,*) nn," contacts to processor",iproc,
8021 c & " of CONT_TO_COMM group"
8024 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8025 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8026 c write (iout,*) "ireq,req",ireq,req(ireq)
8028 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8032 c write (iout,*) "number of requests (contacts)",ireq
8033 c write (iout,*) "req",(req(i),i=1,4)
8036 & call MPI_Waitall(ireq,req,status_array,ierr)
8037 do iii=1,ntask_cont_from
8038 iproc=itask_cont_from(iii)
8041 write (iout,*) "Received",nn," contacts from processor",iproc,
8042 & " of CONT_FROM_COMM group"
8045 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8050 ii=zapas_recv(1,i,iii)
8051 c Flag the received contacts to prevent double-counting
8052 jj=-zapas_recv(2,i,iii)
8053 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8055 nnn=num_cont_hb(ii)+1
8058 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8059 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8060 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8061 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8062 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8063 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8064 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8065 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8066 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8067 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8068 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8069 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8070 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8071 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8072 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8073 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8074 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8075 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8076 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8077 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8078 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8079 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8080 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8081 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8086 write (iout,'(a)') 'Contact function values after receive:'
8088 write (iout,'(2i3,50(1x,i3,f5.2))')
8089 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8090 & j=1,num_cont_hb(i))
8097 write (iout,'(a)') 'Contact function values:'
8099 write (iout,'(2i3,50(1x,i3,f5.2))')
8100 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8101 & j=1,num_cont_hb(i))
8105 C Remove the loop below after debugging !!!
8112 C Calculate the local-electrostatic correlation terms
8113 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8115 num_conti=num_cont_hb(i)
8116 num_conti1=num_cont_hb(i+1)
8123 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8124 c & ' jj=',jj,' kk=',kk
8125 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8126 & .or. j.lt.0 .and. j1.gt.0) .and.
8127 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8128 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8129 C The system gains extra energy.
8130 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8131 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
8132 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
8134 else if (j1.eq.j) then
8135 C Contacts I-J and I-(J+1) occur simultaneously.
8136 C The system loses extra energy.
8137 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8142 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8143 c & ' jj=',jj,' kk=',kk
8145 C Contacts I-J and (I+1)-J occur simultaneously.
8146 C The system loses extra energy.
8147 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8154 c------------------------------------------------------------------------------
8155 subroutine add_hb_contact(ii,jj,itask)
8156 implicit real*8 (a-h,o-z)
8157 include "DIMENSIONS"
8158 include "COMMON.IOUNITS"
8161 parameter (max_cont=maxconts)
8162 parameter (max_dim=26)
8163 include "COMMON.CONTACTS"
8164 double precision zapas(max_dim,maxconts,max_fg_procs),
8165 & zapas_recv(max_dim,maxconts,max_fg_procs)
8166 common /przechowalnia/ zapas
8167 integer i,j,ii,jj,iproc,itask(4),nn
8168 c write (iout,*) "itask",itask
8171 if (iproc.gt.0) then
8172 do j=1,num_cont_hb(ii)
8174 c write (iout,*) "i",ii," j",jj," jjc",jjc
8176 ncont_sent(iproc)=ncont_sent(iproc)+1
8177 nn=ncont_sent(iproc)
8178 zapas(1,nn,iproc)=ii
8179 zapas(2,nn,iproc)=jjc
8180 zapas(3,nn,iproc)=facont_hb(j,ii)
8181 zapas(4,nn,iproc)=ees0p(j,ii)
8182 zapas(5,nn,iproc)=ees0m(j,ii)
8183 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8184 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8185 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8186 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8187 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8188 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8189 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8190 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8191 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8192 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8193 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8194 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8195 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8196 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8197 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8198 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8199 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8200 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8201 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8202 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8203 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8211 c------------------------------------------------------------------------------
8212 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8214 C This subroutine calculates multi-body contributions to hydrogen-bonding
8215 implicit real*8 (a-h,o-z)
8216 include 'DIMENSIONS'
8217 include 'COMMON.IOUNITS'
8220 parameter (max_cont=maxconts)
8221 parameter (max_dim=70)
8222 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8223 double precision zapas(max_dim,maxconts,max_fg_procs),
8224 & zapas_recv(max_dim,maxconts,max_fg_procs)
8225 common /przechowalnia/ zapas
8226 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8227 & status_array(MPI_STATUS_SIZE,maxconts*2)
8229 include 'COMMON.SETUP'
8230 include 'COMMON.FFIELD'
8231 include 'COMMON.DERIV'
8232 include 'COMMON.LOCAL'
8233 include 'COMMON.INTERACT'
8234 include 'COMMON.CONTACTS'
8235 include 'COMMON.CHAIN'
8236 include 'COMMON.CONTROL'
8237 include 'COMMON.SHIELD'
8238 double precision gx(3),gx1(3)
8239 integer num_cont_hb_old(maxres)
8241 double precision eello4,eello5,eelo6,eello_turn6
8242 external eello4,eello5,eello6,eello_turn6
8243 C Set lprn=.true. for debugging
8248 num_cont_hb_old(i)=num_cont_hb(i)
8252 if (nfgtasks.le.1) goto 30
8254 write (iout,'(a)') 'Contact function values before RECEIVE:'
8256 write (iout,'(2i3,50(1x,i2,f5.2))')
8257 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8258 & j=1,num_cont_hb(i))
8262 do i=1,ntask_cont_from
8265 do i=1,ntask_cont_to
8268 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8270 C Make the list of contacts to send to send to other procesors
8271 do i=iturn3_start,iturn3_end
8272 c write (iout,*) "make contact list turn3",i," num_cont",
8274 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8276 do i=iturn4_start,iturn4_end
8277 c write (iout,*) "make contact list turn4",i," num_cont",
8279 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8283 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8285 do j=1,num_cont_hb(i)
8288 iproc=iint_sent_local(k,jjc,ii)
8289 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8290 if (iproc.ne.0) then
8291 ncont_sent(iproc)=ncont_sent(iproc)+1
8292 nn=ncont_sent(iproc)
8294 zapas(2,nn,iproc)=jjc
8295 zapas(3,nn,iproc)=d_cont(j,i)
8299 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8304 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8312 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8323 & "Numbers of contacts to be sent to other processors",
8324 & (ncont_sent(i),i=1,ntask_cont_to)
8325 write (iout,*) "Contacts sent"
8326 do ii=1,ntask_cont_to
8328 iproc=itask_cont_to(ii)
8329 write (iout,*) nn," contacts to processor",iproc,
8330 & " of CONT_TO_COMM group"
8332 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8340 CorrelID1=nfgtasks+fg_rank+1
8342 C Receive the numbers of needed contacts from other processors
8343 do ii=1,ntask_cont_from
8344 iproc=itask_cont_from(ii)
8346 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8347 & FG_COMM,req(ireq),IERR)
8349 c write (iout,*) "IRECV ended"
8351 C Send the number of contacts needed by other processors
8352 do ii=1,ntask_cont_to
8353 iproc=itask_cont_to(ii)
8355 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8356 & FG_COMM,req(ireq),IERR)
8358 c write (iout,*) "ISEND ended"
8359 c write (iout,*) "number of requests (nn)",ireq
8362 & call MPI_Waitall(ireq,req,status_array,ierr)
8364 c & "Numbers of contacts to be received from other processors",
8365 c & (ncont_recv(i),i=1,ntask_cont_from)
8369 do ii=1,ntask_cont_from
8370 iproc=itask_cont_from(ii)
8372 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8373 c & " of CONT_TO_COMM group"
8377 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8378 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8379 c write (iout,*) "ireq,req",ireq,req(ireq)
8382 C Send the contacts to processors that need them
8383 do ii=1,ntask_cont_to
8384 iproc=itask_cont_to(ii)
8386 c write (iout,*) nn," contacts to processor",iproc,
8387 c & " of CONT_TO_COMM group"
8390 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8391 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8392 c write (iout,*) "ireq,req",ireq,req(ireq)
8394 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8398 c write (iout,*) "number of requests (contacts)",ireq
8399 c write (iout,*) "req",(req(i),i=1,4)
8402 & call MPI_Waitall(ireq,req,status_array,ierr)
8403 do iii=1,ntask_cont_from
8404 iproc=itask_cont_from(iii)
8407 write (iout,*) "Received",nn," contacts from processor",iproc,
8408 & " of CONT_FROM_COMM group"
8411 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8416 ii=zapas_recv(1,i,iii)
8417 c Flag the received contacts to prevent double-counting
8418 jj=-zapas_recv(2,i,iii)
8419 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8421 nnn=num_cont_hb(ii)+1
8424 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8428 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8433 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8441 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8450 write (iout,'(a)') 'Contact function values after receive:'
8452 write (iout,'(2i3,50(1x,i3,5f6.3))')
8453 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8454 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8461 write (iout,'(a)') 'Contact function values:'
8463 write (iout,'(2i3,50(1x,i2,5f6.3))')
8464 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8465 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8471 C Remove the loop below after debugging !!!
8478 C Calculate the dipole-dipole interaction energies
8479 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8480 do i=iatel_s,iatel_e+1
8481 num_conti=num_cont_hb(i)
8490 C Calculate the local-electrostatic correlation terms
8491 c write (iout,*) "gradcorr5 in eello5 before loop"
8493 c write (iout,'(i5,3f10.5)')
8494 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8496 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8497 c write (iout,*) "corr loop i",i
8499 num_conti=num_cont_hb(i)
8500 num_conti1=num_cont_hb(i+1)
8507 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8508 c & ' jj=',jj,' kk=',kk
8509 c if (j1.eq.j+1 .or. j1.eq.j-1) then
8510 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8511 & .or. j.lt.0 .and. j1.gt.0) .and.
8512 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8513 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8514 C The system gains extra energy.
8516 sqd1=dsqrt(d_cont(jj,i))
8517 sqd2=dsqrt(d_cont(kk,i1))
8518 sred_geom = sqd1*sqd2
8519 IF (sred_geom.lt.cutoff_corr) THEN
8520 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
8522 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8523 cd & ' jj=',jj,' kk=',kk
8524 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8525 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8527 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8528 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8531 cd write (iout,*) 'sred_geom=',sred_geom,
8532 cd & ' ekont=',ekont,' fprim=',fprimcont,
8533 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8534 cd write (iout,*) "g_contij",g_contij
8535 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8536 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8537 call calc_eello(i,jp,i+1,jp1,jj,kk)
8538 if (wcorr4.gt.0.0d0)
8539 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8540 CC & *fac_shield(i)**2*fac_shield(j)**2
8541 if (energy_dec.and.wcorr4.gt.0.0d0)
8542 1 write (iout,'(a6,4i5,0pf7.3)')
8543 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8544 c write (iout,*) "gradcorr5 before eello5"
8546 c write (iout,'(i5,3f10.5)')
8547 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8549 if (wcorr5.gt.0.0d0)
8550 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8551 c write (iout,*) "gradcorr5 after eello5"
8553 c write (iout,'(i5,3f10.5)')
8554 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8556 if (energy_dec.and.wcorr5.gt.0.0d0)
8557 1 write (iout,'(a6,4i5,0pf7.3)')
8558 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8559 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8560 cd write(2,*)'ijkl',i,jp,i+1,jp1
8561 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
8562 & .or. wturn6.eq.0.0d0))then
8563 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8564 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8565 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8566 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8567 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8568 cd & 'ecorr6=',ecorr6
8569 cd write (iout,'(4e15.5)') sred_geom,
8570 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8571 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8572 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8573 else if (wturn6.gt.0.0d0
8574 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8575 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8576 eturn6=eturn6+eello_turn6(i,jj,kk)
8577 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8578 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8579 cd write (2,*) 'multibody_eello:eturn6',eturn6
8588 num_cont_hb(i)=num_cont_hb_old(i)
8590 c write (iout,*) "gradcorr5 in eello5"
8592 c write (iout,'(i5,3f10.5)')
8593 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8597 c------------------------------------------------------------------------------
8598 subroutine add_hb_contact_eello(ii,jj,itask)
8599 implicit real*8 (a-h,o-z)
8600 include "DIMENSIONS"
8601 include "COMMON.IOUNITS"
8604 parameter (max_cont=maxconts)
8605 parameter (max_dim=70)
8606 include "COMMON.CONTACTS"
8607 double precision zapas(max_dim,maxconts,max_fg_procs),
8608 & zapas_recv(max_dim,maxconts,max_fg_procs)
8609 common /przechowalnia/ zapas
8610 integer i,j,ii,jj,iproc,itask(4),nn
8611 c write (iout,*) "itask",itask
8614 if (iproc.gt.0) then
8615 do j=1,num_cont_hb(ii)
8617 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8619 ncont_sent(iproc)=ncont_sent(iproc)+1
8620 nn=ncont_sent(iproc)
8621 zapas(1,nn,iproc)=ii
8622 zapas(2,nn,iproc)=jjc
8623 zapas(3,nn,iproc)=d_cont(j,ii)
8627 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8632 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8640 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8652 c------------------------------------------------------------------------------
8653 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8654 implicit real*8 (a-h,o-z)
8655 include 'DIMENSIONS'
8656 include 'COMMON.IOUNITS'
8657 include 'COMMON.DERIV'
8658 include 'COMMON.INTERACT'
8659 include 'COMMON.CONTACTS'
8660 include 'COMMON.SHIELD'
8661 include 'COMMON.CONTROL'
8662 double precision gx(3),gx1(3)
8665 C print *,"wchodze",fac_shield(i),shield_mode
8673 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8675 C & fac_shield(i)**2*fac_shield(j)**2
8676 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8677 C Following 4 lines for diagnostics.
8682 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8683 c & 'Contacts ',i,j,
8684 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8685 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8687 C Calculate the multi-body contribution to energy.
8688 C ecorr=ecorr+ekont*ees
8689 C Calculate multi-body contributions to the gradient.
8690 coeffpees0pij=coeffp*ees0pij
8691 coeffmees0mij=coeffm*ees0mij
8692 coeffpees0pkl=coeffp*ees0pkl
8693 coeffmees0mkl=coeffm*ees0mkl
8695 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8696 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8697 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8698 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8699 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8700 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8701 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8702 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8703 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8704 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8705 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8706 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8707 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8708 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8709 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8710 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8711 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8712 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8713 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8714 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8715 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8716 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8717 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8718 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8719 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8724 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8725 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8726 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8727 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8732 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8733 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8734 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8735 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8738 c write (iout,*) "ehbcorr",ekont*ees
8739 C print *,ekont,ees,i,k
8741 C now gradient over shielding
8743 if (shield_mode.gt.0) then
8746 C print *,i,j,fac_shield(i),fac_shield(j),
8747 C &fac_shield(k),fac_shield(l)
8748 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
8749 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8750 do ilist=1,ishield_list(i)
8751 iresshield=shield_list(ilist,i)
8753 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8755 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8757 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8758 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8762 do ilist=1,ishield_list(j)
8763 iresshield=shield_list(ilist,j)
8765 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8767 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8769 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8770 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8775 do ilist=1,ishield_list(k)
8776 iresshield=shield_list(ilist,k)
8778 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8780 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8782 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8783 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8787 do ilist=1,ishield_list(l)
8788 iresshield=shield_list(ilist,l)
8790 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8792 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8794 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8795 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8799 C print *,gshieldx(m,iresshield)
8801 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
8802 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8803 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
8804 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8805 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
8806 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8807 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
8808 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8810 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
8811 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8812 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
8813 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8814 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
8815 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8816 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
8817 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8825 C---------------------------------------------------------------------------
8826 subroutine dipole(i,j,jj)
8827 implicit real*8 (a-h,o-z)
8828 include 'DIMENSIONS'
8829 include 'COMMON.IOUNITS'
8830 include 'COMMON.CHAIN'
8831 include 'COMMON.FFIELD'
8832 include 'COMMON.DERIV'
8833 include 'COMMON.INTERACT'
8834 include 'COMMON.CONTACTS'
8835 include 'COMMON.TORSION'
8836 include 'COMMON.VAR'
8837 include 'COMMON.GEO'
8838 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8840 iti1 = itortyp(itype(i+1))
8841 if (j.lt.nres-1) then
8842 itj1 = itortyp(itype(j+1))
8847 dipi(iii,1)=Ub2(iii,i)
8848 dipderi(iii)=Ub2der(iii,i)
8849 dipi(iii,2)=b1(iii,i+1)
8850 dipj(iii,1)=Ub2(iii,j)
8851 dipderj(iii)=Ub2der(iii,j)
8852 dipj(iii,2)=b1(iii,j+1)
8856 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8859 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8866 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8870 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8875 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8876 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8878 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8880 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8882 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8887 C---------------------------------------------------------------------------
8888 subroutine calc_eello(i,j,k,l,jj,kk)
8890 C This subroutine computes matrices and vectors needed to calculate
8891 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8893 implicit real*8 (a-h,o-z)
8894 include 'DIMENSIONS'
8895 include 'COMMON.IOUNITS'
8896 include 'COMMON.CHAIN'
8897 include 'COMMON.DERIV'
8898 include 'COMMON.INTERACT'
8899 include 'COMMON.CONTACTS'
8900 include 'COMMON.TORSION'
8901 include 'COMMON.VAR'
8902 include 'COMMON.GEO'
8903 include 'COMMON.FFIELD'
8904 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8905 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8908 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8909 cd & ' jj=',jj,' kk=',kk
8910 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8911 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8912 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8915 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8916 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8919 call transpose2(aa1(1,1),aa1t(1,1))
8920 call transpose2(aa2(1,1),aa2t(1,1))
8923 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8924 & aa1tder(1,1,lll,kkk))
8925 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8926 & aa2tder(1,1,lll,kkk))
8930 C parallel orientation of the two CA-CA-CA frames.
8932 iti=itortyp(itype(i))
8936 itk1=itortyp(itype(k+1))
8937 itj=itortyp(itype(j))
8938 if (l.lt.nres-1) then
8939 itl1=itortyp(itype(l+1))
8943 C A1 kernel(j+1) A2T
8945 cd write (iout,'(3f10.5,5x,3f10.5)')
8946 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8948 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8949 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8950 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8951 C Following matrices are needed only for 6-th order cumulants
8952 IF (wcorr6.gt.0.0d0) THEN
8953 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8954 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8955 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8956 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8957 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8958 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8959 & ADtEAderx(1,1,1,1,1,1))
8961 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8962 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8963 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8964 & ADtEA1derx(1,1,1,1,1,1))
8966 C End 6-th order cumulants
8969 cd write (2,*) 'In calc_eello6'
8971 cd write (2,*) 'iii=',iii
8973 cd write (2,*) 'kkk=',kkk
8975 cd write (2,'(3(2f10.5),5x)')
8976 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8981 call transpose2(EUgder(1,1,k),auxmat(1,1))
8982 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8983 call transpose2(EUg(1,1,k),auxmat(1,1))
8984 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8985 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8989 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8990 & EAEAderx(1,1,lll,kkk,iii,1))
8994 C A1T kernel(i+1) A2
8995 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8996 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8997 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8998 C Following matrices are needed only for 6-th order cumulants
8999 IF (wcorr6.gt.0.0d0) THEN
9000 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9001 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
9002 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9003 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9004 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
9005 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9006 & ADtEAderx(1,1,1,1,1,2))
9007 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9008 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
9009 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9010 & ADtEA1derx(1,1,1,1,1,2))
9012 C End 6-th order cumulants
9013 call transpose2(EUgder(1,1,l),auxmat(1,1))
9014 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
9015 call transpose2(EUg(1,1,l),auxmat(1,1))
9016 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9017 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9021 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9022 & EAEAderx(1,1,lll,kkk,iii,2))
9027 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9028 C They are needed only when the fifth- or the sixth-order cumulants are
9030 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
9031 call transpose2(AEA(1,1,1),auxmat(1,1))
9032 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9033 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9034 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9035 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9036 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9037 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9038 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9039 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9040 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9041 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9042 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9043 call transpose2(AEA(1,1,2),auxmat(1,1))
9044 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
9045 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
9046 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
9047 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9048 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
9049 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
9050 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
9051 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
9052 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
9053 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
9054 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
9055 C Calculate the Cartesian derivatives of the vectors.
9059 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9060 call matvec2(auxmat(1,1),b1(1,i),
9061 & AEAb1derx(1,lll,kkk,iii,1,1))
9062 call matvec2(auxmat(1,1),Ub2(1,i),
9063 & AEAb2derx(1,lll,kkk,iii,1,1))
9064 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9065 & AEAb1derx(1,lll,kkk,iii,2,1))
9066 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9067 & AEAb2derx(1,lll,kkk,iii,2,1))
9068 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9069 call matvec2(auxmat(1,1),b1(1,j),
9070 & AEAb1derx(1,lll,kkk,iii,1,2))
9071 call matvec2(auxmat(1,1),Ub2(1,j),
9072 & AEAb2derx(1,lll,kkk,iii,1,2))
9073 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9074 & AEAb1derx(1,lll,kkk,iii,2,2))
9075 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
9076 & AEAb2derx(1,lll,kkk,iii,2,2))
9083 C Antiparallel orientation of the two CA-CA-CA frames.
9085 iti=itortyp(itype(i))
9089 itk1=itortyp(itype(k+1))
9090 itl=itortyp(itype(l))
9091 itj=itortyp(itype(j))
9092 if (j.lt.nres-1) then
9093 itj1=itortyp(itype(j+1))
9097 C A2 kernel(j-1)T A1T
9098 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9099 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
9100 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9101 C Following matrices are needed only for 6-th order cumulants
9102 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9103 & j.eq.i+4 .and. l.eq.i+3)) THEN
9104 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9105 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
9106 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9107 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9108 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
9109 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9110 & ADtEAderx(1,1,1,1,1,1))
9111 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9112 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
9113 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9114 & ADtEA1derx(1,1,1,1,1,1))
9116 C End 6-th order cumulants
9117 call transpose2(EUgder(1,1,k),auxmat(1,1))
9118 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9119 call transpose2(EUg(1,1,k),auxmat(1,1))
9120 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9121 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9125 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9126 & EAEAderx(1,1,lll,kkk,iii,1))
9130 C A2T kernel(i+1)T A1
9131 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9132 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
9133 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9134 C Following matrices are needed only for 6-th order cumulants
9135 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9136 & j.eq.i+4 .and. l.eq.i+3)) THEN
9137 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9138 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
9139 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9140 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9141 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
9142 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9143 & ADtEAderx(1,1,1,1,1,2))
9144 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9145 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
9146 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9147 & ADtEA1derx(1,1,1,1,1,2))
9149 C End 6-th order cumulants
9150 call transpose2(EUgder(1,1,j),auxmat(1,1))
9151 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9152 call transpose2(EUg(1,1,j),auxmat(1,1))
9153 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9154 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9158 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9159 & EAEAderx(1,1,lll,kkk,iii,2))
9164 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9165 C They are needed only when the fifth- or the sixth-order cumulants are
9167 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
9168 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9169 call transpose2(AEA(1,1,1),auxmat(1,1))
9170 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9171 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9172 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9173 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9174 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9175 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9176 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9177 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9178 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9179 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9180 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9181 call transpose2(AEA(1,1,2),auxmat(1,1))
9182 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
9183 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9184 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9185 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9186 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
9187 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9188 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
9189 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
9190 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9191 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9192 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9193 C Calculate the Cartesian derivatives of the vectors.
9197 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9198 call matvec2(auxmat(1,1),b1(1,i),
9199 & AEAb1derx(1,lll,kkk,iii,1,1))
9200 call matvec2(auxmat(1,1),Ub2(1,i),
9201 & AEAb2derx(1,lll,kkk,iii,1,1))
9202 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9203 & AEAb1derx(1,lll,kkk,iii,2,1))
9204 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9205 & AEAb2derx(1,lll,kkk,iii,2,1))
9206 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9207 call matvec2(auxmat(1,1),b1(1,l),
9208 & AEAb1derx(1,lll,kkk,iii,1,2))
9209 call matvec2(auxmat(1,1),Ub2(1,l),
9210 & AEAb2derx(1,lll,kkk,iii,1,2))
9211 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
9212 & AEAb1derx(1,lll,kkk,iii,2,2))
9213 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
9214 & AEAb2derx(1,lll,kkk,iii,2,2))
9223 C---------------------------------------------------------------------------
9224 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
9225 & KK,KKderg,AKA,AKAderg,AKAderx)
9229 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
9230 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
9231 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
9236 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9238 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
9241 cd if (lprn) write (2,*) 'In kernel'
9243 cd if (lprn) write (2,*) 'kkk=',kkk
9245 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
9246 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9248 cd write (2,*) 'lll=',lll
9249 cd write (2,*) 'iii=1'
9251 cd write (2,'(3(2f10.5),5x)')
9252 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9255 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
9256 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9258 cd write (2,*) 'lll=',lll
9259 cd write (2,*) 'iii=2'
9261 cd write (2,'(3(2f10.5),5x)')
9262 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9269 C---------------------------------------------------------------------------
9270 double precision function eello4(i,j,k,l,jj,kk)
9271 implicit real*8 (a-h,o-z)
9272 include 'DIMENSIONS'
9273 include 'COMMON.IOUNITS'
9274 include 'COMMON.CHAIN'
9275 include 'COMMON.DERIV'
9276 include 'COMMON.INTERACT'
9277 include 'COMMON.CONTACTS'
9278 include 'COMMON.TORSION'
9279 include 'COMMON.VAR'
9280 include 'COMMON.GEO'
9281 double precision pizda(2,2),ggg1(3),ggg2(3)
9282 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9286 cd print *,'eello4:',i,j,k,l,jj,kk
9287 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9288 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9289 cold eij=facont_hb(jj,i)
9290 cold ekl=facont_hb(kk,k)
9292 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9293 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9294 gcorr_loc(k-1)=gcorr_loc(k-1)
9295 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9297 gcorr_loc(l-1)=gcorr_loc(l-1)
9298 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9300 gcorr_loc(j-1)=gcorr_loc(j-1)
9301 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9306 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9307 & -EAEAderx(2,2,lll,kkk,iii,1)
9308 cd derx(lll,kkk,iii)=0.0d0
9312 cd gcorr_loc(l-1)=0.0d0
9313 cd gcorr_loc(j-1)=0.0d0
9314 cd gcorr_loc(k-1)=0.0d0
9316 cd write (iout,*)'Contacts have occurred for peptide groups',
9317 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9318 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9319 if (j.lt.nres-1) then
9326 if (l.lt.nres-1) then
9334 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9335 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9336 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9337 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9338 cgrad ghalf=0.5d0*ggg1(ll)
9339 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9340 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9341 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9342 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9343 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9344 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9345 cgrad ghalf=0.5d0*ggg2(ll)
9346 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9347 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9348 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9349 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9350 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9351 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9355 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9360 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9365 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9370 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9374 cd write (2,*) iii,gcorr_loc(iii)
9377 cd write (2,*) 'ekont',ekont
9378 cd write (iout,*) 'eello4',ekont*eel4
9381 C---------------------------------------------------------------------------
9382 double precision function eello5(i,j,k,l,jj,kk)
9383 implicit real*8 (a-h,o-z)
9384 include 'DIMENSIONS'
9385 include 'COMMON.IOUNITS'
9386 include 'COMMON.CHAIN'
9387 include 'COMMON.DERIV'
9388 include 'COMMON.INTERACT'
9389 include 'COMMON.CONTACTS'
9390 include 'COMMON.TORSION'
9391 include 'COMMON.VAR'
9392 include 'COMMON.GEO'
9393 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9394 double precision ggg1(3),ggg2(3)
9395 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9400 C /l\ / \ \ / \ / \ / C
9401 C / \ / \ \ / \ / \ / C
9402 C j| o |l1 | o | o| o | | o |o C
9403 C \ |/k\| |/ \| / |/ \| |/ \| C
9404 C \i/ \ / \ / / \ / \ C
9406 C (I) (II) (III) (IV) C
9408 C eello5_1 eello5_2 eello5_3 eello5_4 C
9410 C Antiparallel chains C
9413 C /j\ / \ \ / \ / \ / C
9414 C / \ / \ \ / \ / \ / C
9415 C j1| o |l | o | o| o | | o |o C
9416 C \ |/k\| |/ \| / |/ \| |/ \| C
9417 C \i/ \ / \ / / \ / \ C
9419 C (I) (II) (III) (IV) C
9421 C eello5_1 eello5_2 eello5_3 eello5_4 C
9423 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9425 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9426 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9431 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9433 itk=itortyp(itype(k))
9434 itl=itortyp(itype(l))
9435 itj=itortyp(itype(j))
9440 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9441 cd & eel5_3_num,eel5_4_num)
9445 derx(lll,kkk,iii)=0.0d0
9449 cd eij=facont_hb(jj,i)
9450 cd ekl=facont_hb(kk,k)
9452 cd write (iout,*)'Contacts have occurred for peptide groups',
9453 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9455 C Contribution from the graph I.
9456 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9457 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9458 call transpose2(EUg(1,1,k),auxmat(1,1))
9459 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9460 vv(1)=pizda(1,1)-pizda(2,2)
9461 vv(2)=pizda(1,2)+pizda(2,1)
9462 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9463 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9464 C Explicit gradient in virtual-dihedral angles.
9465 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9466 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9467 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9468 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9469 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9470 vv(1)=pizda(1,1)-pizda(2,2)
9471 vv(2)=pizda(1,2)+pizda(2,1)
9472 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9473 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9474 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9475 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9476 vv(1)=pizda(1,1)-pizda(2,2)
9477 vv(2)=pizda(1,2)+pizda(2,1)
9479 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9480 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9481 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9483 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9484 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9485 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9487 C Cartesian gradient
9491 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
9493 vv(1)=pizda(1,1)-pizda(2,2)
9494 vv(2)=pizda(1,2)+pizda(2,1)
9495 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9496 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
9497 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9503 C Contribution from graph II
9504 call transpose2(EE(1,1,itk),auxmat(1,1))
9505 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9506 vv(1)=pizda(1,1)+pizda(2,2)
9507 vv(2)=pizda(2,1)-pizda(1,2)
9508 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
9509 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9510 C Explicit gradient in virtual-dihedral angles.
9511 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9512 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9513 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9514 vv(1)=pizda(1,1)+pizda(2,2)
9515 vv(2)=pizda(2,1)-pizda(1,2)
9517 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9518 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9519 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9521 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9522 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9523 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9525 C Cartesian gradient
9529 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9531 vv(1)=pizda(1,1)+pizda(2,2)
9532 vv(2)=pizda(2,1)-pizda(1,2)
9533 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9534 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
9535 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9543 C Parallel orientation
9544 C Contribution from graph III
9545 call transpose2(EUg(1,1,l),auxmat(1,1))
9546 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9547 vv(1)=pizda(1,1)-pizda(2,2)
9548 vv(2)=pizda(1,2)+pizda(2,1)
9549 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
9550 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9551 C Explicit gradient in virtual-dihedral angles.
9552 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9553 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
9554 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9555 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9556 vv(1)=pizda(1,1)-pizda(2,2)
9557 vv(2)=pizda(1,2)+pizda(2,1)
9558 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9559 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
9560 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9561 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9562 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9563 vv(1)=pizda(1,1)-pizda(2,2)
9564 vv(2)=pizda(1,2)+pizda(2,1)
9565 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9566 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
9567 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9568 C Cartesian gradient
9572 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9574 vv(1)=pizda(1,1)-pizda(2,2)
9575 vv(2)=pizda(1,2)+pizda(2,1)
9576 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9577 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
9578 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9583 C Contribution from graph IV
9585 call transpose2(EE(1,1,itl),auxmat(1,1))
9586 call matmat2(auxmat(1,1),AEA(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 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
9590 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9591 C Explicit gradient in virtual-dihedral angles.
9592 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9593 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9594 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9595 vv(1)=pizda(1,1)+pizda(2,2)
9596 vv(2)=pizda(2,1)-pizda(1,2)
9597 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9598 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
9599 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9600 C Cartesian gradient
9604 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9606 vv(1)=pizda(1,1)+pizda(2,2)
9607 vv(2)=pizda(2,1)-pizda(1,2)
9608 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9609 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
9610 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9615 C Antiparallel orientation
9616 C Contribution from graph III
9618 call transpose2(EUg(1,1,j),auxmat(1,1))
9619 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9620 vv(1)=pizda(1,1)-pizda(2,2)
9621 vv(2)=pizda(1,2)+pizda(2,1)
9622 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9623 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9624 C Explicit gradient in virtual-dihedral angles.
9625 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9626 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9627 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9628 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9629 vv(1)=pizda(1,1)-pizda(2,2)
9630 vv(2)=pizda(1,2)+pizda(2,1)
9631 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9632 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9633 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9634 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9635 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9636 vv(1)=pizda(1,1)-pizda(2,2)
9637 vv(2)=pizda(1,2)+pizda(2,1)
9638 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9639 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9640 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9641 C Cartesian gradient
9645 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9647 vv(1)=pizda(1,1)-pizda(2,2)
9648 vv(2)=pizda(1,2)+pizda(2,1)
9649 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9650 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9651 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9656 C Contribution from graph IV
9658 call transpose2(EE(1,1,itj),auxmat(1,1))
9659 call matmat2(auxmat(1,1),AEA(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 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9663 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9664 C Explicit gradient in virtual-dihedral angles.
9665 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9666 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9667 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9668 vv(1)=pizda(1,1)+pizda(2,2)
9669 vv(2)=pizda(2,1)-pizda(1,2)
9670 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9671 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9672 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9673 C Cartesian gradient
9677 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9679 vv(1)=pizda(1,1)+pizda(2,2)
9680 vv(2)=pizda(2,1)-pizda(1,2)
9681 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9682 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9683 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9689 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9690 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9691 cd write (2,*) 'ijkl',i,j,k,l
9692 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9693 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9695 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9696 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9697 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9698 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9699 if (j.lt.nres-1) then
9706 if (l.lt.nres-1) then
9716 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9717 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9718 C summed up outside the subrouine as for the other subroutines
9719 C handling long-range interactions. The old code is commented out
9720 C with "cgrad" to keep track of changes.
9722 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9723 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9724 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9725 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9726 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9727 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9728 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9729 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9730 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9731 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9733 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9734 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9735 cgrad ghalf=0.5d0*ggg1(ll)
9737 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9738 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9739 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9740 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9741 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9742 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9743 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9744 cgrad ghalf=0.5d0*ggg2(ll)
9746 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
9747 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9748 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
9749 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9750 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9751 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9756 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9757 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9762 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9763 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9769 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9774 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9778 cd write (2,*) iii,g_corr5_loc(iii)
9781 cd write (2,*) 'ekont',ekont
9782 cd write (iout,*) 'eello5',ekont*eel5
9785 c--------------------------------------------------------------------------
9786 double precision function eello6(i,j,k,l,jj,kk)
9787 implicit real*8 (a-h,o-z)
9788 include 'DIMENSIONS'
9789 include 'COMMON.IOUNITS'
9790 include 'COMMON.CHAIN'
9791 include 'COMMON.DERIV'
9792 include 'COMMON.INTERACT'
9793 include 'COMMON.CONTACTS'
9794 include 'COMMON.TORSION'
9795 include 'COMMON.VAR'
9796 include 'COMMON.GEO'
9797 include 'COMMON.FFIELD'
9798 double precision ggg1(3),ggg2(3)
9799 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9804 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9812 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9813 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9817 derx(lll,kkk,iii)=0.0d0
9821 cd eij=facont_hb(jj,i)
9822 cd ekl=facont_hb(kk,k)
9828 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9829 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9830 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9831 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9832 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9833 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9835 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9836 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9837 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9838 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9839 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9840 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9844 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9846 C If turn contributions are considered, they will be handled separately.
9847 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9848 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9849 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9850 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9851 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9852 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9853 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9855 if (j.lt.nres-1) then
9862 if (l.lt.nres-1) then
9870 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9871 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9872 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9873 cgrad ghalf=0.5d0*ggg1(ll)
9875 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9876 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9877 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9878 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9879 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9880 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9881 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9882 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9883 cgrad ghalf=0.5d0*ggg2(ll)
9884 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9886 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9887 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9888 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9889 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9890 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9891 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9896 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9897 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9902 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9903 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9909 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9914 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9918 cd write (2,*) iii,g_corr6_loc(iii)
9921 cd write (2,*) 'ekont',ekont
9922 cd write (iout,*) 'eello6',ekont*eel6
9925 c--------------------------------------------------------------------------
9926 double precision function eello6_graph1(i,j,k,l,imat,swap)
9927 implicit real*8 (a-h,o-z)
9928 include 'DIMENSIONS'
9929 include 'COMMON.IOUNITS'
9930 include 'COMMON.CHAIN'
9931 include 'COMMON.DERIV'
9932 include 'COMMON.INTERACT'
9933 include 'COMMON.CONTACTS'
9934 include 'COMMON.TORSION'
9935 include 'COMMON.VAR'
9936 include 'COMMON.GEO'
9937 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9941 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9943 C Parallel Antiparallel C
9949 C \ j|/k\| / \ |/k\|l / C
9954 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9955 itk=itortyp(itype(k))
9956 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9957 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9958 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9959 call transpose2(EUgC(1,1,k),auxmat(1,1))
9960 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9961 vv1(1)=pizda1(1,1)-pizda1(2,2)
9962 vv1(2)=pizda1(1,2)+pizda1(2,1)
9963 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9964 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9965 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9966 s5=scalar2(vv(1),Dtobr2(1,i))
9967 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9968 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9969 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9970 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9971 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9972 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9973 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9974 & +scalar2(vv(1),Dtobr2der(1,i)))
9975 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9976 vv1(1)=pizda1(1,1)-pizda1(2,2)
9977 vv1(2)=pizda1(1,2)+pizda1(2,1)
9978 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9979 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9981 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9982 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9983 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9984 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9985 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9987 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9988 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9989 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9990 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9991 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9993 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9994 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9995 vv1(1)=pizda1(1,1)-pizda1(2,2)
9996 vv1(2)=pizda1(1,2)+pizda1(2,1)
9997 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9998 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9999 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
10000 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
10009 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
10010 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
10011 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
10012 call transpose2(EUgC(1,1,k),auxmat(1,1))
10013 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10015 vv1(1)=pizda1(1,1)-pizda1(2,2)
10016 vv1(2)=pizda1(1,2)+pizda1(2,1)
10017 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10018 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
10019 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
10020 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
10021 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
10022 s5=scalar2(vv(1),Dtobr2(1,i))
10023 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
10029 c----------------------------------------------------------------------------
10030 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
10031 implicit real*8 (a-h,o-z)
10032 include 'DIMENSIONS'
10033 include 'COMMON.IOUNITS'
10034 include 'COMMON.CHAIN'
10035 include 'COMMON.DERIV'
10036 include 'COMMON.INTERACT'
10037 include 'COMMON.CONTACTS'
10038 include 'COMMON.TORSION'
10039 include 'COMMON.VAR'
10040 include 'COMMON.GEO'
10042 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10043 & auxvec1(2),auxvec2(2),auxmat1(2,2)
10045 common /kutas/ lprn
10046 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10048 C Parallel Antiparallel C
10054 C \ j|/k\| \ |/k\|l C
10059 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10060 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
10061 C AL 7/4/01 s1 would occur in the sixth-order moment,
10062 C but not in a cluster cumulant
10064 s1=dip(1,jj,i)*dip(1,kk,k)
10066 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
10067 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10068 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
10069 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
10070 call transpose2(EUg(1,1,k),auxmat(1,1))
10071 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
10072 vv(1)=pizda(1,1)-pizda(2,2)
10073 vv(2)=pizda(1,2)+pizda(2,1)
10074 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10075 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10077 eello6_graph2=-(s1+s2+s3+s4)
10079 eello6_graph2=-(s2+s3+s4)
10081 c eello6_graph2=-s3
10082 C Derivatives in gamma(i-1)
10085 s1=dipderg(1,jj,i)*dip(1,kk,k)
10087 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10088 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
10089 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10090 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10092 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10094 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10096 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
10098 C Derivatives in gamma(k-1)
10100 s1=dip(1,jj,i)*dipderg(1,kk,k)
10102 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
10103 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10104 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
10105 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10106 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10107 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
10108 vv(1)=pizda(1,1)-pizda(2,2)
10109 vv(2)=pizda(1,2)+pizda(2,1)
10110 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10112 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10114 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10116 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
10117 C Derivatives in gamma(j-1) or gamma(l-1)
10120 s1=dipderg(3,jj,i)*dip(1,kk,k)
10122 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
10123 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10124 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
10125 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
10126 vv(1)=pizda(1,1)-pizda(2,2)
10127 vv(2)=pizda(1,2)+pizda(2,1)
10128 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10131 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10133 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10136 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10137 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10139 C Derivatives in gamma(l-1) or gamma(j-1)
10142 s1=dip(1,jj,i)*dipderg(3,kk,k)
10144 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10145 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10146 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10147 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10148 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10149 vv(1)=pizda(1,1)-pizda(2,2)
10150 vv(2)=pizda(1,2)+pizda(2,1)
10151 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10154 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10156 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10159 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10160 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10162 C Cartesian derivatives.
10164 write (2,*) 'In eello6_graph2'
10166 write (2,*) 'iii=',iii
10168 write (2,*) 'kkk=',kkk
10170 write (2,'(3(2f10.5),5x)')
10171 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10181 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10183 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10186 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
10188 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10189 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
10191 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10192 call transpose2(EUg(1,1,k),auxmat(1,1))
10193 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
10195 vv(1)=pizda(1,1)-pizda(2,2)
10196 vv(2)=pizda(1,2)+pizda(2,1)
10197 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10198 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10200 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10202 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10205 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10207 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10214 c----------------------------------------------------------------------------
10215 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
10216 implicit real*8 (a-h,o-z)
10217 include 'DIMENSIONS'
10218 include 'COMMON.IOUNITS'
10219 include 'COMMON.CHAIN'
10220 include 'COMMON.DERIV'
10221 include 'COMMON.INTERACT'
10222 include 'COMMON.CONTACTS'
10223 include 'COMMON.TORSION'
10224 include 'COMMON.VAR'
10225 include 'COMMON.GEO'
10226 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
10228 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10230 C Parallel Antiparallel C
10235 C /| o |o o| o |\ C
10236 C j|/k\| / |/k\|l / C
10241 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10243 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10244 C energy moment and not to the cluster cumulant.
10245 iti=itortyp(itype(i))
10246 if (j.lt.nres-1) then
10247 itj1=itortyp(itype(j+1))
10251 itk=itortyp(itype(k))
10252 itk1=itortyp(itype(k+1))
10253 if (l.lt.nres-1) then
10254 itl1=itortyp(itype(l+1))
10259 s1=dip(4,jj,i)*dip(4,kk,k)
10261 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
10262 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10263 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
10264 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10265 call transpose2(EE(1,1,itk),auxmat(1,1))
10266 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10267 vv(1)=pizda(1,1)+pizda(2,2)
10268 vv(2)=pizda(2,1)-pizda(1,2)
10269 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10270 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10271 cd & "sum",-(s2+s3+s4)
10273 eello6_graph3=-(s1+s2+s3+s4)
10275 eello6_graph3=-(s2+s3+s4)
10277 c eello6_graph3=-s4
10278 C Derivatives in gamma(k-1)
10279 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
10280 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10281 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10282 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10283 C Derivatives in gamma(l-1)
10284 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
10285 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10286 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10287 vv(1)=pizda(1,1)+pizda(2,2)
10288 vv(2)=pizda(2,1)-pizda(1,2)
10289 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10290 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10291 C Cartesian derivatives.
10297 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10299 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10302 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
10304 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10305 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
10307 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10308 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
10310 vv(1)=pizda(1,1)+pizda(2,2)
10311 vv(2)=pizda(2,1)-pizda(1,2)
10312 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10314 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10316 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10319 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10321 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10323 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10329 c----------------------------------------------------------------------------
10330 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10331 implicit real*8 (a-h,o-z)
10332 include 'DIMENSIONS'
10333 include 'COMMON.IOUNITS'
10334 include 'COMMON.CHAIN'
10335 include 'COMMON.DERIV'
10336 include 'COMMON.INTERACT'
10337 include 'COMMON.CONTACTS'
10338 include 'COMMON.TORSION'
10339 include 'COMMON.VAR'
10340 include 'COMMON.GEO'
10341 include 'COMMON.FFIELD'
10342 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10343 & auxvec1(2),auxmat1(2,2)
10345 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10347 C Parallel Antiparallel C
10352 C /| o |o o| o |\ C
10353 C \ j|/k\| \ |/k\|l C
10358 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10360 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10361 C energy moment and not to the cluster cumulant.
10362 cd write (2,*) 'eello_graph4: wturn6',wturn6
10363 iti=itortyp(itype(i))
10364 itj=itortyp(itype(j))
10365 if (j.lt.nres-1) then
10366 itj1=itortyp(itype(j+1))
10370 itk=itortyp(itype(k))
10371 if (k.lt.nres-1) then
10372 itk1=itortyp(itype(k+1))
10376 itl=itortyp(itype(l))
10377 if (l.lt.nres-1) then
10378 itl1=itortyp(itype(l+1))
10382 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10383 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10384 cd & ' itl',itl,' itl1',itl1
10386 if (imat.eq.1) then
10387 s1=dip(3,jj,i)*dip(3,kk,k)
10389 s1=dip(2,jj,j)*dip(2,kk,l)
10392 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10393 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10395 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
10396 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10398 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
10399 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10401 call transpose2(EUg(1,1,k),auxmat(1,1))
10402 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10403 vv(1)=pizda(1,1)-pizda(2,2)
10404 vv(2)=pizda(2,1)+pizda(1,2)
10405 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10406 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10408 eello6_graph4=-(s1+s2+s3+s4)
10410 eello6_graph4=-(s2+s3+s4)
10412 C Derivatives in gamma(i-1)
10415 if (imat.eq.1) then
10416 s1=dipderg(2,jj,i)*dip(3,kk,k)
10418 s1=dipderg(4,jj,j)*dip(2,kk,l)
10421 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10423 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
10424 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10426 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
10427 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10429 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10430 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10431 cd write (2,*) 'turn6 derivatives'
10433 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10435 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10439 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10441 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10445 C Derivatives in gamma(k-1)
10447 if (imat.eq.1) then
10448 s1=dip(3,jj,i)*dipderg(2,kk,k)
10450 s1=dip(2,jj,j)*dipderg(4,kk,l)
10453 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10454 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10456 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
10457 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10459 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
10460 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10462 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10463 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10464 vv(1)=pizda(1,1)-pizda(2,2)
10465 vv(2)=pizda(2,1)+pizda(1,2)
10466 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10467 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10469 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10471 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10475 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10477 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10480 C Derivatives in gamma(j-1) or gamma(l-1)
10481 if (l.eq.j+1 .and. l.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 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10489 else if (j.gt.1) then
10490 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10491 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10492 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10493 vv(1)=pizda(1,1)-pizda(2,2)
10494 vv(2)=pizda(2,1)+pizda(1,2)
10495 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10496 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10497 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10499 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10502 C Cartesian derivatives.
10508 if (imat.eq.1) then
10509 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10511 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10514 if (imat.eq.1) then
10515 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10517 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10521 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
10523 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10525 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10526 & b1(1,j+1),auxvec(1))
10527 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
10529 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10530 & b1(1,l+1),auxvec(1))
10531 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
10533 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10535 vv(1)=pizda(1,1)-pizda(2,2)
10536 vv(2)=pizda(2,1)+pizda(1,2)
10537 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10539 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10541 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10544 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10547 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10550 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10552 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10554 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10558 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10560 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10563 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10565 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10573 c----------------------------------------------------------------------------
10574 double precision function eello_turn6(i,jj,kk)
10575 implicit real*8 (a-h,o-z)
10576 include 'DIMENSIONS'
10577 include 'COMMON.IOUNITS'
10578 include 'COMMON.CHAIN'
10579 include 'COMMON.DERIV'
10580 include 'COMMON.INTERACT'
10581 include 'COMMON.CONTACTS'
10582 include 'COMMON.TORSION'
10583 include 'COMMON.VAR'
10584 include 'COMMON.GEO'
10585 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
10586 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
10588 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
10589 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
10590 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10591 C the respective energy moment and not to the cluster cumulant.
10600 iti=itortyp(itype(i))
10601 itk=itortyp(itype(k))
10602 itk1=itortyp(itype(k+1))
10603 itl=itortyp(itype(l))
10604 itj=itortyp(itype(j))
10605 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10606 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
10607 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10612 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10614 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10618 derx_turn(lll,kkk,iii)=0.0d0
10625 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10627 cd write (2,*) 'eello6_5',eello6_5
10629 call transpose2(AEA(1,1,1),auxmat(1,1))
10630 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10631 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10632 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10634 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10635 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10636 s2 = scalar2(b1(1,k),vtemp1(1))
10638 call transpose2(AEA(1,1,2),atemp(1,1))
10639 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10640 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10641 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10643 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10644 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10645 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10647 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10648 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10649 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10650 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10651 ss13 = scalar2(b1(1,k),vtemp4(1))
10652 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10654 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10660 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10661 C Derivatives in gamma(i+2)
10665 call transpose2(AEA(1,1,1),auxmatd(1,1))
10666 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10667 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10668 call transpose2(AEAderg(1,1,2),atempd(1,1))
10669 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10670 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10672 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10673 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10674 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10680 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10681 C Derivatives in gamma(i+3)
10683 call transpose2(AEA(1,1,1),auxmatd(1,1))
10684 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10685 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10686 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10688 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10689 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10690 s2d = scalar2(b1(1,k),vtemp1d(1))
10692 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10693 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10695 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10697 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10698 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10699 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10707 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10708 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10710 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10711 & -0.5d0*ekont*(s2d+s12d)
10713 C Derivatives in gamma(i+4)
10714 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10715 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10716 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10718 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10719 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10720 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10728 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10730 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10732 C Derivatives in gamma(i+5)
10734 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10735 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10736 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10738 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10739 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10740 s2d = scalar2(b1(1,k),vtemp1d(1))
10742 call transpose2(AEA(1,1,2),atempd(1,1))
10743 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10744 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10746 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10747 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10749 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10750 ss13d = scalar2(b1(1,k),vtemp4d(1))
10751 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10759 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10760 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10762 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10763 & -0.5d0*ekont*(s2d+s12d)
10765 C Cartesian derivatives
10770 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10771 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10772 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10774 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10775 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10777 s2d = scalar2(b1(1,k),vtemp1d(1))
10779 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10780 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10781 s8d = -(atempd(1,1)+atempd(2,2))*
10782 & scalar2(cc(1,1,itl),vtemp2(1))
10784 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10786 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10787 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10794 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10795 & - 0.5d0*(s1d+s2d)
10797 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10801 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10802 & - 0.5d0*(s8d+s12d)
10804 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10813 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10814 & achuj_tempd(1,1))
10815 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10816 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10817 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10818 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10819 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10821 ss13d = scalar2(b1(1,k),vtemp4d(1))
10822 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10823 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10827 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10828 cd & 16*eel_turn6_num
10830 if (j.lt.nres-1) then
10837 if (l.lt.nres-1) then
10845 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10846 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10847 cgrad ghalf=0.5d0*ggg1(ll)
10849 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10850 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10851 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10852 & +ekont*derx_turn(ll,2,1)
10853 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10854 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10855 & +ekont*derx_turn(ll,4,1)
10856 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10857 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10858 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10859 cgrad ghalf=0.5d0*ggg2(ll)
10861 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10862 & +ekont*derx_turn(ll,2,2)
10863 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10864 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10865 & +ekont*derx_turn(ll,4,2)
10866 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10867 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10868 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10873 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10878 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10884 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10889 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10893 cd write (2,*) iii,g_corr6_loc(iii)
10895 eello_turn6=ekont*eel_turn6
10896 cd write (2,*) 'ekont',ekont
10897 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10901 C-----------------------------------------------------------------------------
10902 double precision function scalar(u,v)
10903 !DIR$ INLINEALWAYS scalar
10905 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10908 double precision u(3),v(3)
10909 cd double precision sc
10917 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10920 crc-------------------------------------------------
10921 SUBROUTINE MATVEC2(A1,V1,V2)
10922 !DIR$ INLINEALWAYS MATVEC2
10924 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10926 implicit real*8 (a-h,o-z)
10927 include 'DIMENSIONS'
10928 DIMENSION A1(2,2),V1(2),V2(2)
10932 c 3 VI=VI+A1(I,K)*V1(K)
10936 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10937 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10942 C---------------------------------------
10943 SUBROUTINE MATMAT2(A1,A2,A3)
10945 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10947 implicit real*8 (a-h,o-z)
10948 include 'DIMENSIONS'
10949 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10950 c DIMENSION AI3(2,2)
10954 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10960 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10961 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10962 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10963 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10971 c-------------------------------------------------------------------------
10972 double precision function scalar2(u,v)
10973 !DIR$ INLINEALWAYS scalar2
10975 double precision u(2),v(2)
10976 double precision sc
10978 scalar2=u(1)*v(1)+u(2)*v(2)
10982 C-----------------------------------------------------------------------------
10984 subroutine transpose2(a,at)
10985 !DIR$ INLINEALWAYS transpose2
10987 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10990 double precision a(2,2),at(2,2)
10997 c--------------------------------------------------------------------------
10998 subroutine transpose(n,a,at)
11001 double precision a(n,n),at(n,n)
11009 C---------------------------------------------------------------------------
11010 subroutine prodmat3(a1,a2,kk,transp,prod)
11011 !DIR$ INLINEALWAYS prodmat3
11013 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
11017 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
11019 crc double precision auxmat(2,2),prod_(2,2)
11022 crc call transpose2(kk(1,1),auxmat(1,1))
11023 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
11024 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11026 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
11027 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
11028 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
11029 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
11030 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
11031 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
11032 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
11033 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
11036 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
11037 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11039 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
11040 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
11041 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
11042 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
11043 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
11044 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
11045 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
11046 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
11049 c call transpose2(a2(1,1),a2t(1,1))
11052 crc print *,((prod_(i,j),i=1,2),j=1,2)
11053 crc print *,((prod(i,j),i=1,2),j=1,2)
11057 CCC----------------------------------------------
11058 subroutine Eliptransfer(eliptran)
11059 implicit real*8 (a-h,o-z)
11060 include 'DIMENSIONS'
11061 include 'COMMON.GEO'
11062 include 'COMMON.VAR'
11063 include 'COMMON.LOCAL'
11064 include 'COMMON.CHAIN'
11065 include 'COMMON.DERIV'
11066 include 'COMMON.NAMES'
11067 include 'COMMON.INTERACT'
11068 include 'COMMON.IOUNITS'
11069 include 'COMMON.CALC'
11070 include 'COMMON.CONTROL'
11071 include 'COMMON.SPLITELE'
11072 include 'COMMON.SBRIDGE'
11073 C this is done by Adasko
11074 C print *,"wchodze"
11075 C structure of box:
11077 C--bordliptop-- buffore starts
11078 C--bufliptop--- here true lipid starts
11080 C--buflipbot--- lipid ends buffore starts
11081 C--bordlipbot--buffore ends
11083 do i=ilip_start,ilip_end
11085 if (itype(i).eq.ntyp1) cycle
11087 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
11088 if (positi.le.0) positi=positi+boxzsize
11090 C first for peptide groups
11091 c for each residue check if it is in lipid or lipid water border area
11092 if ((positi.gt.bordlipbot)
11093 &.and.(positi.lt.bordliptop)) then
11094 C the energy transfer exist
11095 if (positi.lt.buflipbot) then
11096 C what fraction I am in
11098 & ((positi-bordlipbot)/lipbufthick)
11099 C lipbufthick is thickenes of lipid buffore
11100 sslip=sscalelip(fracinbuf)
11101 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11102 eliptran=eliptran+sslip*pepliptran
11103 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11104 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11105 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11107 C print *,"doing sccale for lower part"
11108 C print *,i,sslip,fracinbuf,ssgradlip
11109 elseif (positi.gt.bufliptop) then
11110 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
11111 sslip=sscalelip(fracinbuf)
11112 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11113 eliptran=eliptran+sslip*pepliptran
11114 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11115 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11116 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11117 C print *, "doing sscalefor top part"
11118 C print *,i,sslip,fracinbuf,ssgradlip
11120 eliptran=eliptran+pepliptran
11121 C print *,"I am in true lipid"
11124 C eliptran=elpitran+0.0 ! I am in water
11127 C print *, "nic nie bylo w lipidzie?"
11128 C now multiply all by the peptide group transfer factor
11129 C eliptran=eliptran*pepliptran
11130 C now the same for side chains
11132 do i=ilip_start,ilip_end
11133 if (itype(i).eq.ntyp1) cycle
11134 positi=(mod(c(3,i+nres),boxzsize))
11135 if (positi.le.0) positi=positi+boxzsize
11136 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
11137 c for each residue check if it is in lipid or lipid water border area
11138 C respos=mod(c(3,i+nres),boxzsize)
11139 C print *,positi,bordlipbot,buflipbot
11140 if ((positi.gt.bordlipbot)
11141 & .and.(positi.lt.bordliptop)) then
11142 C the energy transfer exist
11143 if (positi.lt.buflipbot) then
11145 & ((positi-bordlipbot)/lipbufthick)
11146 C lipbufthick is thickenes of lipid buffore
11147 sslip=sscalelip(fracinbuf)
11148 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11149 eliptran=eliptran+sslip*liptranene(itype(i))
11150 gliptranx(3,i)=gliptranx(3,i)
11151 &+ssgradlip*liptranene(itype(i))
11152 gliptranc(3,i-1)= gliptranc(3,i-1)
11153 &+ssgradlip*liptranene(itype(i))
11154 C print *,"doing sccale for lower part"
11155 elseif (positi.gt.bufliptop) then
11157 &((bordliptop-positi)/lipbufthick)
11158 sslip=sscalelip(fracinbuf)
11159 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11160 eliptran=eliptran+sslip*liptranene(itype(i))
11161 gliptranx(3,i)=gliptranx(3,i)
11162 &+ssgradlip*liptranene(itype(i))
11163 gliptranc(3,i-1)= gliptranc(3,i-1)
11164 &+ssgradlip*liptranene(itype(i))
11165 C print *, "doing sscalefor top part",sslip,fracinbuf
11167 eliptran=eliptran+liptranene(itype(i))
11168 C print *,"I am in true lipid"
11170 endif ! if in lipid or buffor
11172 C eliptran=elpitran+0.0 ! I am in water
11176 C---------------------------------------------------------
11177 C AFM soubroutine for constant force
11178 subroutine AFMforce(Eafmforce)
11179 implicit real*8 (a-h,o-z)
11180 include 'DIMENSIONS'
11181 include 'COMMON.GEO'
11182 include 'COMMON.VAR'
11183 include 'COMMON.LOCAL'
11184 include 'COMMON.CHAIN'
11185 include 'COMMON.DERIV'
11186 include 'COMMON.NAMES'
11187 include 'COMMON.INTERACT'
11188 include 'COMMON.IOUNITS'
11189 include 'COMMON.CALC'
11190 include 'COMMON.CONTROL'
11191 include 'COMMON.SPLITELE'
11192 include 'COMMON.SBRIDGE'
11197 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11198 dist=dist+diffafm(i)**2
11201 Eafmforce=-forceAFMconst*(dist-distafminit)
11203 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
11204 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
11206 C print *,'AFM',Eafmforce
11209 C---------------------------------------------------------
11210 C AFM subroutine with pseudoconstant velocity
11211 subroutine AFMvel(Eafmforce)
11212 implicit real*8 (a-h,o-z)
11213 include 'DIMENSIONS'
11214 include 'COMMON.GEO'
11215 include 'COMMON.VAR'
11216 include 'COMMON.LOCAL'
11217 include 'COMMON.CHAIN'
11218 include 'COMMON.DERIV'
11219 include 'COMMON.NAMES'
11220 include 'COMMON.INTERACT'
11221 include 'COMMON.IOUNITS'
11222 include 'COMMON.CALC'
11223 include 'COMMON.CONTROL'
11224 include 'COMMON.SPLITELE'
11225 include 'COMMON.SBRIDGE'
11227 C Only for check grad COMMENT if not used for checkgrad
11229 C--------------------------------------------------------
11230 C print *,"wchodze"
11234 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11235 dist=dist+diffafm(i)**2
11238 Eafmforce=0.5d0*forceAFMconst
11239 & *(distafminit+totTafm*velAFMconst-dist)**2
11240 C Eafmforce=-forceAFMconst*(dist-distafminit)
11242 gradafm(i,afmend-1)=-forceAFMconst*
11243 &(distafminit+totTafm*velAFMconst-dist)
11245 gradafm(i,afmbeg-1)=forceAFMconst*
11246 &(distafminit+totTafm*velAFMconst-dist)
11249 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
11252 C-----------------------------------------------------------
11253 C first for shielding is setting of function of side-chains
11254 subroutine set_shield_fac
11255 implicit real*8 (a-h,o-z)
11256 include 'DIMENSIONS'
11257 include 'COMMON.CHAIN'
11258 include 'COMMON.DERIV'
11259 include 'COMMON.IOUNITS'
11260 include 'COMMON.SHIELD'
11261 include 'COMMON.INTERACT'
11262 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11263 double precision div77_81/0.974996043d0/,
11264 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11266 C the vector between center of side_chain and peptide group
11267 double precision pep_side(3),long,side_calf(3),
11268 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11269 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11270 C the line belowe needs to be changed for FGPROC>1
11272 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11274 Cif there two consequtive dummy atoms there is no peptide group between them
11275 C the line below has to be changed for FGPROC>1
11278 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11282 C first lets set vector conecting the ithe side-chain with kth side-chain
11283 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11284 C pep_side(j)=2.0d0
11285 C and vector conecting the side-chain with its proper calfa
11286 side_calf(j)=c(j,k+nres)-c(j,k)
11287 C side_calf(j)=2.0d0
11288 pept_group(j)=c(j,i)-c(j,i+1)
11289 C lets have their lenght
11290 dist_pep_side=pep_side(j)**2+dist_pep_side
11291 dist_side_calf=dist_side_calf+side_calf(j)**2
11292 dist_pept_group=dist_pept_group+pept_group(j)**2
11294 dist_pep_side=dsqrt(dist_pep_side)
11295 dist_pept_group=dsqrt(dist_pept_group)
11296 dist_side_calf=dsqrt(dist_side_calf)
11298 pep_side_norm(j)=pep_side(j)/dist_pep_side
11299 side_calf_norm(j)=dist_side_calf
11301 C now sscale fraction
11302 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
11303 C print *,buff_shield,"buff"
11305 if (sh_frac_dist.le.0.0) cycle
11306 C If we reach here it means that this side chain reaches the shielding sphere
11307 C Lets add him to the list for gradient
11308 ishield_list(i)=ishield_list(i)+1
11309 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
11310 C this list is essential otherwise problem would be O3
11311 shield_list(ishield_list(i),i)=k
11312 C Lets have the sscale value
11313 if (sh_frac_dist.gt.1.0) then
11314 scale_fac_dist=1.0d0
11316 sh_frac_dist_grad(j)=0.0d0
11319 scale_fac_dist=-sh_frac_dist*sh_frac_dist
11320 & *(2.0*sh_frac_dist-3.0d0)
11321 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
11322 & /dist_pep_side/buff_shield*0.5
11323 C remember for the final gradient multiply sh_frac_dist_grad(j)
11324 C for side_chain by factor -2 !
11326 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
11327 C print *,"jestem",scale_fac_dist,fac_help_scale,
11328 C & sh_frac_dist_grad(j)
11331 C if ((i.eq.3).and.(k.eq.2)) then
11332 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
11336 C this is what is now we have the distance scaling now volume...
11337 short=short_r_sidechain(itype(k))
11338 long=long_r_sidechain(itype(k))
11339 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
11342 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
11343 C costhet_fac=0.0d0
11345 costhet_grad(j)=costhet_fac*pep_side(j)
11347 C remember for the final gradient multiply costhet_grad(j)
11348 C for side_chain by factor -2 !
11349 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
11350 C pep_side0pept_group is vector multiplication
11351 pep_side0pept_group=0.0
11353 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
11355 cosalfa=(pep_side0pept_group/
11356 & (dist_pep_side*dist_side_calf))
11357 fac_alfa_sin=1.0-cosalfa**2
11358 fac_alfa_sin=dsqrt(fac_alfa_sin)
11359 rkprim=fac_alfa_sin*(long-short)+short
11361 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
11362 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
11365 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
11366 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11367 &*(long-short)/fac_alfa_sin*cosalfa/
11368 &((dist_pep_side*dist_side_calf))*
11369 &((side_calf(j))-cosalfa*
11370 &((pep_side(j)/dist_pep_side)*dist_side_calf))
11372 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11373 &*(long-short)/fac_alfa_sin*cosalfa
11374 &/((dist_pep_side*dist_side_calf))*
11376 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
11379 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
11382 C now the gradient...
11383 C grad_shield is gradient of Calfa for peptide groups
11384 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
11386 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
11387 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
11389 grad_shield(j,i)=grad_shield(j,i)
11390 C gradient po skalowaniu
11391 & +(sh_frac_dist_grad(j)
11392 C gradient po costhet
11393 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
11394 &-scale_fac_dist*(cosphi_grad_long(j))
11395 &/(1.0-cosphi) )*div77_81
11397 C grad_shield_side is Cbeta sidechain gradient
11398 grad_shield_side(j,ishield_list(i),i)=
11399 & (sh_frac_dist_grad(j)*-2.0d0
11400 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
11401 & +scale_fac_dist*(cosphi_grad_long(j))
11402 & *2.0d0/(1.0-cosphi))
11403 & *div77_81*VofOverlap
11405 grad_shield_loc(j,ishield_list(i),i)=
11406 & scale_fac_dist*cosphi_grad_loc(j)
11407 & *2.0d0/(1.0-cosphi)
11408 & *div77_81*VofOverlap
11410 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
11412 fac_shield(i)=VolumeTotal*div77_81+div4_81
11413 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
11417 C--------------------------------------------------------------------------
11418 double precision function tschebyshev(m,n,x,y)
11420 include "DIMENSIONS"
11422 double precision x(n),y,yy(0:maxvar),aux
11423 c Tschebyshev polynomial. Note that the first term is omitted
11424 c m=0: the constant term is included
11425 c m=1: the constant term is not included
11429 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
11438 C--------------------------------------------------------------------------
11439 double precision function gradtschebyshev(m,n,x,y)
11441 include "DIMENSIONS"
11443 double precision x(n+1),y,yy(0:maxvar),aux
11444 c Tschebyshev polynomial. Note that the first term is omitted
11445 c m=0: the constant term is included
11446 c m=1: the constant term is not included
11450 yy(i)=2*y*yy(i-1)-yy(i-2)
11454 aux=aux+x(i+1)*yy(i)*(i+1)
11455 C print *, x(i+1),yy(i),i
11457 gradtschebyshev=aux
11460 C------------------------------------------------------------------------
11461 C first for shielding is setting of function of side-chains
11462 subroutine set_shield_fac2
11463 implicit real*8 (a-h,o-z)
11464 include 'DIMENSIONS'
11465 include 'COMMON.CHAIN'
11466 include 'COMMON.DERIV'
11467 include 'COMMON.IOUNITS'
11468 include 'COMMON.SHIELD'
11469 include 'COMMON.INTERACT'
11470 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11471 double precision div77_81/0.974996043d0/,
11472 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11474 C the vector between center of side_chain and peptide group
11475 double precision pep_side(3),long,side_calf(3),
11476 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11477 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11478 C the line belowe needs to be changed for FGPROC>1
11480 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11482 Cif there two consequtive dummy atoms there is no peptide group between them
11483 C the line below has to be changed for FGPROC>1
11486 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11490 C first lets set vector conecting the ithe side-chain with kth side-chain
11491 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11492 C pep_side(j)=2.0d0
11493 C and vector conecting the side-chain with its proper calfa
11494 side_calf(j)=c(j,k+nres)-c(j,k)
11495 C side_calf(j)=2.0d0
11496 pept_group(j)=c(j,i)-c(j,i+1)
11497 C lets have their lenght
11498 dist_pep_side=pep_side(j)**2+dist_pep_side
11499 dist_side_calf=dist_side_calf+side_calf(j)**2
11500 dist_pept_group=dist_pept_group+pept_group(j)**2
11502 dist_pep_side=dsqrt(dist_pep_side)
11503 dist_pept_group=dsqrt(dist_pept_group)
11504 dist_side_calf=dsqrt(dist_side_calf)
11506 pep_side_norm(j)=pep_side(j)/dist_pep_side
11507 side_calf_norm(j)=dist_side_calf
11509 C now sscale fraction
11510 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
11511 C print *,buff_shield,"buff"
11513 if (sh_frac_dist.le.0.0) cycle
11514 C If we reach here it means that this side chain reaches the shielding sphere
11515 C Lets add him to the list for gradient
11516 ishield_list(i)=ishield_list(i)+1
11517 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
11518 C this list is essential otherwise problem would be O3
11519 shield_list(ishield_list(i),i)=k
11520 C Lets have the sscale value
11521 if (sh_frac_dist.gt.1.0) then
11522 scale_fac_dist=1.0d0
11524 sh_frac_dist_grad(j)=0.0d0
11527 scale_fac_dist=-sh_frac_dist*sh_frac_dist
11528 & *(2.0d0*sh_frac_dist-3.0d0)
11529 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
11530 & /dist_pep_side/buff_shield*0.5d0
11531 C remember for the final gradient multiply sh_frac_dist_grad(j)
11532 C for side_chain by factor -2 !
11534 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
11535 C sh_frac_dist_grad(j)=0.0d0
11536 C scale_fac_dist=1.0d0
11537 C print *,"jestem",scale_fac_dist,fac_help_scale,
11538 C & sh_frac_dist_grad(j)
11541 C this is what is now we have the distance scaling now volume...
11542 short=short_r_sidechain(itype(k))
11543 long=long_r_sidechain(itype(k))
11544 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
11545 sinthet=short/dist_pep_side*costhet
11549 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
11550 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
11551 C & -short/dist_pep_side**2/costhet)
11552 C costhet_fac=0.0d0
11554 costhet_grad(j)=costhet_fac*pep_side(j)
11556 C remember for the final gradient multiply costhet_grad(j)
11557 C for side_chain by factor -2 !
11558 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
11559 C pep_side0pept_group is vector multiplication
11560 pep_side0pept_group=0.0d0
11562 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
11564 cosalfa=(pep_side0pept_group/
11565 & (dist_pep_side*dist_side_calf))
11566 fac_alfa_sin=1.0d0-cosalfa**2
11567 fac_alfa_sin=dsqrt(fac_alfa_sin)
11568 rkprim=fac_alfa_sin*(long-short)+short
11572 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
11574 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
11575 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
11576 & dist_pep_side**2)
11579 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
11580 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
11581 &*(long-short)/fac_alfa_sin*cosalfa/
11582 &((dist_pep_side*dist_side_calf))*
11583 &((side_calf(j))-cosalfa*
11584 &((pep_side(j)/dist_pep_side)*dist_side_calf))
11585 C cosphi_grad_long(j)=0.0d0
11586 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
11587 &*(long-short)/fac_alfa_sin*cosalfa
11588 &/((dist_pep_side*dist_side_calf))*
11590 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
11591 C cosphi_grad_loc(j)=0.0d0
11593 C print *,sinphi,sinthet
11594 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
11597 C now the gradient...
11599 grad_shield(j,i)=grad_shield(j,i)
11600 C gradient po skalowaniu
11601 & +(sh_frac_dist_grad(j)*VofOverlap
11602 C gradient po costhet
11603 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
11604 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
11605 & sinphi/sinthet*costhet*costhet_grad(j)
11606 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
11608 C grad_shield_side is Cbeta sidechain gradient
11609 grad_shield_side(j,ishield_list(i),i)=
11610 & (sh_frac_dist_grad(j)*-2.0d0
11612 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
11613 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
11614 & sinphi/sinthet*costhet*costhet_grad(j)
11615 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
11618 grad_shield_loc(j,ishield_list(i),i)=
11619 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
11620 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
11621 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
11625 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
11627 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
11628 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)