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 write(iout,*) "tu,", i,j,aa_lip(itypi,itypj),bb_lip(itypi,itypj)
1784 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1785 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1786 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1787 C print *,sslipi,sslipj,bordlipbot,zi,zj
1788 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1796 xj=xj_safe+xshift*boxxsize
1797 yj=yj_safe+yshift*boxysize
1798 zj=zj_safe+zshift*boxzsize
1799 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1800 if(dist_temp.lt.dist_init) then
1810 if (subchap.eq.1) then
1819 dxj=dc_norm(1,nres+j)
1820 dyj=dc_norm(2,nres+j)
1821 dzj=dc_norm(3,nres+j)
1825 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1826 c write (iout,*) "j",j," dc_norm",
1827 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1828 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1830 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1831 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1833 c write (iout,'(a7,4f8.3)')
1834 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1835 if (sss.gt.0.0d0) then
1836 C Calculate angle-dependent terms of energy and contributions to their
1840 sig=sig0ij*dsqrt(sigsq)
1841 rij_shift=1.0D0/rij-sig+sig0ij
1842 c for diagnostics; uncomment
1843 c rij_shift=1.2*sig0ij
1844 C I hate to put IF's in the loops, but here don't have another choice!!!!
1845 if (rij_shift.le.0.0D0) then
1847 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1848 cd & restyp(itypi),i,restyp(itypj),j,
1849 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1853 c---------------------------------------------------------------
1854 rij_shift=1.0D0/rij_shift
1855 fac=rij_shift**expon
1856 C here to start with
1861 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1862 eps2der=evdwij*eps3rt
1863 eps3der=evdwij*eps2rt
1864 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1865 C &((sslipi+sslipj)/2.0d0+
1866 C &(2.0d0-sslipi-sslipj)/2.0d0)
1867 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1868 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1869 evdwij=evdwij*eps2rt*eps3rt
1870 evdw=evdw+evdwij*sss
1872 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1874 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1875 & restyp(itypi),i,restyp(itypj),j,
1876 & epsi,sigm,chi1,chi2,chip1,chip2,
1877 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1878 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1882 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1885 C Calculate gradient components.
1886 e1=e1*eps1*eps2rt**2*eps3rt**2
1887 fac=-expon*(e1+evdwij)*rij_shift
1890 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1891 c & evdwij,fac,sigma(itypi,itypj),expon
1892 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1894 C Calculate the radial part of the gradient
1895 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1896 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1897 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1898 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1899 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1900 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1906 C Calculate angular part of the gradient.
1916 c write (iout,*) "Number of loop steps in EGB:",ind
1917 cccc energy_dec=.false.
1920 C-----------------------------------------------------------------------------
1921 subroutine egbv(evdw)
1923 C This subroutine calculates the interaction energy of nonbonded side chains
1924 C assuming the Gay-Berne-Vorobjev potential of interaction.
1926 implicit real*8 (a-h,o-z)
1927 include 'DIMENSIONS'
1928 include 'COMMON.GEO'
1929 include 'COMMON.VAR'
1930 include 'COMMON.LOCAL'
1931 include 'COMMON.CHAIN'
1932 include 'COMMON.DERIV'
1933 include 'COMMON.NAMES'
1934 include 'COMMON.INTERACT'
1935 include 'COMMON.IOUNITS'
1936 include 'COMMON.CALC'
1937 common /srutu/ icall
1940 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1943 c if (icall.eq.0) lprn=.true.
1945 do i=iatsc_s,iatsc_e
1946 itypi=iabs(itype(i))
1947 if (itypi.eq.ntyp1) cycle
1948 itypi1=iabs(itype(i+1))
1953 if (xi.lt.0) xi=xi+boxxsize
1955 if (yi.lt.0) yi=yi+boxysize
1957 if (zi.lt.0) zi=zi+boxzsize
1958 C define scaling factor for lipids
1960 C if (positi.le.0) positi=positi+boxzsize
1962 C first for peptide groups
1963 c for each residue check if it is in lipid or lipid water border area
1964 if ((zi.gt.bordlipbot)
1965 &.and.(zi.lt.bordliptop)) then
1966 C the energy transfer exist
1967 if (zi.lt.buflipbot) then
1968 C what fraction I am in
1970 & ((zi-bordlipbot)/lipbufthick)
1971 C lipbufthick is thickenes of lipid buffore
1972 sslipi=sscalelip(fracinbuf)
1973 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1974 elseif (zi.gt.bufliptop) then
1975 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1976 sslipi=sscalelip(fracinbuf)
1977 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1987 dxi=dc_norm(1,nres+i)
1988 dyi=dc_norm(2,nres+i)
1989 dzi=dc_norm(3,nres+i)
1990 c dsci_inv=dsc_inv(itypi)
1991 dsci_inv=vbld_inv(i+nres)
1993 C Calculate SC interaction energy.
1995 do iint=1,nint_gr(i)
1996 do j=istart(i,iint),iend(i,iint)
1998 itypj=iabs(itype(j))
1999 if (itypj.eq.ntyp1) cycle
2000 c dscj_inv=dsc_inv(itypj)
2001 dscj_inv=vbld_inv(j+nres)
2002 sig0ij=sigma(itypi,itypj)
2003 r0ij=r0(itypi,itypj)
2004 chi1=chi(itypi,itypj)
2005 chi2=chi(itypj,itypi)
2012 alf12=0.5D0*(alf1+alf2)
2013 C For diagnostics only!!!
2027 if (xj.lt.0) xj=xj+boxxsize
2029 if (yj.lt.0) yj=yj+boxysize
2031 if (zj.lt.0) zj=zj+boxzsize
2032 if ((zj.gt.bordlipbot)
2033 &.and.(zj.lt.bordliptop)) then
2034 C the energy transfer exist
2035 if (zj.lt.buflipbot) then
2036 C what fraction I am in
2038 & ((zj-bordlipbot)/lipbufthick)
2039 C lipbufthick is thickenes of lipid buffore
2040 sslipj=sscalelip(fracinbuf)
2041 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
2042 elseif (zj.gt.bufliptop) then
2043 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
2044 sslipj=sscalelip(fracinbuf)
2045 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
2054 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
2055 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2056 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
2057 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2058 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
2059 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
2060 C write(iout,*) "tu,", i,j,aa,bb,aa_lip(itypi,itypj),sslipi,sslipj
2061 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2069 xj=xj_safe+xshift*boxxsize
2070 yj=yj_safe+yshift*boxysize
2071 zj=zj_safe+zshift*boxzsize
2072 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2073 if(dist_temp.lt.dist_init) then
2083 if (subchap.eq.1) then
2092 dxj=dc_norm(1,nres+j)
2093 dyj=dc_norm(2,nres+j)
2094 dzj=dc_norm(3,nres+j)
2095 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2097 C Calculate angle-dependent terms of energy and contributions to their
2101 sig=sig0ij*dsqrt(sigsq)
2102 rij_shift=1.0D0/rij-sig+r0ij
2103 C I hate to put IF's in the loops, but here don't have another choice!!!!
2104 if (rij_shift.le.0.0D0) then
2109 c---------------------------------------------------------------
2110 rij_shift=1.0D0/rij_shift
2111 fac=rij_shift**expon
2114 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2115 eps2der=evdwij*eps3rt
2116 eps3der=evdwij*eps2rt
2117 fac_augm=rrij**expon
2118 e_augm=augm(itypi,itypj)*fac_augm
2119 evdwij=evdwij*eps2rt*eps3rt
2120 evdw=evdw+evdwij+e_augm
2122 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2124 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2125 & restyp(itypi),i,restyp(itypj),j,
2126 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2127 & chi1,chi2,chip1,chip2,
2128 & eps1,eps2rt**2,eps3rt**2,
2129 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2132 C Calculate gradient components.
2133 e1=e1*eps1*eps2rt**2*eps3rt**2
2134 fac=-expon*(e1+evdwij)*rij_shift
2136 fac=rij*fac-2*expon*rrij*e_augm
2137 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2138 C Calculate the radial part of the gradient
2142 C Calculate angular part of the gradient.
2148 C-----------------------------------------------------------------------------
2149 subroutine sc_angular
2150 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2151 C om12. Called by ebp, egb, and egbv.
2153 include 'COMMON.CALC'
2154 include 'COMMON.IOUNITS'
2158 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2159 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2160 om12=dxi*dxj+dyi*dyj+dzi*dzj
2162 C Calculate eps1(om12) and its derivative in om12
2163 faceps1=1.0D0-om12*chiom12
2164 faceps1_inv=1.0D0/faceps1
2165 eps1=dsqrt(faceps1_inv)
2166 C Following variable is eps1*deps1/dom12
2167 eps1_om12=faceps1_inv*chiom12
2172 c write (iout,*) "om12",om12," eps1",eps1
2173 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2178 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2179 sigsq=1.0D0-facsig*faceps1_inv
2180 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2181 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2182 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2188 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2189 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2191 C Calculate eps2 and its derivatives in om1, om2, and om12.
2194 chipom12=chip12*om12
2195 facp=1.0D0-om12*chipom12
2197 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2198 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2199 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2200 C Following variable is the square root of eps2
2201 eps2rt=1.0D0-facp1*facp_inv
2202 C Following three variables are the derivatives of the square root of eps
2203 C in om1, om2, and om12.
2204 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2205 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2206 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2207 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2208 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2209 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2210 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2211 c & " eps2rt_om12",eps2rt_om12
2212 C Calculate whole angle-dependent part of epsilon and contributions
2213 C to its derivatives
2216 C----------------------------------------------------------------------------
2218 implicit real*8 (a-h,o-z)
2219 include 'DIMENSIONS'
2220 include 'COMMON.CHAIN'
2221 include 'COMMON.DERIV'
2222 include 'COMMON.CALC'
2223 include 'COMMON.IOUNITS'
2224 double precision dcosom1(3),dcosom2(3)
2225 cc print *,'sss=',sss
2226 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2227 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2228 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2229 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2233 c eom12=evdwij*eps1_om12
2235 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2236 c & " sigder",sigder
2237 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2238 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2240 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2241 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2244 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2246 c write (iout,*) "gg",(gg(k),k=1,3)
2248 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2249 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2250 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2251 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2252 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2253 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2254 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2255 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2256 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2257 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2260 C Calculate the components of the gradient in DC and X
2264 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2268 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2269 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2273 C-----------------------------------------------------------------------
2274 subroutine e_softsphere(evdw)
2276 C This subroutine calculates the interaction energy of nonbonded side chains
2277 C assuming the LJ potential of interaction.
2279 implicit real*8 (a-h,o-z)
2280 include 'DIMENSIONS'
2281 parameter (accur=1.0d-10)
2282 include 'COMMON.GEO'
2283 include 'COMMON.VAR'
2284 include 'COMMON.LOCAL'
2285 include 'COMMON.CHAIN'
2286 include 'COMMON.DERIV'
2287 include 'COMMON.INTERACT'
2288 include 'COMMON.TORSION'
2289 include 'COMMON.SBRIDGE'
2290 include 'COMMON.NAMES'
2291 include 'COMMON.IOUNITS'
2292 include 'COMMON.CONTACTS'
2294 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2296 do i=iatsc_s,iatsc_e
2297 itypi=iabs(itype(i))
2298 if (itypi.eq.ntyp1) cycle
2299 itypi1=iabs(itype(i+1))
2304 C Calculate SC interaction energy.
2306 do iint=1,nint_gr(i)
2307 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2308 cd & 'iend=',iend(i,iint)
2309 do j=istart(i,iint),iend(i,iint)
2310 itypj=iabs(itype(j))
2311 if (itypj.eq.ntyp1) cycle
2315 rij=xj*xj+yj*yj+zj*zj
2316 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2317 r0ij=r0(itypi,itypj)
2319 c print *,i,j,r0ij,dsqrt(rij)
2320 if (rij.lt.r0ijsq) then
2321 evdwij=0.25d0*(rij-r0ijsq)**2
2329 C Calculate the components of the gradient in DC and X
2335 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2336 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2337 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2338 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2342 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2350 C--------------------------------------------------------------------------
2351 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2354 C Soft-sphere potential of p-p interaction
2356 implicit real*8 (a-h,o-z)
2357 include 'DIMENSIONS'
2358 include 'COMMON.CONTROL'
2359 include 'COMMON.IOUNITS'
2360 include 'COMMON.GEO'
2361 include 'COMMON.VAR'
2362 include 'COMMON.LOCAL'
2363 include 'COMMON.CHAIN'
2364 include 'COMMON.DERIV'
2365 include 'COMMON.INTERACT'
2366 include 'COMMON.CONTACTS'
2367 include 'COMMON.TORSION'
2368 include 'COMMON.VECTORS'
2369 include 'COMMON.FFIELD'
2371 C write(iout,*) 'In EELEC_soft_sphere'
2378 do i=iatel_s,iatel_e
2379 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2383 xmedi=c(1,i)+0.5d0*dxi
2384 ymedi=c(2,i)+0.5d0*dyi
2385 zmedi=c(3,i)+0.5d0*dzi
2386 xmedi=mod(xmedi,boxxsize)
2387 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2388 ymedi=mod(ymedi,boxysize)
2389 if (ymedi.lt.0) ymedi=ymedi+boxysize
2390 zmedi=mod(zmedi,boxzsize)
2391 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2393 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2394 do j=ielstart(i),ielend(i)
2395 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2399 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2400 r0ij=rpp(iteli,itelj)
2409 if (xj.lt.0) xj=xj+boxxsize
2411 if (yj.lt.0) yj=yj+boxysize
2413 if (zj.lt.0) zj=zj+boxzsize
2414 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2422 xj=xj_safe+xshift*boxxsize
2423 yj=yj_safe+yshift*boxysize
2424 zj=zj_safe+zshift*boxzsize
2425 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2426 if(dist_temp.lt.dist_init) then
2436 if (isubchap.eq.1) then
2445 rij=xj*xj+yj*yj+zj*zj
2446 sss=sscale(sqrt(rij))
2447 sssgrad=sscagrad(sqrt(rij))
2448 if (rij.lt.r0ijsq) then
2449 evdw1ij=0.25d0*(rij-r0ijsq)**2
2455 evdw1=evdw1+evdw1ij*sss
2457 C Calculate contributions to the Cartesian gradient.
2459 ggg(1)=fac*xj*sssgrad
2460 ggg(2)=fac*yj*sssgrad
2461 ggg(3)=fac*zj*sssgrad
2463 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2464 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2467 * Loop over residues i+1 thru j-1.
2471 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2476 cgrad do i=nnt,nct-1
2478 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2480 cgrad do j=i+1,nct-1
2482 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2488 c------------------------------------------------------------------------------
2489 subroutine vec_and_deriv
2490 implicit real*8 (a-h,o-z)
2491 include 'DIMENSIONS'
2495 include 'COMMON.IOUNITS'
2496 include 'COMMON.GEO'
2497 include 'COMMON.VAR'
2498 include 'COMMON.LOCAL'
2499 include 'COMMON.CHAIN'
2500 include 'COMMON.VECTORS'
2501 include 'COMMON.SETUP'
2502 include 'COMMON.TIME1'
2503 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2504 C Compute the local reference systems. For reference system (i), the
2505 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2506 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2508 do i=ivec_start,ivec_end
2512 if (i.eq.nres-1) then
2513 C Case of the last full residue
2514 C Compute the Z-axis
2515 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2516 costh=dcos(pi-theta(nres))
2517 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2521 C Compute the derivatives of uz
2523 uzder(2,1,1)=-dc_norm(3,i-1)
2524 uzder(3,1,1)= dc_norm(2,i-1)
2525 uzder(1,2,1)= dc_norm(3,i-1)
2527 uzder(3,2,1)=-dc_norm(1,i-1)
2528 uzder(1,3,1)=-dc_norm(2,i-1)
2529 uzder(2,3,1)= dc_norm(1,i-1)
2532 uzder(2,1,2)= dc_norm(3,i)
2533 uzder(3,1,2)=-dc_norm(2,i)
2534 uzder(1,2,2)=-dc_norm(3,i)
2536 uzder(3,2,2)= dc_norm(1,i)
2537 uzder(1,3,2)= dc_norm(2,i)
2538 uzder(2,3,2)=-dc_norm(1,i)
2540 C Compute the Y-axis
2543 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2545 C Compute the derivatives of uy
2548 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2549 & -dc_norm(k,i)*dc_norm(j,i-1)
2550 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2552 uyder(j,j,1)=uyder(j,j,1)-costh
2553 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2558 uygrad(l,k,j,i)=uyder(l,k,j)
2559 uzgrad(l,k,j,i)=uzder(l,k,j)
2563 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2564 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2565 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2566 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2569 C Compute the Z-axis
2570 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2571 costh=dcos(pi-theta(i+2))
2572 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2576 C Compute the derivatives of uz
2578 uzder(2,1,1)=-dc_norm(3,i+1)
2579 uzder(3,1,1)= dc_norm(2,i+1)
2580 uzder(1,2,1)= dc_norm(3,i+1)
2582 uzder(3,2,1)=-dc_norm(1,i+1)
2583 uzder(1,3,1)=-dc_norm(2,i+1)
2584 uzder(2,3,1)= dc_norm(1,i+1)
2587 uzder(2,1,2)= dc_norm(3,i)
2588 uzder(3,1,2)=-dc_norm(2,i)
2589 uzder(1,2,2)=-dc_norm(3,i)
2591 uzder(3,2,2)= dc_norm(1,i)
2592 uzder(1,3,2)= dc_norm(2,i)
2593 uzder(2,3,2)=-dc_norm(1,i)
2595 C Compute the Y-axis
2598 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2600 C Compute the derivatives of uy
2603 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2604 & -dc_norm(k,i)*dc_norm(j,i+1)
2605 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2607 uyder(j,j,1)=uyder(j,j,1)-costh
2608 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2613 uygrad(l,k,j,i)=uyder(l,k,j)
2614 uzgrad(l,k,j,i)=uzder(l,k,j)
2618 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2619 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2620 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2621 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2625 vbld_inv_temp(1)=vbld_inv(i+1)
2626 if (i.lt.nres-1) then
2627 vbld_inv_temp(2)=vbld_inv(i+2)
2629 vbld_inv_temp(2)=vbld_inv(i)
2634 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2635 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2640 #if defined(PARVEC) && defined(MPI)
2641 if (nfgtasks1.gt.1) then
2643 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2644 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2645 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2646 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2647 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2649 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2650 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2652 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2653 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2654 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2655 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2656 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2657 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2658 time_gather=time_gather+MPI_Wtime()-time00
2660 c if (fg_rank.eq.0) then
2661 c write (iout,*) "Arrays UY and UZ"
2663 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2670 C-----------------------------------------------------------------------------
2671 subroutine check_vecgrad
2672 implicit real*8 (a-h,o-z)
2673 include 'DIMENSIONS'
2674 include 'COMMON.IOUNITS'
2675 include 'COMMON.GEO'
2676 include 'COMMON.VAR'
2677 include 'COMMON.LOCAL'
2678 include 'COMMON.CHAIN'
2679 include 'COMMON.VECTORS'
2680 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2681 dimension uyt(3,maxres),uzt(3,maxres)
2682 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2683 double precision delta /1.0d-7/
2686 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2687 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2688 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2689 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2690 cd & (dc_norm(if90,i),if90=1,3)
2691 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2692 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2693 cd write(iout,'(a)')
2699 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2700 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2713 cd write (iout,*) 'i=',i
2715 erij(k)=dc_norm(k,i)
2719 dc_norm(k,i)=erij(k)
2721 dc_norm(j,i)=dc_norm(j,i)+delta
2722 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2724 c dc_norm(k,i)=dc_norm(k,i)/fac
2726 c write (iout,*) (dc_norm(k,i),k=1,3)
2727 c write (iout,*) (erij(k),k=1,3)
2730 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2731 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2732 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2733 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2735 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2736 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2737 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2740 dc_norm(k,i)=erij(k)
2743 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2744 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2745 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2746 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2747 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2748 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2749 cd write (iout,'(a)')
2754 C--------------------------------------------------------------------------
2755 subroutine set_matrices
2756 implicit real*8 (a-h,o-z)
2757 include 'DIMENSIONS'
2760 include "COMMON.SETUP"
2762 integer status(MPI_STATUS_SIZE)
2764 include 'COMMON.IOUNITS'
2765 include 'COMMON.GEO'
2766 include 'COMMON.VAR'
2767 include 'COMMON.LOCAL'
2768 include 'COMMON.CHAIN'
2769 include 'COMMON.DERIV'
2770 include 'COMMON.INTERACT'
2771 include 'COMMON.CONTACTS'
2772 include 'COMMON.TORSION'
2773 include 'COMMON.VECTORS'
2774 include 'COMMON.FFIELD'
2775 double precision auxvec(2),auxmat(2,2)
2777 C Compute the virtual-bond-torsional-angle dependent quantities needed
2778 C to calculate the el-loc multibody terms of various order.
2780 c write(iout,*) 'nphi=',nphi,nres
2782 do i=ivec_start+2,ivec_end+2
2787 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2788 iti = itype2loc(itype(i-2))
2792 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2793 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2794 iti1 = itype2loc(itype(i-1))
2799 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0d0)
2800 & +bnew1(2,1,iti)*dsin(theta(i-1))
2801 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0d0)
2802 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2803 & +bnew1(2,1,iti)*dcos(theta(i-1))
2804 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2805 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2806 c &*(cos(theta(i)/2.0)
2807 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0d0)
2808 & +bnew2(2,1,iti)*dsin(theta(i-1))
2809 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0d0)
2810 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2811 c &*(cos(theta(i)/2.0)
2812 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2813 & +bnew2(2,1,iti)*dcos(theta(i-1))
2814 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2815 c if (ggb1(1,i).eq.0.0d0) then
2816 c write(iout,*) 'i=',i,ggb1(1,i),
2817 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2818 c &bnew1(2,1,iti)*cos(theta(i)),
2819 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2821 b1(2,i-2)=bnew1(1,2,iti)
2823 b2(2,i-2)=bnew2(1,2,iti)
2825 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2826 EE(1,2,i-2)=eeold(1,2,iti)
2827 EE(2,1,i-2)=eeold(2,1,iti)
2828 EE(2,2,i-2)=eeold(2,2,iti)
2829 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2834 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2835 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2836 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2837 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2838 b1tilde(1,i-2)=b1(1,i-2)
2839 b1tilde(2,i-2)=-b1(2,i-2)
2840 b2tilde(1,i-2)=b2(1,i-2)
2841 b2tilde(2,i-2)=-b2(2,i-2)
2842 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2843 c write(iout,*) 'b1=',b1(1,i-2)
2844 c write (iout,*) 'theta=', theta(i-1)
2847 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2848 iti = itype2loc(itype(i-2))
2852 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2853 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2854 iti1 = itype2loc(itype(i-1))
2862 b1tilde(1,i-2)=b1(1,i-2)
2863 b1tilde(2,i-2)=-b1(2,i-2)
2864 b2tilde(1,i-2)=b2(1,i-2)
2865 b2tilde(2,i-2)=-b2(2,i-2)
2866 EE(1,2,i-2)=eeold(1,2,iti)
2867 EE(2,1,i-2)=eeold(2,1,iti)
2868 EE(2,2,i-2)=eeold(2,2,iti)
2869 EE(1,1,i-2)=eeold(1,1,iti)
2873 do i=ivec_start+2,ivec_end+2
2877 if (i .lt. nres+1) then
2914 if (i .gt. 3 .and. i .lt. nres+1) then
2915 obrot_der(1,i-2)=-sin1
2916 obrot_der(2,i-2)= cos1
2917 Ugder(1,1,i-2)= sin1
2918 Ugder(1,2,i-2)=-cos1
2919 Ugder(2,1,i-2)=-cos1
2920 Ugder(2,2,i-2)=-sin1
2923 obrot2_der(1,i-2)=-dwasin2
2924 obrot2_der(2,i-2)= dwacos2
2925 Ug2der(1,1,i-2)= dwasin2
2926 Ug2der(1,2,i-2)=-dwacos2
2927 Ug2der(2,1,i-2)=-dwacos2
2928 Ug2der(2,2,i-2)=-dwasin2
2930 obrot_der(1,i-2)=0.0d0
2931 obrot_der(2,i-2)=0.0d0
2932 Ugder(1,1,i-2)=0.0d0
2933 Ugder(1,2,i-2)=0.0d0
2934 Ugder(2,1,i-2)=0.0d0
2935 Ugder(2,2,i-2)=0.0d0
2936 obrot2_der(1,i-2)=0.0d0
2937 obrot2_der(2,i-2)=0.0d0
2938 Ug2der(1,1,i-2)=0.0d0
2939 Ug2der(1,2,i-2)=0.0d0
2940 Ug2der(2,1,i-2)=0.0d0
2941 Ug2der(2,2,i-2)=0.0d0
2943 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2944 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2945 iti = itype2loc(itype(i-2))
2949 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2950 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2951 iti1 = itype2loc(itype(i-1))
2955 cd write (iout,*) '*******i',i,' iti1',iti
2956 cd write (iout,*) 'b1',b1(:,iti)
2957 cd write (iout,*) 'b2',b2(:,iti)
2958 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2959 c if (i .gt. iatel_s+2) then
2960 if (i .gt. nnt+2) then
2961 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2963 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2964 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2966 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
2967 c & EE(1,2,iti),EE(2,2,i)
2968 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2969 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2970 c write(iout,*) "Macierz EUG",
2971 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2973 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2975 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2976 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2977 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2978 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2979 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2990 DtUg2(l,k,i-2)=0.0d0
2994 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2995 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2997 muder(k,i-2)=Ub2der(k,i-2)
2999 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3000 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3001 if (itype(i-1).le.ntyp) then
3002 iti1 = itype2loc(itype(i-1))
3010 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
3013 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
3014 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
3015 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
3016 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
3017 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
3018 & ((ee(l,k,i-2),l=1,2),k=1,2),eenew(1,itype2loc(iti))
3020 cd write (iout,*) 'mu1',mu1(:,i-2)
3021 cd write (iout,*) 'mu2',mu2(:,i-2)
3022 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3024 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3025 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
3026 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3027 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
3028 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3029 C Vectors and matrices dependent on a single virtual-bond dihedral.
3030 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
3031 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3032 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3033 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
3034 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
3035 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3036 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3037 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3038 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3041 C Matrices dependent on two consecutive virtual-bond dihedrals.
3042 C The order of matrices is from left to right.
3043 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3045 c do i=max0(ivec_start,2),ivec_end
3047 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3048 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3049 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3050 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3051 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3052 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3053 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3054 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3057 #if defined(MPI) && defined(PARMAT)
3059 c if (fg_rank.eq.0) then
3060 write (iout,*) "Arrays UG and UGDER before GATHER"
3062 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3063 & ((ug(l,k,i),l=1,2),k=1,2),
3064 & ((ugder(l,k,i),l=1,2),k=1,2)
3066 write (iout,*) "Arrays UG2 and UG2DER"
3068 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3069 & ((ug2(l,k,i),l=1,2),k=1,2),
3070 & ((ug2der(l,k,i),l=1,2),k=1,2)
3072 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3074 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3075 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3076 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3078 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3080 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3081 & costab(i),sintab(i),costab2(i),sintab2(i)
3083 write (iout,*) "Array MUDER"
3085 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3089 if (nfgtasks.gt.1) then
3091 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
3092 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
3093 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
3095 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
3096 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3098 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
3099 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3101 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
3102 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3104 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
3105 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3107 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
3108 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3110 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
3111 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3113 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
3114 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
3115 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3116 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
3117 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
3118 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3119 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
3120 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
3121 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3122 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
3123 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
3124 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3125 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3127 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
3128 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3130 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
3131 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3133 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
3134 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3136 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3137 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3139 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3140 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3142 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3143 & ivec_count(fg_rank1),
3144 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3146 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3147 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3149 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3150 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3152 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3153 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3155 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3156 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3158 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3159 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3161 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3162 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3164 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3165 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3167 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3168 & ivec_count(fg_rank1),
3169 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3171 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3172 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3174 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3175 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3177 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3178 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3180 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3181 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3183 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3184 & ivec_count(fg_rank1),
3185 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3187 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3188 & ivec_count(fg_rank1),
3189 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3191 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3192 & ivec_count(fg_rank1),
3193 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3194 & MPI_MAT2,FG_COMM1,IERR)
3195 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3196 & ivec_count(fg_rank1),
3197 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3198 & MPI_MAT2,FG_COMM1,IERR)
3201 c Passes matrix info through the ring
3204 if (irecv.lt.0) irecv=nfgtasks1-1
3207 if (inext.ge.nfgtasks1) inext=0
3209 c write (iout,*) "isend",isend," irecv",irecv
3211 lensend=lentyp(isend)
3212 lenrecv=lentyp(irecv)
3213 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3214 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3215 c & MPI_ROTAT1(lensend),inext,2200+isend,
3216 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3217 c & iprev,2200+irecv,FG_COMM,status,IERR)
3218 c write (iout,*) "Gather ROTAT1"
3220 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3221 c & MPI_ROTAT2(lensend),inext,3300+isend,
3222 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3223 c & iprev,3300+irecv,FG_COMM,status,IERR)
3224 c write (iout,*) "Gather ROTAT2"
3226 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3227 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3228 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3229 & iprev,4400+irecv,FG_COMM,status,IERR)
3230 c write (iout,*) "Gather ROTAT_OLD"
3232 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3233 & MPI_PRECOMP11(lensend),inext,5500+isend,
3234 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3235 & iprev,5500+irecv,FG_COMM,status,IERR)
3236 c write (iout,*) "Gather PRECOMP11"
3238 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3239 & MPI_PRECOMP12(lensend),inext,6600+isend,
3240 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3241 & iprev,6600+irecv,FG_COMM,status,IERR)
3242 c write (iout,*) "Gather PRECOMP12"
3244 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3246 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3247 & MPI_ROTAT2(lensend),inext,7700+isend,
3248 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3249 & iprev,7700+irecv,FG_COMM,status,IERR)
3250 c write (iout,*) "Gather PRECOMP21"
3252 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3253 & MPI_PRECOMP22(lensend),inext,8800+isend,
3254 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3255 & iprev,8800+irecv,FG_COMM,status,IERR)
3256 c write (iout,*) "Gather PRECOMP22"
3258 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3259 & MPI_PRECOMP23(lensend),inext,9900+isend,
3260 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3261 & MPI_PRECOMP23(lenrecv),
3262 & iprev,9900+irecv,FG_COMM,status,IERR)
3263 c write (iout,*) "Gather PRECOMP23"
3268 if (irecv.lt.0) irecv=nfgtasks1-1
3271 time_gather=time_gather+MPI_Wtime()-time00
3274 c if (fg_rank.eq.0) then
3275 write (iout,*) "Arrays UG and UGDER"
3277 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3278 & ((ug(l,k,i),l=1,2),k=1,2),
3279 & ((ugder(l,k,i),l=1,2),k=1,2)
3281 write (iout,*) "Arrays UG2 and UG2DER"
3283 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3284 & ((ug2(l,k,i),l=1,2),k=1,2),
3285 & ((ug2der(l,k,i),l=1,2),k=1,2)
3287 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3289 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3290 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3291 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3293 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3295 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3296 & costab(i),sintab(i),costab2(i),sintab2(i)
3298 write (iout,*) "Array MUDER"
3300 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3306 cd iti = itype2loc(itype(i))
3309 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3310 cd & (EE(j,k,i),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3315 C--------------------------------------------------------------------------
3316 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3318 C This subroutine calculates the average interaction energy and its gradient
3319 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3320 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3321 C The potential depends both on the distance of peptide-group centers and on
3322 C the orientation of the CA-CA virtual bonds.
3324 implicit real*8 (a-h,o-z)
3328 include 'DIMENSIONS'
3329 include 'COMMON.CONTROL'
3330 include 'COMMON.SETUP'
3331 include 'COMMON.IOUNITS'
3332 include 'COMMON.GEO'
3333 include 'COMMON.VAR'
3334 include 'COMMON.LOCAL'
3335 include 'COMMON.CHAIN'
3336 include 'COMMON.DERIV'
3337 include 'COMMON.INTERACT'
3338 include 'COMMON.CONTACTS'
3339 include 'COMMON.TORSION'
3340 include 'COMMON.VECTORS'
3341 include 'COMMON.FFIELD'
3342 include 'COMMON.TIME1'
3343 include 'COMMON.SPLITELE'
3344 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3345 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3346 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3347 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3348 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3349 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3351 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3353 double precision scal_el /1.0d0/
3355 double precision scal_el /0.5d0/
3358 C 13-go grudnia roku pamietnego...
3359 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3360 & 0.0d0,1.0d0,0.0d0,
3361 & 0.0d0,0.0d0,1.0d0/
3362 cd write(iout,*) 'In EELEC'
3364 cd write(iout,*) 'Type',i
3365 cd write(iout,*) 'B1',B1(:,i)
3366 cd write(iout,*) 'B2',B2(:,i)
3367 cd write(iout,*) 'CC',CC(:,:,i)
3368 cd write(iout,*) 'DD',DD(:,:,i)
3369 cd write(iout,*) 'EE',EE(:,:,i)
3371 cd call check_vecgrad
3373 if (icheckgrad.eq.1) then
3375 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3377 dc_norm(k,i)=dc(k,i)*fac
3379 c write (iout,*) 'i',i,' fac',fac
3382 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3383 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3384 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3385 c call vec_and_deriv
3391 time_mat=time_mat+MPI_Wtime()-time01
3395 cd write (iout,*) 'i=',i
3397 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3400 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3401 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3414 cd print '(a)','Enter EELEC'
3415 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3417 gel_loc_loc(i)=0.0d0
3422 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3424 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3426 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3427 do i=iturn3_start,iturn3_end
3429 C write(iout,*) "tu jest i",i
3430 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3431 C changes suggested by Ana to avoid out of bounds
3432 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
3433 c & .or.((i+4).gt.nres)
3434 c & .or.((i-1).le.0)
3435 C end of changes by Ana
3436 & .or. itype(i+2).eq.ntyp1
3437 & .or. itype(i+3).eq.ntyp1) cycle
3438 C Adam: Instructions below will switch off existing interactions
3440 c if(itype(i-1).eq.ntyp1)cycle
3442 c if(i.LT.nres-3)then
3443 c if (itype(i+4).eq.ntyp1) cycle
3448 dx_normi=dc_norm(1,i)
3449 dy_normi=dc_norm(2,i)
3450 dz_normi=dc_norm(3,i)
3451 xmedi=c(1,i)+0.5d0*dxi
3452 ymedi=c(2,i)+0.5d0*dyi
3453 zmedi=c(3,i)+0.5d0*dzi
3454 xmedi=mod(xmedi,boxxsize)
3455 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3456 ymedi=mod(ymedi,boxysize)
3457 if (ymedi.lt.0) ymedi=ymedi+boxysize
3458 zmedi=mod(zmedi,boxzsize)
3459 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3461 call eelecij(i,i+2,ees,evdw1,eel_loc)
3462 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3463 num_cont_hb(i)=num_conti
3465 do i=iturn4_start,iturn4_end
3467 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3468 C changes suggested by Ana to avoid out of bounds
3469 c & .or.((i+5).gt.nres)
3470 c & .or.((i-1).le.0)
3471 C end of changes suggested by Ana
3472 & .or. itype(i+3).eq.ntyp1
3473 & .or. itype(i+4).eq.ntyp1
3474 c & .or. itype(i+5).eq.ntyp1
3475 c & .or. itype(i).eq.ntyp1
3476 c & .or. itype(i-1).eq.ntyp1
3481 dx_normi=dc_norm(1,i)
3482 dy_normi=dc_norm(2,i)
3483 dz_normi=dc_norm(3,i)
3484 xmedi=c(1,i)+0.5d0*dxi
3485 ymedi=c(2,i)+0.5d0*dyi
3486 zmedi=c(3,i)+0.5d0*dzi
3487 C Return atom into box, boxxsize is size of box in x dimension
3489 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3490 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3491 C Condition for being inside the proper box
3492 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3493 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3497 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3498 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3499 C Condition for being inside the proper box
3500 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3501 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3505 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3506 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3507 C Condition for being inside the proper box
3508 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3509 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3512 xmedi=mod(xmedi,boxxsize)
3513 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3514 ymedi=mod(ymedi,boxysize)
3515 if (ymedi.lt.0) ymedi=ymedi+boxysize
3516 zmedi=mod(zmedi,boxzsize)
3517 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3519 num_conti=num_cont_hb(i)
3520 c write(iout,*) "JESTEM W PETLI"
3521 call eelecij(i,i+3,ees,evdw1,eel_loc)
3522 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3523 & call eturn4(i,eello_turn4)
3524 num_cont_hb(i)=num_conti
3526 C Loop over all neighbouring boxes
3531 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3534 do i=iatel_s,iatel_e
3537 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3538 C changes suggested by Ana to avoid out of bounds
3539 c & .or.((i+2).gt.nres)
3540 c & .or.((i-1).le.0)
3541 C end of changes by Ana
3542 c & .or. itype(i+2).eq.ntyp1
3543 c & .or. itype(i-1).eq.ntyp1
3548 dx_normi=dc_norm(1,i)
3549 dy_normi=dc_norm(2,i)
3550 dz_normi=dc_norm(3,i)
3551 xmedi=c(1,i)+0.5d0*dxi
3552 ymedi=c(2,i)+0.5d0*dyi
3553 zmedi=c(3,i)+0.5d0*dzi
3554 xmedi=mod(xmedi,boxxsize)
3555 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3556 ymedi=mod(ymedi,boxysize)
3557 if (ymedi.lt.0) ymedi=ymedi+boxysize
3558 zmedi=mod(zmedi,boxzsize)
3559 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3560 C xmedi=xmedi+xshift*boxxsize
3561 C ymedi=ymedi+yshift*boxysize
3562 C zmedi=zmedi+zshift*boxzsize
3564 C Return tom into box, boxxsize is size of box in x dimension
3566 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3567 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3568 C Condition for being inside the proper box
3569 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3570 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3574 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3575 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3576 C Condition for being inside the proper box
3577 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3578 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3582 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3583 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3584 cC Condition for being inside the proper box
3585 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3586 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3590 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3591 num_conti=num_cont_hb(i)
3593 do j=ielstart(i),ielend(i)
3595 C write (iout,*) i,j
3597 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3598 C changes suggested by Ana to avoid out of bounds
3599 c & .or.((j+2).gt.nres)
3600 c & .or.((j-1).le.0)
3601 C end of changes by Ana
3602 c & .or.itype(j+2).eq.ntyp1
3603 c & .or.itype(j-1).eq.ntyp1
3605 call eelecij(i,j,ees,evdw1,eel_loc)
3607 num_cont_hb(i)=num_conti
3613 c write (iout,*) "Number of loop steps in EELEC:",ind
3615 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3616 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3618 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3619 ccc eel_loc=eel_loc+eello_turn3
3620 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3623 C-------------------------------------------------------------------------------
3624 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3625 implicit real*8 (a-h,o-z)
3626 include 'DIMENSIONS'
3630 include 'COMMON.CONTROL'
3631 include 'COMMON.IOUNITS'
3632 include 'COMMON.GEO'
3633 include 'COMMON.VAR'
3634 include 'COMMON.LOCAL'
3635 include 'COMMON.CHAIN'
3636 include 'COMMON.DERIV'
3637 include 'COMMON.INTERACT'
3638 include 'COMMON.CONTACTS'
3639 include 'COMMON.TORSION'
3640 include 'COMMON.VECTORS'
3641 include 'COMMON.FFIELD'
3642 include 'COMMON.TIME1'
3643 include 'COMMON.SPLITELE'
3644 include 'COMMON.SHIELD'
3645 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3646 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3647 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3648 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3649 & gmuij2(4),gmuji2(4)
3650 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3651 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3653 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3655 double precision scal_el /1.0d0/
3657 double precision scal_el /0.5d0/
3660 C 13-go grudnia roku pamietnego...
3661 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3662 & 0.0d0,1.0d0,0.0d0,
3663 & 0.0d0,0.0d0,1.0d0/
3664 integer xshift,yshift,zshift
3665 c time00=MPI_Wtime()
3666 cd write (iout,*) "eelecij",i,j
3670 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3671 aaa=app(iteli,itelj)
3672 bbb=bpp(iteli,itelj)
3673 ael6i=ael6(iteli,itelj)
3674 ael3i=ael3(iteli,itelj)
3678 dx_normj=dc_norm(1,j)
3679 dy_normj=dc_norm(2,j)
3680 dz_normj=dc_norm(3,j)
3681 C xj=c(1,j)+0.5D0*dxj-xmedi
3682 C yj=c(2,j)+0.5D0*dyj-ymedi
3683 C zj=c(3,j)+0.5D0*dzj-zmedi
3688 if (xj.lt.0) xj=xj+boxxsize
3690 if (yj.lt.0) yj=yj+boxysize
3692 if (zj.lt.0) zj=zj+boxzsize
3693 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3694 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3702 xj=xj_safe+xshift*boxxsize
3703 yj=yj_safe+yshift*boxysize
3704 zj=zj_safe+zshift*boxzsize
3705 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3706 if(dist_temp.lt.dist_init) then
3716 if (isubchap.eq.1) then
3725 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3727 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3728 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3729 C Condition for being inside the proper box
3730 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3731 c & (xj.lt.((-0.5d0)*boxxsize))) then
3735 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3736 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3737 C Condition for being inside the proper box
3738 c if ((yj.gt.((0.5d0)*boxysize)).or.
3739 c & (yj.lt.((-0.5d0)*boxysize))) then
3743 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3744 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3745 C Condition for being inside the proper box
3746 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3747 c & (zj.lt.((-0.5d0)*boxzsize))) then
3750 C endif !endPBC condintion
3754 rij=xj*xj+yj*yj+zj*zj
3756 sss=sscale(sqrt(rij))
3757 sssgrad=sscagrad(sqrt(rij))
3758 c if (sss.gt.0.0d0) then
3764 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3765 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3766 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3767 fac=cosa-3.0D0*cosb*cosg
3769 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3770 if (j.eq.i+2) ev1=scal_el*ev1
3775 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3779 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3780 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3781 if (shield_mode.gt.0) then
3784 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3785 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3794 evdw1=evdw1+evdwij*sss
3795 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3796 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3797 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3798 cd & xmedi,ymedi,zmedi,xj,yj,zj
3800 if (energy_dec) then
3801 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3803 &,iteli,itelj,aaa,evdw1
3804 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
3805 &fac_shield(i),fac_shield(j)
3809 C Calculate contributions to the Cartesian gradient.
3812 facvdw=-6*rrmij*(ev1+evdwij)*sss
3813 facel=-3*rrmij*(el1+eesij)
3820 * Radial derivatives. First process both termini of the fragment (i,j)
3825 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3826 & (shield_mode.gt.0)) then
3828 do ilist=1,ishield_list(i)
3829 iresshield=shield_list(ilist,i)
3831 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
3833 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3835 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
3836 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3837 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3838 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3839 C if (iresshield.gt.i) then
3840 C do ishi=i+1,iresshield-1
3841 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3842 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3846 C do ishi=iresshield,i
3847 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3848 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3854 do ilist=1,ishield_list(j)
3855 iresshield=shield_list(ilist,j)
3857 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
3859 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3861 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
3862 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3864 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3865 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3866 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3867 C if (iresshield.gt.j) then
3868 C do ishi=j+1,iresshield-1
3869 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3870 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3874 C do ishi=iresshield,j
3875 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3876 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3883 gshieldc(k,i)=gshieldc(k,i)+
3884 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
3885 gshieldc(k,j)=gshieldc(k,j)+
3886 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
3887 gshieldc(k,i-1)=gshieldc(k,i-1)+
3888 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
3889 gshieldc(k,j-1)=gshieldc(k,j-1)+
3890 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
3895 c ghalf=0.5D0*ggg(k)
3896 c gelc(k,i)=gelc(k,i)+ghalf
3897 c gelc(k,j)=gelc(k,j)+ghalf
3899 c 9/28/08 AL Gradient compotents will be summed only at the end
3900 C print *,"before", gelc_long(1,i), gelc_long(1,j)
3902 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3903 C & +grad_shield(k,j)*eesij/fac_shield(j)
3904 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3905 C & +grad_shield(k,i)*eesij/fac_shield(i)
3906 C gelc_long(k,i-1)=gelc_long(k,i-1)
3907 C & +grad_shield(k,i)*eesij/fac_shield(i)
3908 C gelc_long(k,j-1)=gelc_long(k,j-1)
3909 C & +grad_shield(k,j)*eesij/fac_shield(j)
3911 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
3914 * Loop over residues i+1 thru j-1.
3918 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3921 if (sss.gt.0.0) then
3922 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3923 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3924 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3931 c ghalf=0.5D0*ggg(k)
3932 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3933 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3935 c 9/28/08 AL Gradient compotents will be summed only at the end
3937 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3938 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3941 * Loop over residues i+1 thru j-1.
3945 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3950 facvdw=(ev1+evdwij)*sss
3953 fac=-3*rrmij*(facvdw+facvdw+facel)
3958 * Radial derivatives. First process both termini of the fragment (i,j)
3961 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
3963 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
3965 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
3967 c ghalf=0.5D0*ggg(k)
3968 c gelc(k,i)=gelc(k,i)+ghalf
3969 c gelc(k,j)=gelc(k,j)+ghalf
3971 c 9/28/08 AL Gradient compotents will be summed only at the end
3973 gelc_long(k,j)=gelc(k,j)+ggg(k)
3974 gelc_long(k,i)=gelc(k,i)-ggg(k)
3977 * Loop over residues i+1 thru j-1.
3981 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3984 c 9/28/08 AL Gradient compotents will be summed only at the end
3985 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3986 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3987 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3989 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3990 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3996 ecosa=2.0D0*fac3*fac1+fac4
3999 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
4000 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
4002 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4003 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4005 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
4006 cd & (dcosg(k),k=1,3)
4008 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
4009 & fac_shield(i)**2*fac_shield(j)**2
4012 c ghalf=0.5D0*ggg(k)
4013 c gelc(k,i)=gelc(k,i)+ghalf
4014 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4015 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4016 c gelc(k,j)=gelc(k,j)+ghalf
4017 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4018 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4022 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4025 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
4028 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4029 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
4030 & *fac_shield(i)**2*fac_shield(j)**2
4032 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4033 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
4034 & *fac_shield(i)**2*fac_shield(j)**2
4035 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4036 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4038 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
4042 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
4043 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
4044 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4046 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
4047 C energy of a peptide unit is assumed in the form of a second-order
4048 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
4049 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
4050 C are computed for EVERY pair of non-contiguous peptide groups.
4053 if (j.lt.nres-1) then
4065 muij(kkk)=mu(k,i)*mu(l,j)
4066 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
4068 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
4069 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
4070 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
4071 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
4072 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
4073 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4077 cd write (iout,*) 'EELEC: i',i,' j',j
4078 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
4079 cd write(iout,*) 'muij',muij
4080 ury=scalar(uy(1,i),erij)
4081 urz=scalar(uz(1,i),erij)
4082 vry=scalar(uy(1,j),erij)
4083 vrz=scalar(uz(1,j),erij)
4084 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4085 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4086 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4087 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4088 fac=dsqrt(-ael6i)*r3ij
4093 cd write (iout,'(4i5,4f10.5)')
4094 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
4095 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4096 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4097 cd & uy(:,j),uz(:,j)
4098 cd write (iout,'(4f10.5)')
4099 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4100 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4101 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
4102 cd write (iout,'(9f10.5/)')
4103 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4104 C Derivatives of the elements of A in virtual-bond vectors
4105 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4107 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4108 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4109 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4110 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4111 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4112 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4113 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4114 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4115 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4116 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4117 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4118 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4120 C Compute radial contributions to the gradient
4138 C Add the contributions coming from er
4141 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4142 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4143 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4144 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4147 C Derivatives in DC(i)
4148 cgrad ghalf1=0.5d0*agg(k,1)
4149 cgrad ghalf2=0.5d0*agg(k,2)
4150 cgrad ghalf3=0.5d0*agg(k,3)
4151 cgrad ghalf4=0.5d0*agg(k,4)
4152 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
4153 & -3.0d0*uryg(k,2)*vry)!+ghalf1
4154 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
4155 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
4156 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
4157 & -3.0d0*urzg(k,2)*vry)!+ghalf3
4158 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
4159 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
4160 C Derivatives in DC(i+1)
4161 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
4162 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4163 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
4164 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4165 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
4166 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4167 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
4168 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4169 C Derivatives in DC(j)
4170 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
4171 & -3.0d0*vryg(k,2)*ury)!+ghalf1
4172 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4173 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4174 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4175 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4176 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4177 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4178 C Derivatives in DC(j+1) or DC(nres-1)
4179 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4180 & -3.0d0*vryg(k,3)*ury)
4181 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4182 & -3.0d0*vrzg(k,3)*ury)
4183 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4184 & -3.0d0*vryg(k,3)*urz)
4185 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4186 & -3.0d0*vrzg(k,3)*urz)
4187 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4189 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4202 aggi(k,l)=-aggi(k,l)
4203 aggi1(k,l)=-aggi1(k,l)
4204 aggj(k,l)=-aggj(k,l)
4205 aggj1(k,l)=-aggj1(k,l)
4208 if (j.lt.nres-1) then
4214 aggi(k,l)=-aggi(k,l)
4215 aggi1(k,l)=-aggi1(k,l)
4216 aggj(k,l)=-aggj(k,l)
4217 aggj1(k,l)=-aggj1(k,l)
4228 aggi(k,l)=-aggi(k,l)
4229 aggi1(k,l)=-aggi1(k,l)
4230 aggj(k,l)=-aggj(k,l)
4231 aggj1(k,l)=-aggj1(k,l)
4236 IF (wel_loc.gt.0.0d0) THEN
4237 C Contribution to the local-electrostatic energy coming from the i-j pair
4238 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4240 if (shield_mode.eq.0) then
4247 eel_loc_ij=eel_loc_ij
4248 & *fac_shield(i)*fac_shield(j)
4249 C Now derivative over eel_loc
4250 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4251 & (shield_mode.gt.0)) then
4254 do ilist=1,ishield_list(i)
4255 iresshield=shield_list(ilist,i)
4257 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
4260 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4262 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
4263 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4267 do ilist=1,ishield_list(j)
4268 iresshield=shield_list(ilist,j)
4270 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
4273 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4275 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
4276 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4283 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
4284 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4285 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
4286 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4287 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
4288 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4289 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
4290 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4295 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4296 c & ' eel_loc_ij',eel_loc_ij
4297 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4298 C Calculate patrial derivative for theta angle
4300 geel_loc_ij=(a22*gmuij1(1)
4304 & *fac_shield(i)*fac_shield(j)
4305 c write(iout,*) "derivative over thatai"
4306 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4308 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4309 & geel_loc_ij*wel_loc
4310 c write(iout,*) "derivative over thatai-1"
4311 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4318 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4319 & geel_loc_ij*wel_loc
4320 & *fac_shield(i)*fac_shield(j)
4322 c Derivative over j residue
4323 geel_loc_ji=a22*gmuji1(1)
4327 c write(iout,*) "derivative over thataj"
4328 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4331 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4332 & geel_loc_ji*wel_loc
4333 & *fac_shield(i)*fac_shield(j)
4340 c write(iout,*) "derivative over thataj-1"
4341 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4343 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4344 & geel_loc_ji*wel_loc
4345 & *fac_shield(i)*fac_shield(j)
4347 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4349 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4350 & 'eelloc',i,j,eel_loc_ij
4351 c if (eel_loc_ij.ne.0)
4352 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4353 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4355 eel_loc=eel_loc+eel_loc_ij
4356 C Partial derivatives in virtual-bond dihedral angles gamma
4358 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4359 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4360 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
4361 & *fac_shield(i)*fac_shield(j)
4363 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4364 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4365 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
4366 & *fac_shield(i)*fac_shield(j)
4367 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4369 ggg(l)=(agg(l,1)*muij(1)+
4370 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
4371 & *fac_shield(i)*fac_shield(j)
4372 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4373 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4374 cgrad ghalf=0.5d0*ggg(l)
4375 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4376 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4380 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4383 C Remaining derivatives of eello
4385 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4386 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4387 & *fac_shield(i)*fac_shield(j)
4389 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4390 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4391 & *fac_shield(i)*fac_shield(j)
4393 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4394 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4395 & *fac_shield(i)*fac_shield(j)
4397 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4398 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4399 & *fac_shield(i)*fac_shield(j)
4403 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4404 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4405 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4406 & .and. num_conti.le.maxconts) then
4407 c write (iout,*) i,j," entered corr"
4409 C Calculate the contact function. The ith column of the array JCONT will
4410 C contain the numbers of atoms that make contacts with the atom I (of numbers
4411 C greater than I). The arrays FACONT and GACONT will contain the values of
4412 C the contact function and its derivative.
4413 c r0ij=1.02D0*rpp(iteli,itelj)
4414 c r0ij=1.11D0*rpp(iteli,itelj)
4415 r0ij=2.20D0*rpp(iteli,itelj)
4416 c r0ij=1.55D0*rpp(iteli,itelj)
4417 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4418 if (fcont.gt.0.0D0) then
4419 num_conti=num_conti+1
4420 if (num_conti.gt.maxconts) then
4421 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4422 & ' will skip next contacts for this conf.'
4424 jcont_hb(num_conti,i)=j
4425 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4426 cd & " jcont_hb",jcont_hb(num_conti,i)
4427 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4428 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4429 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4431 d_cont(num_conti,i)=rij
4432 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4433 C --- Electrostatic-interaction matrix ---
4434 a_chuj(1,1,num_conti,i)=a22
4435 a_chuj(1,2,num_conti,i)=a23
4436 a_chuj(2,1,num_conti,i)=a32
4437 a_chuj(2,2,num_conti,i)=a33
4438 C --- Gradient of rij
4440 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4447 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4448 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4449 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4450 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4451 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4456 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4457 C Calculate contact energies
4459 wij=cosa-3.0D0*cosb*cosg
4462 c fac3=dsqrt(-ael6i)/r0ij**3
4463 fac3=dsqrt(-ael6i)*r3ij
4464 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4465 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4466 if (ees0tmp.gt.0) then
4467 ees0pij=dsqrt(ees0tmp)
4471 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4472 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4473 if (ees0tmp.gt.0) then
4474 ees0mij=dsqrt(ees0tmp)
4479 if (shield_mode.eq.0) then
4483 ees0plist(num_conti,i)=j
4484 C fac_shield(i)=0.4d0
4485 C fac_shield(j)=0.6d0
4487 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4488 & *fac_shield(i)*fac_shield(j)
4489 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4490 & *fac_shield(i)*fac_shield(j)
4491 C Diagnostics. Comment out or remove after debugging!
4492 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4493 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4494 c ees0m(num_conti,i)=0.0D0
4496 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4497 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4498 C Angular derivatives of the contact function
4499 ees0pij1=fac3/ees0pij
4500 ees0mij1=fac3/ees0mij
4501 fac3p=-3.0D0*fac3*rrmij
4502 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4503 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4505 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4506 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4507 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4508 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4509 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4510 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4511 ecosap=ecosa1+ecosa2
4512 ecosbp=ecosb1+ecosb2
4513 ecosgp=ecosg1+ecosg2
4514 ecosam=ecosa1-ecosa2
4515 ecosbm=ecosb1-ecosb2
4516 ecosgm=ecosg1-ecosg2
4525 facont_hb(num_conti,i)=fcont
4526 fprimcont=fprimcont/rij
4527 cd facont_hb(num_conti,i)=1.0D0
4528 C Following line is for diagnostics.
4531 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4532 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4535 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4536 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4538 gggp(1)=gggp(1)+ees0pijp*xj
4539 gggp(2)=gggp(2)+ees0pijp*yj
4540 gggp(3)=gggp(3)+ees0pijp*zj
4541 gggm(1)=gggm(1)+ees0mijp*xj
4542 gggm(2)=gggm(2)+ees0mijp*yj
4543 gggm(3)=gggm(3)+ees0mijp*zj
4544 C Derivatives due to the contact function
4545 gacont_hbr(1,num_conti,i)=fprimcont*xj
4546 gacont_hbr(2,num_conti,i)=fprimcont*yj
4547 gacont_hbr(3,num_conti,i)=fprimcont*zj
4550 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4551 c following the change of gradient-summation algorithm.
4553 cgrad ghalfp=0.5D0*gggp(k)
4554 cgrad ghalfm=0.5D0*gggm(k)
4555 gacontp_hb1(k,num_conti,i)=!ghalfp
4556 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4557 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4558 & *fac_shield(i)*fac_shield(j)
4560 gacontp_hb2(k,num_conti,i)=!ghalfp
4561 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4562 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4563 & *fac_shield(i)*fac_shield(j)
4565 gacontp_hb3(k,num_conti,i)=gggp(k)
4566 & *fac_shield(i)*fac_shield(j)
4568 gacontm_hb1(k,num_conti,i)=!ghalfm
4569 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4570 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4571 & *fac_shield(i)*fac_shield(j)
4573 gacontm_hb2(k,num_conti,i)=!ghalfm
4574 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4575 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4576 & *fac_shield(i)*fac_shield(j)
4578 gacontm_hb3(k,num_conti,i)=gggm(k)
4579 & *fac_shield(i)*fac_shield(j)
4582 C Diagnostics. Comment out or remove after debugging!
4584 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4585 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4586 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4587 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4588 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4589 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4592 endif ! num_conti.le.maxconts
4595 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4598 ghalf=0.5d0*agg(l,k)
4599 aggi(l,k)=aggi(l,k)+ghalf
4600 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4601 aggj(l,k)=aggj(l,k)+ghalf
4604 if (j.eq.nres-1 .and. i.lt.j-2) then
4607 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4612 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4615 C-----------------------------------------------------------------------------
4616 subroutine eturn3(i,eello_turn3)
4617 C Third- and fourth-order contributions from turns
4618 implicit real*8 (a-h,o-z)
4619 include 'DIMENSIONS'
4620 include 'COMMON.IOUNITS'
4621 include 'COMMON.GEO'
4622 include 'COMMON.VAR'
4623 include 'COMMON.LOCAL'
4624 include 'COMMON.CHAIN'
4625 include 'COMMON.DERIV'
4626 include 'COMMON.INTERACT'
4627 include 'COMMON.CONTACTS'
4628 include 'COMMON.TORSION'
4629 include 'COMMON.VECTORS'
4630 include 'COMMON.FFIELD'
4631 include 'COMMON.CONTROL'
4632 include 'COMMON.SHIELD'
4634 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4635 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4636 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4637 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4638 & auxgmat2(2,2),auxgmatt2(2,2)
4639 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4640 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4641 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4642 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4645 c write (iout,*) "eturn3",i,j,j1,j2
4650 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4652 C Third-order contributions
4659 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4660 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4661 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4662 c auxalary matices for theta gradient
4663 c auxalary matrix for i+1 and constant i+2
4664 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4665 c auxalary matrix for i+2 and constant i+1
4666 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4667 call transpose2(auxmat(1,1),auxmat1(1,1))
4668 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4669 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4670 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4671 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4672 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4673 if (shield_mode.eq.0) then
4680 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4681 & *fac_shield(i)*fac_shield(j)
4682 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
4683 & *fac_shield(i)*fac_shield(j)
4684 C Derivatives in theta
4685 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4686 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4687 & *fac_shield(i)*fac_shield(j)
4688 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4689 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4690 & *fac_shield(i)*fac_shield(j)
4693 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4694 C Derivatives in shield mode
4695 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4696 & (shield_mode.gt.0)) then
4699 do ilist=1,ishield_list(i)
4700 iresshield=shield_list(ilist,i)
4702 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4704 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4706 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4707 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4711 do ilist=1,ishield_list(j)
4712 iresshield=shield_list(ilist,j)
4714 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4716 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4718 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4719 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4726 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
4727 & grad_shield(k,i)*eello_t3/fac_shield(i)
4728 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
4729 & grad_shield(k,j)*eello_t3/fac_shield(j)
4730 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
4731 & grad_shield(k,i)*eello_t3/fac_shield(i)
4732 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
4733 & grad_shield(k,j)*eello_t3/fac_shield(j)
4737 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4738 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4739 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4740 cd & ' eello_turn3_num',4*eello_turn3_num
4741 C Derivatives in gamma(i)
4742 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4743 call transpose2(auxmat2(1,1),auxmat3(1,1))
4744 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4745 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4746 & *fac_shield(i)*fac_shield(j)
4747 C Derivatives in gamma(i+1)
4748 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4749 call transpose2(auxmat2(1,1),auxmat3(1,1))
4750 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4751 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4752 & +0.5d0*(pizda(1,1)+pizda(2,2))
4753 & *fac_shield(i)*fac_shield(j)
4754 C Cartesian derivatives
4756 c ghalf1=0.5d0*agg(l,1)
4757 c ghalf2=0.5d0*agg(l,2)
4758 c ghalf3=0.5d0*agg(l,3)
4759 c ghalf4=0.5d0*agg(l,4)
4760 a_temp(1,1)=aggi(l,1)!+ghalf1
4761 a_temp(1,2)=aggi(l,2)!+ghalf2
4762 a_temp(2,1)=aggi(l,3)!+ghalf3
4763 a_temp(2,2)=aggi(l,4)!+ghalf4
4764 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4765 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4766 & +0.5d0*(pizda(1,1)+pizda(2,2))
4767 & *fac_shield(i)*fac_shield(j)
4769 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4770 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4771 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4772 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4773 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4774 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4775 & +0.5d0*(pizda(1,1)+pizda(2,2))
4776 & *fac_shield(i)*fac_shield(j)
4777 a_temp(1,1)=aggj(l,1)!+ghalf1
4778 a_temp(1,2)=aggj(l,2)!+ghalf2
4779 a_temp(2,1)=aggj(l,3)!+ghalf3
4780 a_temp(2,2)=aggj(l,4)!+ghalf4
4781 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4782 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4783 & +0.5d0*(pizda(1,1)+pizda(2,2))
4784 & *fac_shield(i)*fac_shield(j)
4785 a_temp(1,1)=aggj1(l,1)
4786 a_temp(1,2)=aggj1(l,2)
4787 a_temp(2,1)=aggj1(l,3)
4788 a_temp(2,2)=aggj1(l,4)
4789 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4790 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4791 & +0.5d0*(pizda(1,1)+pizda(2,2))
4792 & *fac_shield(i)*fac_shield(j)
4796 C-------------------------------------------------------------------------------
4797 subroutine eturn4(i,eello_turn4)
4798 C Third- and fourth-order contributions from turns
4799 implicit real*8 (a-h,o-z)
4800 include 'DIMENSIONS'
4801 include 'COMMON.IOUNITS'
4802 include 'COMMON.GEO'
4803 include 'COMMON.VAR'
4804 include 'COMMON.LOCAL'
4805 include 'COMMON.CHAIN'
4806 include 'COMMON.DERIV'
4807 include 'COMMON.INTERACT'
4808 include 'COMMON.CONTACTS'
4809 include 'COMMON.TORSION'
4810 include 'COMMON.VECTORS'
4811 include 'COMMON.FFIELD'
4812 include 'COMMON.CONTROL'
4813 include 'COMMON.SHIELD'
4815 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4816 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4817 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4818 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4819 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4820 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4821 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4822 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4823 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4824 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4825 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4828 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4830 C Fourth-order contributions
4838 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4839 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4840 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4841 c write(iout,*)"WCHODZE W PROGRAM"
4846 iti1=itype2loc(itype(i+1))
4847 iti2=itype2loc(itype(i+2))
4848 iti3=itype2loc(itype(i+3))
4849 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4850 call transpose2(EUg(1,1,i+1),e1t(1,1))
4851 call transpose2(Eug(1,1,i+2),e2t(1,1))
4852 call transpose2(Eug(1,1,i+3),e3t(1,1))
4853 C Ematrix derivative in theta
4854 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4855 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4856 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4857 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4858 c eta1 in derivative theta
4859 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4860 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4861 c auxgvec is derivative of Ub2 so i+3 theta
4862 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4863 c auxalary matrix of E i+1
4864 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4867 s1=scalar2(b1(1,i+2),auxvec(1))
4868 c derivative of theta i+2 with constant i+3
4869 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4870 c derivative of theta i+2 with constant i+2
4871 gs32=scalar2(b1(1,i+2),auxgvec(1))
4872 c derivative of E matix in theta of i+1
4873 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4875 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4876 c ea31 in derivative theta
4877 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4878 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4879 c auxilary matrix auxgvec of Ub2 with constant E matirx
4880 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4881 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4882 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4886 s2=scalar2(b1(1,i+1),auxvec(1))
4887 c derivative of theta i+1 with constant i+3
4888 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4889 c derivative of theta i+2 with constant i+1
4890 gs21=scalar2(b1(1,i+1),auxgvec(1))
4891 c derivative of theta i+3 with constant i+1
4892 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4893 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4895 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4896 c two derivatives over diffetent matrices
4897 c gtae3e2 is derivative over i+3
4898 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4899 c ae3gte2 is derivative over i+2
4900 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4901 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4902 c three possible derivative over theta E matices
4904 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4906 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4908 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4909 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4911 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4912 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4913 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4914 if (shield_mode.eq.0) then
4921 eello_turn4=eello_turn4-(s1+s2+s3)
4922 & *fac_shield(i)*fac_shield(j)
4923 eello_t4=-(s1+s2+s3)
4924 & *fac_shield(i)*fac_shield(j)
4925 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4926 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4927 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4928 C Now derivative over shield:
4929 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4930 & (shield_mode.gt.0)) then
4933 do ilist=1,ishield_list(i)
4934 iresshield=shield_list(ilist,i)
4936 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
4938 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
4940 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
4941 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
4945 do ilist=1,ishield_list(j)
4946 iresshield=shield_list(ilist,j)
4948 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
4950 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
4952 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
4953 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
4960 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
4961 & grad_shield(k,i)*eello_t4/fac_shield(i)
4962 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
4963 & grad_shield(k,j)*eello_t4/fac_shield(j)
4964 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
4965 & grad_shield(k,i)*eello_t4/fac_shield(i)
4966 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
4967 & grad_shield(k,j)*eello_t4/fac_shield(j)
4976 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4977 cd & ' eello_turn4_num',8*eello_turn4_num
4979 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4980 & -(gs13+gsE13+gsEE1)*wturn4
4981 & *fac_shield(i)*fac_shield(j)
4982 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4983 & -(gs23+gs21+gsEE2)*wturn4
4984 & *fac_shield(i)*fac_shield(j)
4986 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4987 & -(gs32+gsE31+gsEE3)*wturn4
4988 & *fac_shield(i)*fac_shield(j)
4990 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4993 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4994 & 'eturn4',i,j,-(s1+s2+s3)
4995 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4996 c & ' eello_turn4_num',8*eello_turn4_num
4997 C Derivatives in gamma(i)
4998 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4999 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
5000 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
5001 s1=scalar2(b1(1,i+2),auxvec(1))
5002 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
5003 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5004 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
5005 & *fac_shield(i)*fac_shield(j)
5006 C Derivatives in gamma(i+1)
5007 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
5008 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
5009 s2=scalar2(b1(1,i+1),auxvec(1))
5010 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5011 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5012 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5013 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
5014 & *fac_shield(i)*fac_shield(j)
5015 C Derivatives in gamma(i+2)
5016 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5017 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5018 s1=scalar2(b1(1,i+2),auxvec(1))
5019 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5020 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5021 s2=scalar2(b1(1,i+1),auxvec(1))
5022 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5023 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5024 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5025 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
5026 & *fac_shield(i)*fac_shield(j)
5027 C Cartesian derivatives
5028 C Derivatives of this turn contributions in DC(i+2)
5029 if (j.lt.nres-1) then
5031 a_temp(1,1)=agg(l,1)
5032 a_temp(1,2)=agg(l,2)
5033 a_temp(2,1)=agg(l,3)
5034 a_temp(2,2)=agg(l,4)
5035 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5036 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5037 s1=scalar2(b1(1,i+2),auxvec(1))
5038 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5039 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5040 s2=scalar2(b1(1,i+1),auxvec(1))
5041 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5042 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5043 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5045 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
5046 & *fac_shield(i)*fac_shield(j)
5049 C Remaining derivatives of this turn contribution
5051 a_temp(1,1)=aggi(l,1)
5052 a_temp(1,2)=aggi(l,2)
5053 a_temp(2,1)=aggi(l,3)
5054 a_temp(2,2)=aggi(l,4)
5055 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5056 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5057 s1=scalar2(b1(1,i+2),auxvec(1))
5058 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5059 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5060 s2=scalar2(b1(1,i+1),auxvec(1))
5061 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5062 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5063 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5064 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
5065 & *fac_shield(i)*fac_shield(j)
5066 a_temp(1,1)=aggi1(l,1)
5067 a_temp(1,2)=aggi1(l,2)
5068 a_temp(2,1)=aggi1(l,3)
5069 a_temp(2,2)=aggi1(l,4)
5070 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5071 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5072 s1=scalar2(b1(1,i+2),auxvec(1))
5073 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5074 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5075 s2=scalar2(b1(1,i+1),auxvec(1))
5076 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5077 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5078 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5079 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
5080 & *fac_shield(i)*fac_shield(j)
5081 a_temp(1,1)=aggj(l,1)
5082 a_temp(1,2)=aggj(l,2)
5083 a_temp(2,1)=aggj(l,3)
5084 a_temp(2,2)=aggj(l,4)
5085 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5086 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5087 s1=scalar2(b1(1,i+2),auxvec(1))
5088 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5089 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5090 s2=scalar2(b1(1,i+1),auxvec(1))
5091 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5092 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5093 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5094 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
5095 & *fac_shield(i)*fac_shield(j)
5096 a_temp(1,1)=aggj1(l,1)
5097 a_temp(1,2)=aggj1(l,2)
5098 a_temp(2,1)=aggj1(l,3)
5099 a_temp(2,2)=aggj1(l,4)
5100 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5101 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5102 s1=scalar2(b1(1,i+2),auxvec(1))
5103 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5104 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5105 s2=scalar2(b1(1,i+1),auxvec(1))
5106 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5107 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5108 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5109 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5110 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
5111 & *fac_shield(i)*fac_shield(j)
5115 C-----------------------------------------------------------------------------
5116 subroutine vecpr(u,v,w)
5117 implicit real*8(a-h,o-z)
5118 dimension u(3),v(3),w(3)
5119 w(1)=u(2)*v(3)-u(3)*v(2)
5120 w(2)=-u(1)*v(3)+u(3)*v(1)
5121 w(3)=u(1)*v(2)-u(2)*v(1)
5124 C-----------------------------------------------------------------------------
5125 subroutine unormderiv(u,ugrad,unorm,ungrad)
5126 C This subroutine computes the derivatives of a normalized vector u, given
5127 C the derivatives computed without normalization conditions, ugrad. Returns
5130 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
5131 double precision vec(3)
5132 double precision scalar
5134 c write (2,*) 'ugrad',ugrad
5137 vec(i)=scalar(ugrad(1,i),u(1))
5139 c write (2,*) 'vec',vec
5142 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5145 c write (2,*) 'ungrad',ungrad
5148 C-----------------------------------------------------------------------------
5149 subroutine escp_soft_sphere(evdw2,evdw2_14)
5151 C This subroutine calculates the excluded-volume interaction energy between
5152 C peptide-group centers and side chains and its gradient in virtual-bond and
5153 C side-chain vectors.
5155 implicit real*8 (a-h,o-z)
5156 include 'DIMENSIONS'
5157 include 'COMMON.GEO'
5158 include 'COMMON.VAR'
5159 include 'COMMON.LOCAL'
5160 include 'COMMON.CHAIN'
5161 include 'COMMON.DERIV'
5162 include 'COMMON.INTERACT'
5163 include 'COMMON.FFIELD'
5164 include 'COMMON.IOUNITS'
5165 include 'COMMON.CONTROL'
5170 cd print '(a)','Enter ESCP'
5171 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5175 do i=iatscp_s,iatscp_e
5176 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5178 xi=0.5D0*(c(1,i)+c(1,i+1))
5179 yi=0.5D0*(c(2,i)+c(2,i+1))
5180 zi=0.5D0*(c(3,i)+c(3,i+1))
5181 C Return atom into box, boxxsize is size of box in x dimension
5183 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5184 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5185 C Condition for being inside the proper box
5186 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5187 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5191 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5192 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5193 C Condition for being inside the proper box
5194 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5195 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5199 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5200 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5201 cC Condition for being inside the proper box
5202 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5203 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5207 if (xi.lt.0) xi=xi+boxxsize
5209 if (yi.lt.0) yi=yi+boxysize
5211 if (zi.lt.0) zi=zi+boxzsize
5212 C xi=xi+xshift*boxxsize
5213 C yi=yi+yshift*boxysize
5214 C zi=zi+zshift*boxzsize
5215 do iint=1,nscp_gr(i)
5217 do j=iscpstart(i,iint),iscpend(i,iint)
5218 if (itype(j).eq.ntyp1) cycle
5219 itypj=iabs(itype(j))
5220 C Uncomment following three lines for SC-p interactions
5224 C Uncomment following three lines for Ca-p interactions
5229 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5230 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5231 C Condition for being inside the proper box
5232 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5233 c & (xj.lt.((-0.5d0)*boxxsize))) then
5237 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5238 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5239 cC Condition for being inside the proper box
5240 c if ((yj.gt.((0.5d0)*boxysize)).or.
5241 c & (yj.lt.((-0.5d0)*boxysize))) then
5245 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5246 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5247 C Condition for being inside the proper box
5248 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5249 c & (zj.lt.((-0.5d0)*boxzsize))) then
5252 if (xj.lt.0) xj=xj+boxxsize
5254 if (yj.lt.0) yj=yj+boxysize
5256 if (zj.lt.0) zj=zj+boxzsize
5257 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5265 xj=xj_safe+xshift*boxxsize
5266 yj=yj_safe+yshift*boxysize
5267 zj=zj_safe+zshift*boxzsize
5268 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5269 if(dist_temp.lt.dist_init) then
5279 if (subchap.eq.1) then
5292 rij=xj*xj+yj*yj+zj*zj
5296 if (rij.lt.r0ijsq) then
5297 evdwij=0.25d0*(rij-r0ijsq)**2
5305 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5310 cgrad if (j.lt.i) then
5311 cd write (iout,*) 'j<i'
5312 C Uncomment following three lines for SC-p interactions
5314 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5317 cd write (iout,*) 'j>i'
5319 cgrad ggg(k)=-ggg(k)
5320 C Uncomment following line for SC-p interactions
5321 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5325 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5327 cgrad kstart=min0(i+1,j)
5328 cgrad kend=max0(i-1,j-1)
5329 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5330 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5331 cgrad do k=kstart,kend
5333 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5337 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5338 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5349 C-----------------------------------------------------------------------------
5350 subroutine escp(evdw2,evdw2_14)
5352 C This subroutine calculates the excluded-volume interaction energy between
5353 C peptide-group centers and side chains and its gradient in virtual-bond and
5354 C side-chain vectors.
5356 implicit real*8 (a-h,o-z)
5357 include 'DIMENSIONS'
5358 include 'COMMON.GEO'
5359 include 'COMMON.VAR'
5360 include 'COMMON.LOCAL'
5361 include 'COMMON.CHAIN'
5362 include 'COMMON.DERIV'
5363 include 'COMMON.INTERACT'
5364 include 'COMMON.FFIELD'
5365 include 'COMMON.IOUNITS'
5366 include 'COMMON.CONTROL'
5367 include 'COMMON.SPLITELE'
5371 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
5372 cd print '(a)','Enter ESCP'
5373 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5377 do i=iatscp_s,iatscp_e
5378 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5380 xi=0.5D0*(c(1,i)+c(1,i+1))
5381 yi=0.5D0*(c(2,i)+c(2,i+1))
5382 zi=0.5D0*(c(3,i)+c(3,i+1))
5384 if (xi.lt.0) xi=xi+boxxsize
5386 if (yi.lt.0) yi=yi+boxysize
5388 if (zi.lt.0) zi=zi+boxzsize
5389 c xi=xi+xshift*boxxsize
5390 c yi=yi+yshift*boxysize
5391 c zi=zi+zshift*boxzsize
5392 c print *,xi,yi,zi,'polozenie i'
5393 C Return atom into box, boxxsize is size of box in x dimension
5395 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5396 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5397 C Condition for being inside the proper box
5398 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5399 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5403 c print *,xi,boxxsize,"pierwszy"
5405 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5406 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5407 C Condition for being inside the proper box
5408 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5409 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5413 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5414 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5415 C Condition for being inside the proper box
5416 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5417 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5420 do iint=1,nscp_gr(i)
5422 do j=iscpstart(i,iint),iscpend(i,iint)
5423 itypj=iabs(itype(j))
5424 if (itypj.eq.ntyp1) cycle
5425 C Uncomment following three lines for SC-p interactions
5429 C Uncomment following three lines for Ca-p interactions
5434 if (xj.lt.0) xj=xj+boxxsize
5436 if (yj.lt.0) yj=yj+boxysize
5438 if (zj.lt.0) zj=zj+boxzsize
5440 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5441 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5442 C Condition for being inside the proper box
5443 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5444 c & (xj.lt.((-0.5d0)*boxxsize))) then
5448 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5449 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5450 cC Condition for being inside the proper box
5451 c if ((yj.gt.((0.5d0)*boxysize)).or.
5452 c & (yj.lt.((-0.5d0)*boxysize))) then
5456 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5457 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5458 C Condition for being inside the proper box
5459 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5460 c & (zj.lt.((-0.5d0)*boxzsize))) then
5463 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5464 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5472 xj=xj_safe+xshift*boxxsize
5473 yj=yj_safe+yshift*boxysize
5474 zj=zj_safe+zshift*boxzsize
5475 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5476 if(dist_temp.lt.dist_init) then
5486 if (subchap.eq.1) then
5495 c print *,xj,yj,zj,'polozenie j'
5496 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5498 sss=sscale(1.0d0/(dsqrt(rrij)))
5499 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5500 c if (sss.eq.0) print *,'czasem jest OK'
5501 if (sss.le.0.0d0) cycle
5502 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5504 e1=fac*fac*aad(itypj,iteli)
5505 e2=fac*bad(itypj,iteli)
5506 if (iabs(j-i) .le. 2) then
5509 evdw2_14=evdw2_14+(e1+e2)*sss
5512 evdw2=evdw2+evdwij*sss
5513 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5514 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5517 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5519 fac=-(evdwij+e1)*rrij*sss
5520 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5524 cgrad if (j.lt.i) then
5525 cd write (iout,*) 'j<i'
5526 C Uncomment following three lines for SC-p interactions
5528 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5531 cd write (iout,*) 'j>i'
5533 cgrad ggg(k)=-ggg(k)
5534 C Uncomment following line for SC-p interactions
5535 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5536 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5540 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5542 cgrad kstart=min0(i+1,j)
5543 cgrad kend=max0(i-1,j-1)
5544 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5545 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5546 cgrad do k=kstart,kend
5548 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5552 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5553 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5555 c endif !endif for sscale cutoff
5565 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5566 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5567 gradx_scp(j,i)=expon*gradx_scp(j,i)
5570 C******************************************************************************
5574 C To save time the factor EXPON has been extracted from ALL components
5575 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5578 C******************************************************************************
5581 C--------------------------------------------------------------------------
5582 subroutine edis(ehpb)
5584 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5586 implicit real*8 (a-h,o-z)
5587 include 'DIMENSIONS'
5588 include 'COMMON.SBRIDGE'
5589 include 'COMMON.CHAIN'
5590 include 'COMMON.DERIV'
5591 include 'COMMON.VAR'
5592 include 'COMMON.INTERACT'
5593 include 'COMMON.IOUNITS'
5594 include 'COMMON.CONTROL'
5600 C write (iout,*) ,"link_end",link_end,constr_dist
5601 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5602 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5603 if (link_end.eq.0) return
5604 do i=link_start,link_end
5605 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5606 C CA-CA distance used in regularization of structure.
5609 C iii and jjj point to the residues for which the distance is assigned.
5610 if (ii.gt.nres) then
5617 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5618 c & dhpb(i),dhpb1(i),forcon(i)
5619 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5620 C distance and angle dependent SS bond potential.
5621 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5622 C & iabs(itype(jjj)).eq.1) then
5623 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5624 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5625 if (.not.dyn_ss .and. i.le.nss) then
5626 C 15/02/13 CC dynamic SSbond - additional check
5627 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5628 & iabs(itype(jjj)).eq.1) then
5629 call ssbond_ene(iii,jjj,eij)
5632 cd write (iout,*) "eij",eij
5633 cd & ' waga=',waga,' fac=',fac
5634 else if (ii.gt.nres .and. jj.gt.nres) then
5635 c Restraints from contact prediction
5637 if (constr_dist.eq.11) then
5638 ehpb=ehpb+fordepth(i)**4.0d0
5639 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5640 fac=fordepth(i)**4.0d0
5641 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5642 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5643 & ehpb,fordepth(i),dd
5645 if (dhpb1(i).gt.0.0d0) then
5646 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5647 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5648 c write (iout,*) "beta nmr",
5649 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5653 C Get the force constant corresponding to this distance.
5655 C Calculate the contribution to energy.
5656 ehpb=ehpb+waga*rdis*rdis
5657 c write (iout,*) "beta reg",dd,waga*rdis*rdis
5659 C Evaluate gradient.
5665 ggg(j)=fac*(c(j,jj)-c(j,ii))
5668 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5669 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5672 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5673 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5676 C Calculate the distance between the two points and its difference from the
5679 if (constr_dist.eq.11) then
5680 ehpb=ehpb+fordepth(i)**4.0d0
5681 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5682 fac=fordepth(i)**4.0d0
5683 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5684 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5685 & ehpb,fordepth(i),dd
5687 if (dhpb1(i).gt.0.0d0) then
5688 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5689 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5690 c write (iout,*) "alph nmr",
5691 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5694 C Get the force constant corresponding to this distance.
5696 C Calculate the contribution to energy.
5697 ehpb=ehpb+waga*rdis*rdis
5698 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5700 C Evaluate gradient.
5706 ggg(j)=fac*(c(j,jj)-c(j,ii))
5708 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5709 C If this is a SC-SC distance, we need to calculate the contributions to the
5710 C Cartesian gradient in the SC vectors (ghpbx).
5713 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5714 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5717 cgrad do j=iii,jjj-1
5719 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5723 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5724 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5728 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5731 C--------------------------------------------------------------------------
5732 subroutine ssbond_ene(i,j,eij)
5734 C Calculate the distance and angle dependent SS-bond potential energy
5735 C using a free-energy function derived based on RHF/6-31G** ab initio
5736 C calculations of diethyl disulfide.
5738 C A. Liwo and U. Kozlowska, 11/24/03
5740 implicit real*8 (a-h,o-z)
5741 include 'DIMENSIONS'
5742 include 'COMMON.SBRIDGE'
5743 include 'COMMON.CHAIN'
5744 include 'COMMON.DERIV'
5745 include 'COMMON.LOCAL'
5746 include 'COMMON.INTERACT'
5747 include 'COMMON.VAR'
5748 include 'COMMON.IOUNITS'
5749 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5750 itypi=iabs(itype(i))
5754 dxi=dc_norm(1,nres+i)
5755 dyi=dc_norm(2,nres+i)
5756 dzi=dc_norm(3,nres+i)
5757 c dsci_inv=dsc_inv(itypi)
5758 dsci_inv=vbld_inv(nres+i)
5759 itypj=iabs(itype(j))
5760 c dscj_inv=dsc_inv(itypj)
5761 dscj_inv=vbld_inv(nres+j)
5765 dxj=dc_norm(1,nres+j)
5766 dyj=dc_norm(2,nres+j)
5767 dzj=dc_norm(3,nres+j)
5768 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5773 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5774 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5775 om12=dxi*dxj+dyi*dyj+dzi*dzj
5777 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5778 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5784 deltat12=om2-om1+2.0d0
5786 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5787 & +akct*deltad*deltat12
5788 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5789 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5790 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5791 c & " deltat12",deltat12," eij",eij
5792 ed=2*akcm*deltad+akct*deltat12
5794 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5795 eom1=-2*akth*deltat1-pom1-om2*pom2
5796 eom2= 2*akth*deltat2+pom1-om1*pom2
5799 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5800 ghpbx(k,i)=ghpbx(k,i)-ggk
5801 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5802 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5803 ghpbx(k,j)=ghpbx(k,j)+ggk
5804 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5805 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5806 ghpbc(k,i)=ghpbc(k,i)-ggk
5807 ghpbc(k,j)=ghpbc(k,j)+ggk
5810 C Calculate the components of the gradient in DC and X
5814 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5819 C--------------------------------------------------------------------------
5820 subroutine ebond(estr)
5822 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5824 implicit real*8 (a-h,o-z)
5825 include 'DIMENSIONS'
5826 include 'COMMON.LOCAL'
5827 include 'COMMON.GEO'
5828 include 'COMMON.INTERACT'
5829 include 'COMMON.DERIV'
5830 include 'COMMON.VAR'
5831 include 'COMMON.CHAIN'
5832 include 'COMMON.IOUNITS'
5833 include 'COMMON.NAMES'
5834 include 'COMMON.FFIELD'
5835 include 'COMMON.CONTROL'
5836 include 'COMMON.SETUP'
5837 double precision u(3),ud(3)
5840 do i=ibondp_start,ibondp_end
5841 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5842 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5844 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5845 c & *dc(j,i-1)/vbld(i)
5847 c if (energy_dec) write(iout,*)
5848 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5850 C Checking if it involves dummy (NH3+ or COO-) group
5851 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5852 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5853 diff = vbld(i)-vbldpDUM
5854 if (energy_dec) write(iout,*) "dum_bond",i,diff
5856 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5857 diff = vbld(i)-vbldp0
5859 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5860 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5863 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5865 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5869 estr=0.5d0*AKP*estr+estr1
5871 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5873 do i=ibond_start,ibond_end
5875 if (iti.ne.10 .and. iti.ne.ntyp1) then
5878 diff=vbld(i+nres)-vbldsc0(1,iti)
5879 if (energy_dec) write (iout,*)
5880 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5881 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5882 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5884 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5888 diff=vbld(i+nres)-vbldsc0(j,iti)
5889 ud(j)=aksc(j,iti)*diff
5890 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5904 uprod2=uprod2*u(k)*u(k)
5908 usumsqder=usumsqder+ud(j)*uprod2
5910 estr=estr+uprod/usum
5912 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5920 C--------------------------------------------------------------------------
5921 subroutine ebend(etheta,ethetacnstr)
5923 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5924 C angles gamma and its derivatives in consecutive thetas and gammas.
5926 implicit real*8 (a-h,o-z)
5927 include 'DIMENSIONS'
5928 include 'COMMON.LOCAL'
5929 include 'COMMON.GEO'
5930 include 'COMMON.INTERACT'
5931 include 'COMMON.DERIV'
5932 include 'COMMON.VAR'
5933 include 'COMMON.CHAIN'
5934 include 'COMMON.IOUNITS'
5935 include 'COMMON.NAMES'
5936 include 'COMMON.FFIELD'
5937 include 'COMMON.CONTROL'
5938 include 'COMMON.TORCNSTR'
5939 common /calcthet/ term1,term2,termm,diffak,ratak,
5940 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5941 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5942 double precision y(2),z(2)
5944 c time11=dexp(-2*time)
5947 c write (*,'(a,i2)') 'EBEND ICG=',icg
5948 do i=ithet_start,ithet_end
5949 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5950 & .or.itype(i).eq.ntyp1) cycle
5951 C Zero the energy function and its derivative at 0 or pi.
5952 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5954 ichir1=isign(1,itype(i-2))
5955 ichir2=isign(1,itype(i))
5956 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5957 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5958 if (itype(i-1).eq.10) then
5959 itype1=isign(10,itype(i-2))
5960 ichir11=isign(1,itype(i-2))
5961 ichir12=isign(1,itype(i-2))
5962 itype2=isign(10,itype(i))
5963 ichir21=isign(1,itype(i))
5964 ichir22=isign(1,itype(i))
5967 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5970 if (phii.ne.phii) phii=150.0
5980 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5983 if (phii1.ne.phii1) phii1=150.0
5995 C Calculate the "mean" value of theta from the part of the distribution
5996 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5997 C In following comments this theta will be referred to as t_c.
5998 thet_pred_mean=0.0d0
6000 athetk=athet(k,it,ichir1,ichir2)
6001 bthetk=bthet(k,it,ichir1,ichir2)
6003 athetk=athet(k,itype1,ichir11,ichir12)
6004 bthetk=bthet(k,itype2,ichir21,ichir22)
6006 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
6007 c write(iout,*) 'chuj tu', y(k),z(k)
6009 dthett=thet_pred_mean*ssd
6010 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
6011 C Derivatives of the "mean" values in gamma1 and gamma2.
6012 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
6013 &+athet(2,it,ichir1,ichir2)*y(1))*ss
6014 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
6015 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
6017 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
6018 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
6019 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
6020 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
6022 if (theta(i).gt.pi-delta) then
6023 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
6025 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
6026 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6027 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
6029 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
6031 else if (theta(i).lt.delta) then
6032 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
6033 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6034 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
6036 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
6037 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
6040 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
6043 etheta=etheta+ethetai
6044 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
6045 & 'ebend',i,ethetai,theta(i),itype(i)
6046 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
6047 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
6048 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
6051 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6052 do i=ithetaconstr_start,ithetaconstr_end
6053 itheta=itheta_constr(i)
6054 thetiii=theta(itheta)
6055 difi=pinorm(thetiii-theta_constr0(i))
6056 if (difi.gt.theta_drange(i)) then
6057 difi=difi-theta_drange(i)
6058 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6059 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6060 & +for_thet_constr(i)*difi**3
6061 else if (difi.lt.-drange(i)) then
6063 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6064 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6065 & +for_thet_constr(i)*difi**3
6069 if (energy_dec) then
6070 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6071 & i,itheta,rad2deg*thetiii,
6072 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6073 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6074 & gloc(itheta+nphi-2,icg)
6078 C Ufff.... We've done all this!!!
6081 C---------------------------------------------------------------------------
6082 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
6084 implicit real*8 (a-h,o-z)
6085 include 'DIMENSIONS'
6086 include 'COMMON.LOCAL'
6087 include 'COMMON.IOUNITS'
6088 common /calcthet/ term1,term2,termm,diffak,ratak,
6089 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6090 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6091 C Calculate the contributions to both Gaussian lobes.
6092 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6093 C The "polynomial part" of the "standard deviation" of this part of
6094 C the distributioni.
6095 ccc write (iout,*) thetai,thet_pred_mean
6098 sig=sig*thet_pred_mean+polthet(j,it)
6100 C Derivative of the "interior part" of the "standard deviation of the"
6101 C gamma-dependent Gaussian lobe in t_c.
6102 sigtc=3*polthet(3,it)
6104 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6107 C Set the parameters of both Gaussian lobes of the distribution.
6108 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6109 fac=sig*sig+sigc0(it)
6112 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6113 sigsqtc=-4.0D0*sigcsq*sigtc
6114 c print *,i,sig,sigtc,sigsqtc
6115 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
6116 sigtc=-sigtc/(fac*fac)
6117 C Following variable is sigma(t_c)**(-2)
6118 sigcsq=sigcsq*sigcsq
6120 sig0inv=1.0D0/sig0i**2
6121 delthec=thetai-thet_pred_mean
6122 delthe0=thetai-theta0i
6123 term1=-0.5D0*sigcsq*delthec*delthec
6124 term2=-0.5D0*sig0inv*delthe0*delthe0
6125 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
6126 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6127 C NaNs in taking the logarithm. We extract the largest exponent which is added
6128 C to the energy (this being the log of the distribution) at the end of energy
6129 C term evaluation for this virtual-bond angle.
6130 if (term1.gt.term2) then
6132 term2=dexp(term2-termm)
6136 term1=dexp(term1-termm)
6139 C The ratio between the gamma-independent and gamma-dependent lobes of
6140 C the distribution is a Gaussian function of thet_pred_mean too.
6141 diffak=gthet(2,it)-thet_pred_mean
6142 ratak=diffak/gthet(3,it)**2
6143 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6144 C Let's differentiate it in thet_pred_mean NOW.
6146 C Now put together the distribution terms to make complete distribution.
6147 termexp=term1+ak*term2
6148 termpre=sigc+ak*sig0i
6149 C Contribution of the bending energy from this theta is just the -log of
6150 C the sum of the contributions from the two lobes and the pre-exponential
6151 C factor. Simple enough, isn't it?
6152 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6153 C write (iout,*) 'termexp',termexp,termm,termpre,i
6154 C NOW the derivatives!!!
6155 C 6/6/97 Take into account the deformation.
6156 E_theta=(delthec*sigcsq*term1
6157 & +ak*delthe0*sig0inv*term2)/termexp
6158 E_tc=((sigtc+aktc*sig0i)/termpre
6159 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
6160 & aktc*term2)/termexp)
6163 c-----------------------------------------------------------------------------
6164 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
6165 implicit real*8 (a-h,o-z)
6166 include 'DIMENSIONS'
6167 include 'COMMON.LOCAL'
6168 include 'COMMON.IOUNITS'
6169 common /calcthet/ term1,term2,termm,diffak,ratak,
6170 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6171 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6172 delthec=thetai-thet_pred_mean
6173 delthe0=thetai-theta0i
6174 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
6175 t3 = thetai-thet_pred_mean
6179 t14 = t12+t6*sigsqtc
6181 t21 = thetai-theta0i
6187 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
6188 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
6189 & *(-t12*t9-ak*sig0inv*t27)
6193 C--------------------------------------------------------------------------
6194 subroutine ebend(etheta,ethetacnstr)
6196 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6197 C angles gamma and its derivatives in consecutive thetas and gammas.
6198 C ab initio-derived potentials from
6199 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6201 implicit real*8 (a-h,o-z)
6202 include 'DIMENSIONS'
6203 include 'COMMON.LOCAL'
6204 include 'COMMON.GEO'
6205 include 'COMMON.INTERACT'
6206 include 'COMMON.DERIV'
6207 include 'COMMON.VAR'
6208 include 'COMMON.CHAIN'
6209 include 'COMMON.IOUNITS'
6210 include 'COMMON.NAMES'
6211 include 'COMMON.FFIELD'
6212 include 'COMMON.CONTROL'
6213 include 'COMMON.TORCNSTR'
6214 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
6215 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
6216 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
6217 & sinph1ph2(maxdouble,maxdouble)
6218 logical lprn /.false./, lprn1 /.false./
6220 do i=ithet_start,ithet_end
6221 c print *,i,itype(i-1),itype(i),itype(i-2)
6222 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6223 & .or.itype(i).eq.ntyp1) cycle
6224 C print *,i,theta(i)
6225 if (iabs(itype(i+1)).eq.20) iblock=2
6226 if (iabs(itype(i+1)).ne.20) iblock=1
6230 theti2=0.5d0*theta(i)
6231 ityp2=ithetyp((itype(i-1)))
6233 coskt(k)=dcos(k*theti2)
6234 sinkt(k)=dsin(k*theti2)
6237 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
6240 if (phii.ne.phii) phii=150.0
6244 ityp1=ithetyp((itype(i-2)))
6245 C propagation of chirality for glycine type
6247 cosph1(k)=dcos(k*phii)
6248 sinph1(k)=dsin(k*phii)
6253 ityp1=ithetyp((itype(i-2)))
6258 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6261 if (phii1.ne.phii1) phii1=150.0
6266 ityp3=ithetyp((itype(i)))
6268 cosph2(k)=dcos(k*phii1)
6269 sinph2(k)=dsin(k*phii1)
6273 ityp3=ithetyp((itype(i)))
6279 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
6282 ccl=cosph1(l)*cosph2(k-l)
6283 ssl=sinph1(l)*sinph2(k-l)
6284 scl=sinph1(l)*cosph2(k-l)
6285 csl=cosph1(l)*sinph2(k-l)
6286 cosph1ph2(l,k)=ccl-ssl
6287 cosph1ph2(k,l)=ccl+ssl
6288 sinph1ph2(l,k)=scl+csl
6289 sinph1ph2(k,l)=scl-csl
6293 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
6294 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6295 write (iout,*) "coskt and sinkt"
6297 write (iout,*) k,coskt(k),sinkt(k)
6301 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6302 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
6305 & write (iout,*) "k",k,"
6306 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
6307 & " ethetai",ethetai
6310 write (iout,*) "cosph and sinph"
6312 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6314 write (iout,*) "cosph1ph2 and sinph2ph2"
6317 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6318 & sinph1ph2(l,k),sinph1ph2(k,l)
6321 write(iout,*) "ethetai",ethetai
6326 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
6327 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
6328 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
6329 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6330 ethetai=ethetai+sinkt(m)*aux
6331 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6332 dephii=dephii+k*sinkt(m)*(
6333 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
6334 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6335 dephii1=dephii1+k*sinkt(m)*(
6336 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
6337 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6339 & write (iout,*) "m",m," k",k," bbthet",
6340 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
6341 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
6342 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
6343 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6344 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6347 C print *,"cosph1", (cosph1(k), k=1,nsingle)
6348 C print *,"cosph2", (cosph2(k), k=1,nsingle)
6349 C print *,"sinph1", (sinph1(k), k=1,nsingle)
6350 C print *,"sinph2", (sinph2(k), k=1,nsingle)
6352 & write(iout,*) "ethetai",ethetai
6353 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6357 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6358 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
6359 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6360 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6361 ethetai=ethetai+sinkt(m)*aux
6362 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6363 dephii=dephii+l*sinkt(m)*(
6364 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
6365 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6366 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6367 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6368 dephii1=dephii1+(k-l)*sinkt(m)*(
6369 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6370 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6371 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
6372 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6374 write (iout,*) "m",m," k",k," l",l," ffthet",
6375 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6376 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
6377 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6378 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
6379 & " ethetai",ethetai
6380 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6381 & cosph1ph2(k,l)*sinkt(m),
6382 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6391 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6392 & i,theta(i)*rad2deg,phii*rad2deg,
6393 & phii1*rad2deg,ethetai
6395 etheta=etheta+ethetai
6396 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6397 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6398 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
6402 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6403 do i=ithetaconstr_start,ithetaconstr_end
6404 itheta=itheta_constr(i)
6405 thetiii=theta(itheta)
6406 difi=pinorm(thetiii-theta_constr0(i))
6407 if (difi.gt.theta_drange(i)) then
6408 difi=difi-theta_drange(i)
6409 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6410 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6411 & +for_thet_constr(i)*difi**3
6412 else if (difi.lt.-drange(i)) then
6414 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6415 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6416 & +for_thet_constr(i)*difi**3
6420 if (energy_dec) then
6421 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6422 & i,itheta,rad2deg*thetiii,
6423 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6424 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6425 & gloc(itheta+nphi-2,icg)
6433 c-----------------------------------------------------------------------------
6434 subroutine esc(escloc)
6435 C Calculate the local energy of a side chain and its derivatives in the
6436 C corresponding virtual-bond valence angles THETA and the spherical angles
6438 implicit real*8 (a-h,o-z)
6439 include 'DIMENSIONS'
6440 include 'COMMON.GEO'
6441 include 'COMMON.LOCAL'
6442 include 'COMMON.VAR'
6443 include 'COMMON.INTERACT'
6444 include 'COMMON.DERIV'
6445 include 'COMMON.CHAIN'
6446 include 'COMMON.IOUNITS'
6447 include 'COMMON.NAMES'
6448 include 'COMMON.FFIELD'
6449 include 'COMMON.CONTROL'
6450 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6451 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6452 common /sccalc/ time11,time12,time112,theti,it,nlobit
6455 c write (iout,'(a)') 'ESC'
6456 do i=loc_start,loc_end
6458 if (it.eq.ntyp1) cycle
6459 if (it.eq.10) goto 1
6460 nlobit=nlob(iabs(it))
6461 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6462 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6463 theti=theta(i+1)-pipol
6468 if (x(2).gt.pi-delta) then
6472 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6474 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6475 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6477 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6478 & ddersc0(1),dersc(1))
6479 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6480 & ddersc0(3),dersc(3))
6482 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6484 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6485 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6486 & dersc0(2),esclocbi,dersc02)
6487 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6489 call splinthet(x(2),0.5d0*delta,ss,ssd)
6494 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6496 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6497 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6499 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6501 c write (iout,*) escloci
6502 else if (x(2).lt.delta) then
6506 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6508 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6509 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6511 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6512 & ddersc0(1),dersc(1))
6513 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6514 & ddersc0(3),dersc(3))
6516 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6518 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6519 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6520 & dersc0(2),esclocbi,dersc02)
6521 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6526 call splinthet(x(2),0.5d0*delta,ss,ssd)
6528 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6530 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6531 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6533 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6534 c write (iout,*) escloci
6536 call enesc(x,escloci,dersc,ddummy,.false.)
6539 escloc=escloc+escloci
6540 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6541 & 'escloc',i,escloci
6542 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6544 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6546 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6547 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6552 C---------------------------------------------------------------------------
6553 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6554 implicit real*8 (a-h,o-z)
6555 include 'DIMENSIONS'
6556 include 'COMMON.GEO'
6557 include 'COMMON.LOCAL'
6558 include 'COMMON.IOUNITS'
6559 common /sccalc/ time11,time12,time112,theti,it,nlobit
6560 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6561 double precision contr(maxlob,-1:1)
6563 c write (iout,*) 'it=',it,' nlobit=',nlobit
6567 if (mixed) ddersc(j)=0.0d0
6571 C Because of periodicity of the dependence of the SC energy in omega we have
6572 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6573 C To avoid underflows, first compute & store the exponents.
6581 z(k)=x(k)-censc(k,j,it)
6586 Axk=Axk+gaussc(l,k,j,it)*z(l)
6592 expfac=expfac+Ax(k,j,iii)*z(k)
6600 C As in the case of ebend, we want to avoid underflows in exponentiation and
6601 C subsequent NaNs and INFs in energy calculation.
6602 C Find the largest exponent
6606 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6610 cd print *,'it=',it,' emin=',emin
6612 C Compute the contribution to SC energy and derivatives
6617 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6618 if(adexp.ne.adexp) adexp=1.0
6621 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6623 cd print *,'j=',j,' expfac=',expfac
6624 escloc_i=escloc_i+expfac
6626 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6630 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6631 & +gaussc(k,2,j,it))*expfac
6638 dersc(1)=dersc(1)/cos(theti)**2
6639 ddersc(1)=ddersc(1)/cos(theti)**2
6642 escloci=-(dlog(escloc_i)-emin)
6644 dersc(j)=dersc(j)/escloc_i
6648 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6653 C------------------------------------------------------------------------------
6654 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6655 implicit real*8 (a-h,o-z)
6656 include 'DIMENSIONS'
6657 include 'COMMON.GEO'
6658 include 'COMMON.LOCAL'
6659 include 'COMMON.IOUNITS'
6660 common /sccalc/ time11,time12,time112,theti,it,nlobit
6661 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6662 double precision contr(maxlob)
6673 z(k)=x(k)-censc(k,j,it)
6679 Axk=Axk+gaussc(l,k,j,it)*z(l)
6685 expfac=expfac+Ax(k,j)*z(k)
6690 C As in the case of ebend, we want to avoid underflows in exponentiation and
6691 C subsequent NaNs and INFs in energy calculation.
6692 C Find the largest exponent
6695 if (emin.gt.contr(j)) emin=contr(j)
6699 C Compute the contribution to SC energy and derivatives
6703 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6704 escloc_i=escloc_i+expfac
6706 dersc(k)=dersc(k)+Ax(k,j)*expfac
6708 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6709 & +gaussc(1,2,j,it))*expfac
6713 dersc(1)=dersc(1)/cos(theti)**2
6714 dersc12=dersc12/cos(theti)**2
6715 escloci=-(dlog(escloc_i)-emin)
6717 dersc(j)=dersc(j)/escloc_i
6719 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6723 c----------------------------------------------------------------------------------
6724 subroutine esc(escloc)
6725 C Calculate the local energy of a side chain and its derivatives in the
6726 C corresponding virtual-bond valence angles THETA and the spherical angles
6727 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6728 C added by Urszula Kozlowska. 07/11/2007
6730 implicit real*8 (a-h,o-z)
6731 include 'DIMENSIONS'
6732 include 'COMMON.GEO'
6733 include 'COMMON.LOCAL'
6734 include 'COMMON.VAR'
6735 include 'COMMON.SCROT'
6736 include 'COMMON.INTERACT'
6737 include 'COMMON.DERIV'
6738 include 'COMMON.CHAIN'
6739 include 'COMMON.IOUNITS'
6740 include 'COMMON.NAMES'
6741 include 'COMMON.FFIELD'
6742 include 'COMMON.CONTROL'
6743 include 'COMMON.VECTORS'
6744 double precision x_prime(3),y_prime(3),z_prime(3)
6745 & , sumene,dsc_i,dp2_i,x(65),
6746 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6747 & de_dxx,de_dyy,de_dzz,de_dt
6748 double precision s1_t,s1_6_t,s2_t,s2_6_t
6750 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6751 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6752 & dt_dCi(3),dt_dCi1(3)
6753 common /sccalc/ time11,time12,time112,theti,it,nlobit
6756 do i=loc_start,loc_end
6757 if (itype(i).eq.ntyp1) cycle
6758 costtab(i+1) =dcos(theta(i+1))
6759 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6760 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6761 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6762 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6763 cosfac=dsqrt(cosfac2)
6764 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6765 sinfac=dsqrt(sinfac2)
6767 if (it.eq.10) goto 1
6769 C Compute the axes of tghe local cartesian coordinates system; store in
6770 c x_prime, y_prime and z_prime
6777 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6778 C & dc_norm(3,i+nres)
6780 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6781 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6784 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6787 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6788 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6789 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6790 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6791 c & " xy",scalar(x_prime(1),y_prime(1)),
6792 c & " xz",scalar(x_prime(1),z_prime(1)),
6793 c & " yy",scalar(y_prime(1),y_prime(1)),
6794 c & " yz",scalar(y_prime(1),z_prime(1)),
6795 c & " zz",scalar(z_prime(1),z_prime(1))
6797 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6798 C to local coordinate system. Store in xx, yy, zz.
6804 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6805 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6806 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6813 C Compute the energy of the ith side cbain
6815 c write (2,*) "xx",xx," yy",yy," zz",zz
6818 x(j) = sc_parmin(j,it)
6821 Cc diagnostics - remove later
6823 yy1 = dsin(alph(2))*dcos(omeg(2))
6824 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6825 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6826 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6828 C," --- ", xx_w,yy_w,zz_w
6831 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6832 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6834 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6835 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6837 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6838 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6839 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6840 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6841 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6843 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6844 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6845 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6846 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6847 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6849 dsc_i = 0.743d0+x(61)
6851 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6852 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6853 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6854 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6855 s1=(1+x(63))/(0.1d0 + dscp1)
6856 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6857 s2=(1+x(65))/(0.1d0 + dscp2)
6858 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6859 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6860 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6861 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6863 c & dscp1,dscp2,sumene
6864 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6865 escloc = escloc + sumene
6866 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6871 C This section to check the numerical derivatives of the energy of ith side
6872 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6873 C #define DEBUG in the code to turn it on.
6875 write (2,*) "sumene =",sumene
6879 write (2,*) xx,yy,zz
6880 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6881 de_dxx_num=(sumenep-sumene)/aincr
6883 write (2,*) "xx+ sumene from enesc=",sumenep
6886 write (2,*) xx,yy,zz
6887 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6888 de_dyy_num=(sumenep-sumene)/aincr
6890 write (2,*) "yy+ sumene from enesc=",sumenep
6893 write (2,*) xx,yy,zz
6894 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6895 de_dzz_num=(sumenep-sumene)/aincr
6897 write (2,*) "zz+ sumene from enesc=",sumenep
6898 costsave=cost2tab(i+1)
6899 sintsave=sint2tab(i+1)
6900 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6901 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6902 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6903 de_dt_num=(sumenep-sumene)/aincr
6904 write (2,*) " t+ sumene from enesc=",sumenep
6905 cost2tab(i+1)=costsave
6906 sint2tab(i+1)=sintsave
6907 C End of diagnostics section.
6910 C Compute the gradient of esc
6912 c zz=zz*dsign(1.0,dfloat(itype(i)))
6913 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6914 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6915 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6916 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6917 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6918 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6919 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6920 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6921 pom1=(sumene3*sint2tab(i+1)+sumene1)
6922 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6923 pom2=(sumene4*cost2tab(i+1)+sumene2)
6924 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6925 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6926 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6927 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6929 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6930 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6931 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6933 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6934 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6935 & +(pom1+pom2)*pom_dx
6937 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6940 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6941 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6942 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6944 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6945 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6946 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6947 & +x(59)*zz**2 +x(60)*xx*zz
6948 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6949 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6950 & +(pom1-pom2)*pom_dy
6952 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6955 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6956 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6957 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6958 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6959 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6960 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6961 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6962 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6964 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6967 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6968 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6969 & +pom1*pom_dt1+pom2*pom_dt2
6971 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6976 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6977 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6978 cosfac2xx=cosfac2*xx
6979 sinfac2yy=sinfac2*yy
6981 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6983 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6985 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6986 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6987 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6988 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6989 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6990 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6991 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6992 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6993 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6994 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6998 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6999 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
7000 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
7001 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
7004 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
7005 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
7006 dZZ_XYZ(k)=vbld_inv(i+nres)*
7007 & (z_prime(k)-zz*dC_norm(k,i+nres))
7009 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
7010 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
7014 dXX_Ctab(k,i)=dXX_Ci(k)
7015 dXX_C1tab(k,i)=dXX_Ci1(k)
7016 dYY_Ctab(k,i)=dYY_Ci(k)
7017 dYY_C1tab(k,i)=dYY_Ci1(k)
7018 dZZ_Ctab(k,i)=dZZ_Ci(k)
7019 dZZ_C1tab(k,i)=dZZ_Ci1(k)
7020 dXX_XYZtab(k,i)=dXX_XYZ(k)
7021 dYY_XYZtab(k,i)=dYY_XYZ(k)
7022 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
7026 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
7027 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
7028 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
7029 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
7030 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
7032 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
7033 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
7034 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
7035 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
7036 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
7037 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
7038 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
7039 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
7041 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
7042 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
7044 C to check gradient call subroutine check_grad
7050 c------------------------------------------------------------------------------
7051 double precision function enesc(x,xx,yy,zz,cost2,sint2)
7053 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
7054 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
7055 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7056 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7058 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7059 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7061 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7062 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7063 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7064 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7065 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7067 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7068 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7069 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7070 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7071 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7073 dsc_i = 0.743d0+x(61)
7075 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7076 & *(xx*cost2+yy*sint2))
7077 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7078 & *(xx*cost2-yy*sint2))
7079 s1=(1+x(63))/(0.1d0 + dscp1)
7080 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7081 s2=(1+x(65))/(0.1d0 + dscp2)
7082 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7083 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
7084 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
7089 c------------------------------------------------------------------------------
7090 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
7092 C This procedure calculates two-body contact function g(rij) and its derivative:
7095 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
7098 C where x=(rij-r0ij)/delta
7100 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
7103 double precision rij,r0ij,eps0ij,fcont,fprimcont
7104 double precision x,x2,x4,delta
7108 if (x.lt.-1.0D0) then
7111 else if (x.le.1.0D0) then
7114 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
7115 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7122 c------------------------------------------------------------------------------
7123 subroutine splinthet(theti,delta,ss,ssder)
7124 implicit real*8 (a-h,o-z)
7125 include 'DIMENSIONS'
7126 include 'COMMON.VAR'
7127 include 'COMMON.GEO'
7130 if (theti.gt.pipol) then
7131 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7133 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7138 c------------------------------------------------------------------------------
7139 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7141 double precision x,x0,delta,f0,f1,fprim0,f,fprim
7142 double precision ksi,ksi2,ksi3,a1,a2,a3
7143 a1=fprim0*delta/(f1-f0)
7149 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7150 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7153 c------------------------------------------------------------------------------
7154 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7156 double precision x,x0,delta,f0x,f1x,fprim0x,fx
7157 double precision ksi,ksi2,ksi3,a1,a2,a3
7162 a2=3*(f1x-f0x)-2*fprim0x*delta
7163 a3=fprim0x*delta-2*(f1x-f0x)
7164 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7167 C-----------------------------------------------------------------------------
7169 C-----------------------------------------------------------------------------
7170 subroutine etor(etors,edihcnstr)
7171 implicit real*8 (a-h,o-z)
7172 include 'DIMENSIONS'
7173 include 'COMMON.VAR'
7174 include 'COMMON.GEO'
7175 include 'COMMON.LOCAL'
7176 include 'COMMON.TORSION'
7177 include 'COMMON.INTERACT'
7178 include 'COMMON.DERIV'
7179 include 'COMMON.CHAIN'
7180 include 'COMMON.NAMES'
7181 include 'COMMON.IOUNITS'
7182 include 'COMMON.FFIELD'
7183 include 'COMMON.TORCNSTR'
7184 include 'COMMON.CONTROL'
7186 C Set lprn=.true. for debugging
7190 do i=iphi_start,iphi_end
7192 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7193 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7194 itori=itortyp(itype(i-2))
7195 itori1=itortyp(itype(i-1))
7198 C Proline-Proline pair is a special case...
7199 if (itori.eq.3 .and. itori1.eq.3) then
7200 if (phii.gt.-dwapi3) then
7202 fac=1.0D0/(1.0D0-cosphi)
7203 etorsi=v1(1,3,3)*fac
7204 etorsi=etorsi+etorsi
7205 etors=etors+etorsi-v1(1,3,3)
7206 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
7207 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7210 v1ij=v1(j+1,itori,itori1)
7211 v2ij=v2(j+1,itori,itori1)
7214 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7215 if (energy_dec) etors_ii=etors_ii+
7216 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7217 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7221 v1ij=v1(j,itori,itori1)
7222 v2ij=v2(j,itori,itori1)
7225 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7226 if (energy_dec) etors_ii=etors_ii+
7227 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7228 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7231 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7234 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7235 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7236 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7237 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7238 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7240 ! 6/20/98 - dihedral angle constraints
7243 itori=idih_constr(i)
7246 if (difi.gt.drange(i)) then
7248 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7249 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7250 else if (difi.lt.-drange(i)) then
7252 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
7253 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7255 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
7256 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7258 ! write (iout,*) 'edihcnstr',edihcnstr
7261 c------------------------------------------------------------------------------
7262 subroutine etor_d(etors_d)
7266 c----------------------------------------------------------------------------
7268 subroutine etor(etors,edihcnstr)
7269 implicit real*8 (a-h,o-z)
7270 include 'DIMENSIONS'
7271 include 'COMMON.VAR'
7272 include 'COMMON.GEO'
7273 include 'COMMON.LOCAL'
7274 include 'COMMON.TORSION'
7275 include 'COMMON.INTERACT'
7276 include 'COMMON.DERIV'
7277 include 'COMMON.CHAIN'
7278 include 'COMMON.NAMES'
7279 include 'COMMON.IOUNITS'
7280 include 'COMMON.FFIELD'
7281 include 'COMMON.TORCNSTR'
7282 include 'COMMON.CONTROL'
7284 C Set lprn=.true. for debugging
7288 do i=iphi_start,iphi_end
7289 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7290 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7291 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7292 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7293 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7294 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7295 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7296 C For introducing the NH3+ and COO- group please check the etor_d for reference
7299 if (iabs(itype(i)).eq.20) then
7304 itori=itortyp(itype(i-2))
7305 itori1=itortyp(itype(i-1))
7308 C Regular cosine and sine terms
7309 do j=1,nterm(itori,itori1,iblock)
7310 v1ij=v1(j,itori,itori1,iblock)
7311 v2ij=v2(j,itori,itori1,iblock)
7314 etors=etors+v1ij*cosphi+v2ij*sinphi
7315 if (energy_dec) etors_ii=etors_ii+
7316 & v1ij*cosphi+v2ij*sinphi
7317 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7321 C E = SUM ----------------------------------- - v1
7322 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7324 cosphi=dcos(0.5d0*phii)
7325 sinphi=dsin(0.5d0*phii)
7326 do j=1,nlor(itori,itori1,iblock)
7327 vl1ij=vlor1(j,itori,itori1)
7328 vl2ij=vlor2(j,itori,itori1)
7329 vl3ij=vlor3(j,itori,itori1)
7330 pom=vl2ij*cosphi+vl3ij*sinphi
7331 pom1=1.0d0/(pom*pom+1.0d0)
7332 etors=etors+vl1ij*pom1
7333 if (energy_dec) etors_ii=etors_ii+
7336 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7338 C Subtract the constant term
7339 etors=etors-v0(itori,itori1,iblock)
7340 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7341 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
7343 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7344 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7345 & (v1(j,itori,itori1,iblock),j=1,6),
7346 & (v2(j,itori,itori1,iblock),j=1,6)
7347 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7348 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7350 ! 6/20/98 - dihedral angle constraints
7352 c do i=1,ndih_constr
7353 do i=idihconstr_start,idihconstr_end
7354 itori=idih_constr(i)
7356 difi=pinorm(phii-phi0(i))
7357 if (difi.gt.drange(i)) then
7359 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7360 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7361 else if (difi.lt.-drange(i)) then
7363 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7364 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7368 if (energy_dec) then
7369 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
7370 & i,itori,rad2deg*phii,
7371 & rad2deg*phi0(i), rad2deg*drange(i),
7372 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
7375 cd write (iout,*) 'edihcnstr',edihcnstr
7378 c----------------------------------------------------------------------------
7379 subroutine etor_d(etors_d)
7380 C 6/23/01 Compute double torsional energy
7381 implicit real*8 (a-h,o-z)
7382 include 'DIMENSIONS'
7383 include 'COMMON.VAR'
7384 include 'COMMON.GEO'
7385 include 'COMMON.LOCAL'
7386 include 'COMMON.TORSION'
7387 include 'COMMON.INTERACT'
7388 include 'COMMON.DERIV'
7389 include 'COMMON.CHAIN'
7390 include 'COMMON.NAMES'
7391 include 'COMMON.IOUNITS'
7392 include 'COMMON.FFIELD'
7393 include 'COMMON.TORCNSTR'
7395 C Set lprn=.true. for debugging
7399 c write(iout,*) "a tu??"
7400 do i=iphid_start,iphid_end
7401 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7402 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7403 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7404 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7405 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7406 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7407 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7408 & (itype(i+1).eq.ntyp1)) cycle
7409 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7410 itori=itortyp(itype(i-2))
7411 itori1=itortyp(itype(i-1))
7412 itori2=itortyp(itype(i))
7418 if (iabs(itype(i+1)).eq.20) iblock=2
7419 C Iblock=2 Proline type
7420 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7421 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7422 C if (itype(i+1).eq.ntyp1) iblock=3
7423 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7424 C IS or IS NOT need for this
7425 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7426 C is (itype(i-3).eq.ntyp1) ntblock=2
7427 C ntblock is N-terminal blocking group
7429 C Regular cosine and sine terms
7430 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7431 C Example of changes for NH3+ blocking group
7432 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7433 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7434 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7435 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7436 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7437 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7438 cosphi1=dcos(j*phii)
7439 sinphi1=dsin(j*phii)
7440 cosphi2=dcos(j*phii1)
7441 sinphi2=dsin(j*phii1)
7442 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7443 & v2cij*cosphi2+v2sij*sinphi2
7444 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7445 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7447 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7449 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7450 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7451 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7452 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7453 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7454 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7455 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7456 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7457 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7458 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7459 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7460 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7461 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7462 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7465 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7466 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7471 C----------------------------------------------------------------------------------
7472 C The rigorous attempt to derive energy function
7473 subroutine etor_kcc(etors,edihcnstr)
7474 implicit real*8 (a-h,o-z)
7475 include 'DIMENSIONS'
7476 include 'COMMON.VAR'
7477 include 'COMMON.GEO'
7478 include 'COMMON.LOCAL'
7479 include 'COMMON.TORSION'
7480 include 'COMMON.INTERACT'
7481 include 'COMMON.DERIV'
7482 include 'COMMON.CHAIN'
7483 include 'COMMON.NAMES'
7484 include 'COMMON.IOUNITS'
7485 include 'COMMON.FFIELD'
7486 include 'COMMON.TORCNSTR'
7487 include 'COMMON.CONTROL'
7489 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
7490 C Set lprn=.true. for debugging
7493 C print *,"wchodze kcc"
7494 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
7495 if (tor_mode.ne.2) then
7498 do i=iphi_start,iphi_end
7499 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7500 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7501 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7502 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7503 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7504 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7505 itori=itortyp_kcc(itype(i-2))
7506 itori1=itortyp_kcc(itype(i-1))
7511 sumnonchebyshev=0.0d0
7513 C to avoid multiple devision by 2
7514 c theti22=0.5d0*theta(i)
7515 C theta 12 is the theta_1 /2
7516 C theta 22 is theta_2 /2
7517 c theti12=0.5d0*theta(i-1)
7518 C and appropriate sinus function
7519 sinthet1=dsin(theta(i-1))
7520 sinthet2=dsin(theta(i))
7521 costhet1=dcos(theta(i-1))
7522 costhet2=dcos(theta(i))
7523 c Cosines of halves thetas
7524 costheti12=0.5d0*(1.0d0+costhet1)
7525 costheti22=0.5d0*(1.0d0+costhet2)
7526 C to speed up lets store its mutliplication
7527 sint1t2=sinthet2*sinthet1
7529 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
7530 C +d_n*sin(n*gamma)) *
7531 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
7532 C we have two sum 1) Non-Chebyshev which is with n and gamma
7534 do j=1,nterm_kcc(itori,itori1)
7536 nval=nterm_kcc_Tb(itori,itori1)
7537 v1ij=v1_kcc(j,itori,itori1)
7538 v2ij=v2_kcc(j,itori,itori1)
7539 c write (iout,*) "i",i," j",j," v1",v1ij," v2",v2ij
7540 C v1ij is c_n and d_n in euation above
7544 sint1t2n=sint1t2n*sint1t2
7545 sumth1tyb1=tschebyshev(1,nval,v11_chyb(1,j,itori,itori1),
7547 gradth1tyb1=-0.5d0*sinthet1*gradtschebyshev(0,nval-1,
7548 & v11_chyb(1,j,itori,itori1),costheti12)
7549 c write (iout,*) "v11",(v11_chyb(k,j,itori,itori1),k=1,nval),
7550 c & " sumth1tyb1",sumth1tyb1," gradth1tyb1",gradth1tyb1
7551 sumth2tyb1=tschebyshev(1,nval,v21_chyb(1,j,itori,itori1),
7553 gradth2tyb1=-0.5d0*sinthet2*gradtschebyshev(0,nval-1,
7554 & v21_chyb(1,j,itori,itori1),costheti22)
7555 c write (iout,*) "v21",(v21_chyb(k,j,itori,itori1),k=1,nval),
7556 c & " sumth2tyb1",sumth2tyb1," gradth2tyb1",gradth2tyb1
7557 sumth1tyb2=tschebyshev(1,nval,v12_chyb(1,j,itori,itori1),
7559 gradth1tyb2=-0.5d0*sinthet1*gradtschebyshev(0,nval-1,
7560 & v12_chyb(1,j,itori,itori1),costheti12)
7561 c write (iout,*) "v12",(v12_chyb(k,j,itori,itori1),k=1,nval),
7562 c & " sumth1tyb2",sumth1tyb2," gradth1tyb2",gradth1tyb2
7563 sumth2tyb2=tschebyshev(1,nval,v22_chyb(1,j,itori,itori1),
7565 gradth2tyb2=-0.5d0*sinthet2*gradtschebyshev(0,nval-1,
7566 & v22_chyb(1,j,itori,itori1),costheti22)
7567 c write (iout,*) "v22",(v22_chyb(k,j,itori,itori1),k=1,nval),
7568 c & " sumth2tyb2",sumth2tyb2," gradth2tyb2",gradth2tyb2
7569 C etors=etors+sint1t2n*(v1ij*cosphi+v2ij*sinphi)
7570 C if (energy_dec) etors_ii=etors_ii+
7571 C & v1ij*cosphi+v2ij*sinphi
7572 C glocig is the gradient local i site in gamma
7573 actval1=v1ij*cosphi*(1.0d0+sumth1tyb1+sumth2tyb1)
7574 actval2=v2ij*sinphi*(1.0d0+sumth1tyb2+sumth2tyb2)
7575 etori=etori+sint1t2n*(actval1+actval2)
7577 & j*sint1t2n*(v2ij*cosphi*(1.0d0+sumth1tyb2+sumth2tyb2)
7578 & -v1ij*sinphi*(1.0d0+sumth1tyb1+sumth2tyb1))
7579 C now gradient over theta_1
7581 & j*sint1t2n1*costhet1*sinthet2*(actval1+actval2)+
7582 & sint1t2n*(v1ij*cosphi*gradth1tyb1+v2ij*sinphi*gradth1tyb2)
7584 & j*sint1t2n1*sinthet1*costhet2*(actval1+actval2)+
7585 & sint1t2n*(v1ij*cosphi*gradth2tyb1+v2ij*sinphi*gradth2tyb2)
7587 C now the Czebyshev polinominal sum
7588 c do k=1,nterm_kcc_Tb(itori,itori1)
7589 c thybt1(k)=v1_chyb(k,j,itori,itori1)
7590 c thybt2(k)=v2_chyb(k,j,itori,itori1)
7594 C print *, sumth1thyb, gradthybt1, sumth2thyb, gradthybt2,
7596 C & (0,nterm_kcc_Tb(itori,itori1)-1,thybt2(1),
7597 C & dcos(theti22)**2),
7600 C now overal sumation
7601 C print *,"sumnon", sumnonchebyshev,sumth1thyb+sumth2thyb
7604 C derivative over gamma
7605 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
7606 C derivative over theta1
7607 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
7608 C now derivative over theta2
7609 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
7611 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
7612 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
7614 C gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7615 ! 6/20/98 - dihedral angle constraints
7616 if (tor_mode.ne.2) then
7618 c do i=1,ndih_constr
7619 do i=idihconstr_start,idihconstr_end
7620 itori=idih_constr(i)
7622 difi=pinorm(phii-phi0(i))
7623 if (difi.gt.drange(i)) then
7625 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7626 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7627 else if (difi.lt.-drange(i)) then
7629 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7630 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7639 C The rigorous attempt to derive energy function
7640 subroutine ebend_kcc(etheta,ethetacnstr)
7642 implicit real*8 (a-h,o-z)
7643 include 'DIMENSIONS'
7644 include 'COMMON.VAR'
7645 include 'COMMON.GEO'
7646 include 'COMMON.LOCAL'
7647 include 'COMMON.TORSION'
7648 include 'COMMON.INTERACT'
7649 include 'COMMON.DERIV'
7650 include 'COMMON.CHAIN'
7651 include 'COMMON.NAMES'
7652 include 'COMMON.IOUNITS'
7653 include 'COMMON.FFIELD'
7654 include 'COMMON.TORCNSTR'
7655 include 'COMMON.CONTROL'
7657 double precision thybt1(maxtermkcc)
7658 C Set lprn=.true. for debugging
7661 C print *,"wchodze kcc"
7662 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
7663 if (tor_mode.ne.2) etheta=0.0D0
7664 do i=ithet_start,ithet_end
7665 c print *,i,itype(i-1),itype(i),itype(i-2)
7666 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
7667 & .or.itype(i).eq.ntyp1) cycle
7668 iti=itortyp_kcc(itype(i-1))
7669 sinthet=dsin(theta(i)/2.0d0)
7670 costhet=dcos(theta(i)/2.0d0)
7671 do j=1,nbend_kcc_Tb(iti)
7672 thybt1(j)=v1bend_chyb(j,iti)
7674 sumth1thyb=tschebyshev
7675 & (1,nbend_kcc_Tb(iti),thybt1(1),costhet)
7676 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
7678 ihelp=nbend_kcc_Tb(iti)-1
7679 gradthybt1=gradtschebyshev
7680 & (0,ihelp,thybt1(1),costhet)
7681 etheta=etheta+sumth1thyb
7682 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
7683 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*
7684 & gradthybt1*sinthet*(-0.5d0)
7686 if (tor_mode.ne.2) then
7688 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
7689 do i=ithetaconstr_start,ithetaconstr_end
7690 itheta=itheta_constr(i)
7691 thetiii=theta(itheta)
7692 difi=pinorm(thetiii-theta_constr0(i))
7693 if (difi.gt.theta_drange(i)) then
7694 difi=difi-theta_drange(i)
7695 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7696 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7697 & +for_thet_constr(i)*difi**3
7698 else if (difi.lt.-drange(i)) then
7700 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7701 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7702 & +for_thet_constr(i)*difi**3
7706 if (energy_dec) then
7707 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
7708 & i,itheta,rad2deg*thetiii,
7709 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
7710 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
7711 & gloc(itheta+nphi-2,icg)
7717 c------------------------------------------------------------------------------
7718 subroutine eback_sc_corr(esccor)
7719 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7720 c conformational states; temporarily implemented as differences
7721 c between UNRES torsional potentials (dependent on three types of
7722 c residues) and the torsional potentials dependent on all 20 types
7723 c of residues computed from AM1 energy surfaces of terminally-blocked
7724 c amino-acid residues.
7725 implicit real*8 (a-h,o-z)
7726 include 'DIMENSIONS'
7727 include 'COMMON.VAR'
7728 include 'COMMON.GEO'
7729 include 'COMMON.LOCAL'
7730 include 'COMMON.TORSION'
7731 include 'COMMON.SCCOR'
7732 include 'COMMON.INTERACT'
7733 include 'COMMON.DERIV'
7734 include 'COMMON.CHAIN'
7735 include 'COMMON.NAMES'
7736 include 'COMMON.IOUNITS'
7737 include 'COMMON.FFIELD'
7738 include 'COMMON.CONTROL'
7740 C Set lprn=.true. for debugging
7743 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7745 do i=itau_start,itau_end
7746 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7748 isccori=isccortyp(itype(i-2))
7749 isccori1=isccortyp(itype(i-1))
7750 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7752 do intertyp=1,3 !intertyp
7753 cc Added 09 May 2012 (Adasko)
7754 cc Intertyp means interaction type of backbone mainchain correlation:
7755 c 1 = SC...Ca...Ca...Ca
7756 c 2 = Ca...Ca...Ca...SC
7757 c 3 = SC...Ca...Ca...SCi
7759 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7760 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7761 & (itype(i-1).eq.ntyp1)))
7762 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7763 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7764 & .or.(itype(i).eq.ntyp1)))
7765 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7766 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7767 & (itype(i-3).eq.ntyp1)))) cycle
7768 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7769 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7771 do j=1,nterm_sccor(isccori,isccori1)
7772 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7773 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7774 cosphi=dcos(j*tauangle(intertyp,i))
7775 sinphi=dsin(j*tauangle(intertyp,i))
7776 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7777 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7779 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7780 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7782 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7783 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
7784 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
7785 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7786 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7792 c----------------------------------------------------------------------------
7793 subroutine multibody(ecorr)
7794 C This subroutine calculates multi-body contributions to energy following
7795 C the idea of Skolnick et al. If side chains I and J make a contact and
7796 C at the same time side chains I+1 and J+1 make a contact, an extra
7797 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7798 implicit real*8 (a-h,o-z)
7799 include 'DIMENSIONS'
7800 include 'COMMON.IOUNITS'
7801 include 'COMMON.DERIV'
7802 include 'COMMON.INTERACT'
7803 include 'COMMON.CONTACTS'
7804 double precision gx(3),gx1(3)
7807 C Set lprn=.true. for debugging
7811 write (iout,'(a)') 'Contact function values:'
7813 write (iout,'(i2,20(1x,i2,f10.5))')
7814 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7829 num_conti=num_cont(i)
7830 num_conti1=num_cont(i1)
7835 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7836 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7837 cd & ' ishift=',ishift
7838 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7839 C The system gains extra energy.
7840 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7841 endif ! j1==j+-ishift
7850 c------------------------------------------------------------------------------
7851 double precision function esccorr(i,j,k,l,jj,kk)
7852 implicit real*8 (a-h,o-z)
7853 include 'DIMENSIONS'
7854 include 'COMMON.IOUNITS'
7855 include 'COMMON.DERIV'
7856 include 'COMMON.INTERACT'
7857 include 'COMMON.CONTACTS'
7858 include 'COMMON.SHIELD'
7859 double precision gx(3),gx1(3)
7864 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7865 C Calculate the multi-body contribution to energy.
7866 C Calculate multi-body contributions to the gradient.
7867 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7868 cd & k,l,(gacont(m,kk,k),m=1,3)
7870 gx(m) =ekl*gacont(m,jj,i)
7871 gx1(m)=eij*gacont(m,kk,k)
7872 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7873 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7874 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7875 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7879 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7884 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7890 c------------------------------------------------------------------------------
7891 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7892 C This subroutine calculates multi-body contributions to hydrogen-bonding
7893 implicit real*8 (a-h,o-z)
7894 include 'DIMENSIONS'
7895 include 'COMMON.IOUNITS'
7898 parameter (max_cont=maxconts)
7899 parameter (max_dim=26)
7900 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7901 double precision zapas(max_dim,maxconts,max_fg_procs),
7902 & zapas_recv(max_dim,maxconts,max_fg_procs)
7903 common /przechowalnia/ zapas
7904 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7905 & status_array(MPI_STATUS_SIZE,maxconts*2)
7907 include 'COMMON.SETUP'
7908 include 'COMMON.FFIELD'
7909 include 'COMMON.DERIV'
7910 include 'COMMON.INTERACT'
7911 include 'COMMON.CONTACTS'
7912 include 'COMMON.CONTROL'
7913 include 'COMMON.LOCAL'
7914 double precision gx(3),gx1(3),time00
7917 C Set lprn=.true. for debugging
7922 if (nfgtasks.le.1) goto 30
7924 write (iout,'(a)') 'Contact function values before RECEIVE:'
7926 write (iout,'(2i3,50(1x,i2,f5.2))')
7927 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7928 & j=1,num_cont_hb(i))
7932 do i=1,ntask_cont_from
7935 do i=1,ntask_cont_to
7938 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7940 C Make the list of contacts to send to send to other procesors
7941 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7943 do i=iturn3_start,iturn3_end
7944 c write (iout,*) "make contact list turn3",i," num_cont",
7946 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7948 do i=iturn4_start,iturn4_end
7949 c write (iout,*) "make contact list turn4",i," num_cont",
7951 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7955 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7957 do j=1,num_cont_hb(i)
7960 iproc=iint_sent_local(k,jjc,ii)
7961 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7962 if (iproc.gt.0) then
7963 ncont_sent(iproc)=ncont_sent(iproc)+1
7964 nn=ncont_sent(iproc)
7966 zapas(2,nn,iproc)=jjc
7967 zapas(3,nn,iproc)=facont_hb(j,i)
7968 zapas(4,nn,iproc)=ees0p(j,i)
7969 zapas(5,nn,iproc)=ees0m(j,i)
7970 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7971 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7972 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7973 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7974 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7975 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7976 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7977 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7978 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7979 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7980 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7981 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7982 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7983 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7984 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7985 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7986 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7987 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7988 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7989 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7990 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7997 & "Numbers of contacts to be sent to other processors",
7998 & (ncont_sent(i),i=1,ntask_cont_to)
7999 write (iout,*) "Contacts sent"
8000 do ii=1,ntask_cont_to
8002 iproc=itask_cont_to(ii)
8003 write (iout,*) nn," contacts to processor",iproc,
8004 & " of CONT_TO_COMM group"
8006 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8014 CorrelID1=nfgtasks+fg_rank+1
8016 C Receive the numbers of needed contacts from other processors
8017 do ii=1,ntask_cont_from
8018 iproc=itask_cont_from(ii)
8020 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8021 & FG_COMM,req(ireq),IERR)
8023 c write (iout,*) "IRECV ended"
8025 C Send the number of contacts needed by other processors
8026 do ii=1,ntask_cont_to
8027 iproc=itask_cont_to(ii)
8029 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8030 & FG_COMM,req(ireq),IERR)
8032 c write (iout,*) "ISEND ended"
8033 c write (iout,*) "number of requests (nn)",ireq
8036 & call MPI_Waitall(ireq,req,status_array,ierr)
8038 c & "Numbers of contacts to be received from other processors",
8039 c & (ncont_recv(i),i=1,ntask_cont_from)
8043 do ii=1,ntask_cont_from
8044 iproc=itask_cont_from(ii)
8046 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8047 c & " of CONT_TO_COMM group"
8051 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8052 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8053 c write (iout,*) "ireq,req",ireq,req(ireq)
8056 C Send the contacts to processors that need them
8057 do ii=1,ntask_cont_to
8058 iproc=itask_cont_to(ii)
8060 c write (iout,*) nn," contacts to processor",iproc,
8061 c & " of CONT_TO_COMM group"
8064 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8065 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8066 c write (iout,*) "ireq,req",ireq,req(ireq)
8068 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8072 c write (iout,*) "number of requests (contacts)",ireq
8073 c write (iout,*) "req",(req(i),i=1,4)
8076 & call MPI_Waitall(ireq,req,status_array,ierr)
8077 do iii=1,ntask_cont_from
8078 iproc=itask_cont_from(iii)
8081 write (iout,*) "Received",nn," contacts from processor",iproc,
8082 & " of CONT_FROM_COMM group"
8085 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8090 ii=zapas_recv(1,i,iii)
8091 c Flag the received contacts to prevent double-counting
8092 jj=-zapas_recv(2,i,iii)
8093 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8095 nnn=num_cont_hb(ii)+1
8098 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8099 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8100 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8101 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8102 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8103 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8104 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8105 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8106 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8107 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8108 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8109 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8110 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8111 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8112 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8113 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8114 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8115 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8116 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8117 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8118 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8119 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8120 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8121 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8126 write (iout,'(a)') 'Contact function values after receive:'
8128 write (iout,'(2i3,50(1x,i3,f5.2))')
8129 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8130 & j=1,num_cont_hb(i))
8137 write (iout,'(a)') 'Contact function values:'
8139 write (iout,'(2i3,50(1x,i3,f5.2))')
8140 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8141 & j=1,num_cont_hb(i))
8145 C Remove the loop below after debugging !!!
8152 C Calculate the local-electrostatic correlation terms
8153 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8155 num_conti=num_cont_hb(i)
8156 num_conti1=num_cont_hb(i+1)
8163 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8164 c & ' jj=',jj,' kk=',kk
8165 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8166 & .or. j.lt.0 .and. j1.gt.0) .and.
8167 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8168 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8169 C The system gains extra energy.
8170 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8171 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
8172 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
8174 else if (j1.eq.j) then
8175 C Contacts I-J and I-(J+1) occur simultaneously.
8176 C The system loses extra energy.
8177 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8182 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8183 c & ' jj=',jj,' kk=',kk
8185 C Contacts I-J and (I+1)-J occur simultaneously.
8186 C The system loses extra energy.
8187 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8194 c------------------------------------------------------------------------------
8195 subroutine add_hb_contact(ii,jj,itask)
8196 implicit real*8 (a-h,o-z)
8197 include "DIMENSIONS"
8198 include "COMMON.IOUNITS"
8201 parameter (max_cont=maxconts)
8202 parameter (max_dim=26)
8203 include "COMMON.CONTACTS"
8204 double precision zapas(max_dim,maxconts,max_fg_procs),
8205 & zapas_recv(max_dim,maxconts,max_fg_procs)
8206 common /przechowalnia/ zapas
8207 integer i,j,ii,jj,iproc,itask(4),nn
8208 c write (iout,*) "itask",itask
8211 if (iproc.gt.0) then
8212 do j=1,num_cont_hb(ii)
8214 c write (iout,*) "i",ii," j",jj," jjc",jjc
8216 ncont_sent(iproc)=ncont_sent(iproc)+1
8217 nn=ncont_sent(iproc)
8218 zapas(1,nn,iproc)=ii
8219 zapas(2,nn,iproc)=jjc
8220 zapas(3,nn,iproc)=facont_hb(j,ii)
8221 zapas(4,nn,iproc)=ees0p(j,ii)
8222 zapas(5,nn,iproc)=ees0m(j,ii)
8223 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8224 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8225 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8226 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8227 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8228 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8229 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8230 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8231 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8232 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8233 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8234 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8235 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8236 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8237 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8238 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8239 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8240 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8241 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8242 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8243 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8251 c------------------------------------------------------------------------------
8252 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8254 C This subroutine calculates multi-body contributions to hydrogen-bonding
8255 implicit real*8 (a-h,o-z)
8256 include 'DIMENSIONS'
8257 include 'COMMON.IOUNITS'
8260 parameter (max_cont=maxconts)
8261 parameter (max_dim=70)
8262 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8263 double precision zapas(max_dim,maxconts,max_fg_procs),
8264 & zapas_recv(max_dim,maxconts,max_fg_procs)
8265 common /przechowalnia/ zapas
8266 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8267 & status_array(MPI_STATUS_SIZE,maxconts*2)
8269 include 'COMMON.SETUP'
8270 include 'COMMON.FFIELD'
8271 include 'COMMON.DERIV'
8272 include 'COMMON.LOCAL'
8273 include 'COMMON.INTERACT'
8274 include 'COMMON.CONTACTS'
8275 include 'COMMON.CHAIN'
8276 include 'COMMON.CONTROL'
8277 include 'COMMON.SHIELD'
8278 double precision gx(3),gx1(3)
8279 integer num_cont_hb_old(maxres)
8281 double precision eello4,eello5,eelo6,eello_turn6
8282 external eello4,eello5,eello6,eello_turn6
8283 C Set lprn=.true. for debugging
8288 num_cont_hb_old(i)=num_cont_hb(i)
8292 if (nfgtasks.le.1) goto 30
8294 write (iout,'(a)') 'Contact function values before RECEIVE:'
8296 write (iout,'(2i3,50(1x,i2,f5.2))')
8297 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8298 & j=1,num_cont_hb(i))
8302 do i=1,ntask_cont_from
8305 do i=1,ntask_cont_to
8308 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8310 C Make the list of contacts to send to send to other procesors
8311 do i=iturn3_start,iturn3_end
8312 c write (iout,*) "make contact list turn3",i," num_cont",
8314 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8316 do i=iturn4_start,iturn4_end
8317 c write (iout,*) "make contact list turn4",i," num_cont",
8319 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8323 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8325 do j=1,num_cont_hb(i)
8328 iproc=iint_sent_local(k,jjc,ii)
8329 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8330 if (iproc.ne.0) then
8331 ncont_sent(iproc)=ncont_sent(iproc)+1
8332 nn=ncont_sent(iproc)
8334 zapas(2,nn,iproc)=jjc
8335 zapas(3,nn,iproc)=d_cont(j,i)
8339 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8344 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8352 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8363 & "Numbers of contacts to be sent to other processors",
8364 & (ncont_sent(i),i=1,ntask_cont_to)
8365 write (iout,*) "Contacts sent"
8366 do ii=1,ntask_cont_to
8368 iproc=itask_cont_to(ii)
8369 write (iout,*) nn," contacts to processor",iproc,
8370 & " of CONT_TO_COMM group"
8372 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8380 CorrelID1=nfgtasks+fg_rank+1
8382 C Receive the numbers of needed contacts from other processors
8383 do ii=1,ntask_cont_from
8384 iproc=itask_cont_from(ii)
8386 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8387 & FG_COMM,req(ireq),IERR)
8389 c write (iout,*) "IRECV ended"
8391 C Send the number of contacts needed by other processors
8392 do ii=1,ntask_cont_to
8393 iproc=itask_cont_to(ii)
8395 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8396 & FG_COMM,req(ireq),IERR)
8398 c write (iout,*) "ISEND ended"
8399 c write (iout,*) "number of requests (nn)",ireq
8402 & call MPI_Waitall(ireq,req,status_array,ierr)
8404 c & "Numbers of contacts to be received from other processors",
8405 c & (ncont_recv(i),i=1,ntask_cont_from)
8409 do ii=1,ntask_cont_from
8410 iproc=itask_cont_from(ii)
8412 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8413 c & " of CONT_TO_COMM group"
8417 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8418 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8419 c write (iout,*) "ireq,req",ireq,req(ireq)
8422 C Send the contacts to processors that need them
8423 do ii=1,ntask_cont_to
8424 iproc=itask_cont_to(ii)
8426 c write (iout,*) nn," contacts to processor",iproc,
8427 c & " of CONT_TO_COMM group"
8430 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8431 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8432 c write (iout,*) "ireq,req",ireq,req(ireq)
8434 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8438 c write (iout,*) "number of requests (contacts)",ireq
8439 c write (iout,*) "req",(req(i),i=1,4)
8442 & call MPI_Waitall(ireq,req,status_array,ierr)
8443 do iii=1,ntask_cont_from
8444 iproc=itask_cont_from(iii)
8447 write (iout,*) "Received",nn," contacts from processor",iproc,
8448 & " of CONT_FROM_COMM group"
8451 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8456 ii=zapas_recv(1,i,iii)
8457 c Flag the received contacts to prevent double-counting
8458 jj=-zapas_recv(2,i,iii)
8459 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8461 nnn=num_cont_hb(ii)+1
8464 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8468 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8473 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8481 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8490 write (iout,'(a)') 'Contact function values after receive:'
8492 write (iout,'(2i3,50(1x,i3,5f6.3))')
8493 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8494 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8501 write (iout,'(a)') 'Contact function values:'
8503 write (iout,'(2i3,50(1x,i2,5f6.3))')
8504 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8505 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8511 C Remove the loop below after debugging !!!
8518 C Calculate the dipole-dipole interaction energies
8519 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8520 do i=iatel_s,iatel_e+1
8521 num_conti=num_cont_hb(i)
8530 C Calculate the local-electrostatic correlation terms
8531 c write (iout,*) "gradcorr5 in eello5 before loop"
8533 c write (iout,'(i5,3f10.5)')
8534 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8536 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8537 c write (iout,*) "corr loop i",i
8539 num_conti=num_cont_hb(i)
8540 num_conti1=num_cont_hb(i+1)
8547 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8548 c & ' jj=',jj,' kk=',kk
8549 c if (j1.eq.j+1 .or. j1.eq.j-1) then
8550 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8551 & .or. j.lt.0 .and. j1.gt.0) .and.
8552 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8553 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8554 C The system gains extra energy.
8556 sqd1=dsqrt(d_cont(jj,i))
8557 sqd2=dsqrt(d_cont(kk,i1))
8558 sred_geom = sqd1*sqd2
8559 IF (sred_geom.lt.cutoff_corr) THEN
8560 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
8562 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8563 cd & ' jj=',jj,' kk=',kk
8564 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8565 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8567 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8568 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8571 cd write (iout,*) 'sred_geom=',sred_geom,
8572 cd & ' ekont=',ekont,' fprim=',fprimcont,
8573 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8574 cd write (iout,*) "g_contij",g_contij
8575 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8576 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8577 call calc_eello(i,jp,i+1,jp1,jj,kk)
8578 if (wcorr4.gt.0.0d0)
8579 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8580 CC & *fac_shield(i)**2*fac_shield(j)**2
8581 if (energy_dec.and.wcorr4.gt.0.0d0)
8582 1 write (iout,'(a6,4i5,0pf7.3)')
8583 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8584 c write (iout,*) "gradcorr5 before eello5"
8586 c write (iout,'(i5,3f10.5)')
8587 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8589 if (wcorr5.gt.0.0d0)
8590 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8591 c write (iout,*) "gradcorr5 after eello5"
8593 c write (iout,'(i5,3f10.5)')
8594 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8596 if (energy_dec.and.wcorr5.gt.0.0d0)
8597 1 write (iout,'(a6,4i5,0pf7.3)')
8598 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8599 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8600 cd write(2,*)'ijkl',i,jp,i+1,jp1
8601 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
8602 & .or. wturn6.eq.0.0d0))then
8603 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8604 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8605 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8606 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8607 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8608 cd & 'ecorr6=',ecorr6
8609 cd write (iout,'(4e15.5)') sred_geom,
8610 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8611 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8612 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8613 else if (wturn6.gt.0.0d0
8614 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8615 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8616 eturn6=eturn6+eello_turn6(i,jj,kk)
8617 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8618 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8619 cd write (2,*) 'multibody_eello:eturn6',eturn6
8628 num_cont_hb(i)=num_cont_hb_old(i)
8630 c write (iout,*) "gradcorr5 in eello5"
8632 c write (iout,'(i5,3f10.5)')
8633 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8637 c------------------------------------------------------------------------------
8638 subroutine add_hb_contact_eello(ii,jj,itask)
8639 implicit real*8 (a-h,o-z)
8640 include "DIMENSIONS"
8641 include "COMMON.IOUNITS"
8644 parameter (max_cont=maxconts)
8645 parameter (max_dim=70)
8646 include "COMMON.CONTACTS"
8647 double precision zapas(max_dim,maxconts,max_fg_procs),
8648 & zapas_recv(max_dim,maxconts,max_fg_procs)
8649 common /przechowalnia/ zapas
8650 integer i,j,ii,jj,iproc,itask(4),nn
8651 c write (iout,*) "itask",itask
8654 if (iproc.gt.0) then
8655 do j=1,num_cont_hb(ii)
8657 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8659 ncont_sent(iproc)=ncont_sent(iproc)+1
8660 nn=ncont_sent(iproc)
8661 zapas(1,nn,iproc)=ii
8662 zapas(2,nn,iproc)=jjc
8663 zapas(3,nn,iproc)=d_cont(j,ii)
8667 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8672 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8680 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8692 c------------------------------------------------------------------------------
8693 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8694 implicit real*8 (a-h,o-z)
8695 include 'DIMENSIONS'
8696 include 'COMMON.IOUNITS'
8697 include 'COMMON.DERIV'
8698 include 'COMMON.INTERACT'
8699 include 'COMMON.CONTACTS'
8700 include 'COMMON.SHIELD'
8701 include 'COMMON.CONTROL'
8702 double precision gx(3),gx1(3)
8705 C print *,"wchodze",fac_shield(i),shield_mode
8713 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8715 C & fac_shield(i)**2*fac_shield(j)**2
8716 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8717 C Following 4 lines for diagnostics.
8722 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8723 c & 'Contacts ',i,j,
8724 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8725 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8727 C Calculate the multi-body contribution to energy.
8728 C ecorr=ecorr+ekont*ees
8729 C Calculate multi-body contributions to the gradient.
8730 coeffpees0pij=coeffp*ees0pij
8731 coeffmees0mij=coeffm*ees0mij
8732 coeffpees0pkl=coeffp*ees0pkl
8733 coeffmees0mkl=coeffm*ees0mkl
8735 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8736 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8737 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8738 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8739 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8740 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8741 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8742 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8743 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8744 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8745 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8746 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8747 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8748 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8749 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8750 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8751 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8752 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8753 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8754 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8755 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8756 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8757 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8758 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8759 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8764 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8765 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8766 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8767 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8772 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8773 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8774 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8775 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8778 c write (iout,*) "ehbcorr",ekont*ees
8779 C print *,ekont,ees,i,k
8781 C now gradient over shielding
8783 if (shield_mode.gt.0) then
8786 C print *,i,j,fac_shield(i),fac_shield(j),
8787 C &fac_shield(k),fac_shield(l)
8788 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
8789 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8790 do ilist=1,ishield_list(i)
8791 iresshield=shield_list(ilist,i)
8793 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8795 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8797 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8798 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8802 do ilist=1,ishield_list(j)
8803 iresshield=shield_list(ilist,j)
8805 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8807 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8809 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8810 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8815 do ilist=1,ishield_list(k)
8816 iresshield=shield_list(ilist,k)
8818 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8820 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8822 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8823 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8827 do ilist=1,ishield_list(l)
8828 iresshield=shield_list(ilist,l)
8830 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8832 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8834 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8835 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8839 C print *,gshieldx(m,iresshield)
8841 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
8842 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8843 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
8844 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8845 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
8846 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8847 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
8848 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8850 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
8851 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8852 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
8853 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8854 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
8855 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8856 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
8857 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8865 C---------------------------------------------------------------------------
8866 subroutine dipole(i,j,jj)
8867 implicit real*8 (a-h,o-z)
8868 include 'DIMENSIONS'
8869 include 'COMMON.IOUNITS'
8870 include 'COMMON.CHAIN'
8871 include 'COMMON.FFIELD'
8872 include 'COMMON.DERIV'
8873 include 'COMMON.INTERACT'
8874 include 'COMMON.CONTACTS'
8875 include 'COMMON.TORSION'
8876 include 'COMMON.VAR'
8877 include 'COMMON.GEO'
8878 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8880 iti1 = itortyp(itype(i+1))
8881 if (j.lt.nres-1) then
8882 itj1 = itype2loc(itype(j+1))
8887 dipi(iii,1)=Ub2(iii,i)
8888 dipderi(iii)=Ub2der(iii,i)
8889 dipi(iii,2)=b1(iii,i+1)
8890 dipj(iii,1)=Ub2(iii,j)
8891 dipderj(iii)=Ub2der(iii,j)
8892 dipj(iii,2)=b1(iii,j+1)
8896 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8899 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8906 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8910 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8915 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8916 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8918 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8920 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8922 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8927 C---------------------------------------------------------------------------
8928 subroutine calc_eello(i,j,k,l,jj,kk)
8930 C This subroutine computes matrices and vectors needed to calculate
8931 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8933 implicit real*8 (a-h,o-z)
8934 include 'DIMENSIONS'
8935 include 'COMMON.IOUNITS'
8936 include 'COMMON.CHAIN'
8937 include 'COMMON.DERIV'
8938 include 'COMMON.INTERACT'
8939 include 'COMMON.CONTACTS'
8940 include 'COMMON.TORSION'
8941 include 'COMMON.VAR'
8942 include 'COMMON.GEO'
8943 include 'COMMON.FFIELD'
8944 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8945 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8948 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8949 cd & ' jj=',jj,' kk=',kk
8950 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8951 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8952 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8955 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8956 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8959 call transpose2(aa1(1,1),aa1t(1,1))
8960 call transpose2(aa2(1,1),aa2t(1,1))
8963 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8964 & aa1tder(1,1,lll,kkk))
8965 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8966 & aa2tder(1,1,lll,kkk))
8970 C parallel orientation of the two CA-CA-CA frames.
8972 iti=itype2loc(itype(i))
8976 itk1=itype2loc(itype(k+1))
8977 itj=itype2loc(itype(j))
8978 if (l.lt.nres-1) then
8979 itl1=itype2loc(itype(l+1))
8983 C A1 kernel(j+1) A2T
8985 cd write (iout,'(3f10.5,5x,3f10.5)')
8986 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8988 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8989 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8990 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8991 C Following matrices are needed only for 6-th order cumulants
8992 IF (wcorr6.gt.0.0d0) THEN
8993 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8994 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8995 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8996 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8997 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8998 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8999 & ADtEAderx(1,1,1,1,1,1))
9001 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9002 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
9003 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9004 & ADtEA1derx(1,1,1,1,1,1))
9006 C End 6-th order cumulants
9009 cd write (2,*) 'In calc_eello6'
9011 cd write (2,*) 'iii=',iii
9013 cd write (2,*) 'kkk=',kkk
9015 cd write (2,'(3(2f10.5),5x)')
9016 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9021 call transpose2(EUgder(1,1,k),auxmat(1,1))
9022 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9023 call transpose2(EUg(1,1,k),auxmat(1,1))
9024 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9025 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9029 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9030 & EAEAderx(1,1,lll,kkk,iii,1))
9034 C A1T kernel(i+1) A2
9035 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9036 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
9037 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9038 C Following matrices are needed only for 6-th order cumulants
9039 IF (wcorr6.gt.0.0d0) THEN
9040 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9041 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
9042 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9043 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9044 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
9045 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9046 & ADtEAderx(1,1,1,1,1,2))
9047 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9048 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
9049 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9050 & ADtEA1derx(1,1,1,1,1,2))
9052 C End 6-th order cumulants
9053 call transpose2(EUgder(1,1,l),auxmat(1,1))
9054 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
9055 call transpose2(EUg(1,1,l),auxmat(1,1))
9056 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9057 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9061 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9062 & EAEAderx(1,1,lll,kkk,iii,2))
9067 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9068 C They are needed only when the fifth- or the sixth-order cumulants are
9070 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
9071 call transpose2(AEA(1,1,1),auxmat(1,1))
9072 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9073 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9074 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9075 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9076 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9077 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9078 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9079 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9080 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9081 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9082 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9083 call transpose2(AEA(1,1,2),auxmat(1,1))
9084 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
9085 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
9086 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
9087 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9088 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
9089 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
9090 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
9091 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
9092 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
9093 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
9094 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
9095 C Calculate the Cartesian derivatives of the vectors.
9099 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9100 call matvec2(auxmat(1,1),b1(1,i),
9101 & AEAb1derx(1,lll,kkk,iii,1,1))
9102 call matvec2(auxmat(1,1),Ub2(1,i),
9103 & AEAb2derx(1,lll,kkk,iii,1,1))
9104 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9105 & AEAb1derx(1,lll,kkk,iii,2,1))
9106 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9107 & AEAb2derx(1,lll,kkk,iii,2,1))
9108 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9109 call matvec2(auxmat(1,1),b1(1,j),
9110 & AEAb1derx(1,lll,kkk,iii,1,2))
9111 call matvec2(auxmat(1,1),Ub2(1,j),
9112 & AEAb2derx(1,lll,kkk,iii,1,2))
9113 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9114 & AEAb1derx(1,lll,kkk,iii,2,2))
9115 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
9116 & AEAb2derx(1,lll,kkk,iii,2,2))
9123 C Antiparallel orientation of the two CA-CA-CA frames.
9125 iti=itype2loc(itype(i))
9129 itk1=itype2loc(itype(k+1))
9130 itl=itype2loc(itype(l))
9131 itj=itype2loc(itype(j))
9132 if (j.lt.nres-1) then
9133 itj1=itype2loc(itype(j+1))
9137 C A2 kernel(j-1)T A1T
9138 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9139 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
9140 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9141 C Following matrices are needed only for 6-th order cumulants
9142 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9143 & j.eq.i+4 .and. l.eq.i+3)) THEN
9144 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9145 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
9146 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9147 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9148 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
9149 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9150 & ADtEAderx(1,1,1,1,1,1))
9151 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9152 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
9153 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9154 & ADtEA1derx(1,1,1,1,1,1))
9156 C End 6-th order cumulants
9157 call transpose2(EUgder(1,1,k),auxmat(1,1))
9158 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9159 call transpose2(EUg(1,1,k),auxmat(1,1))
9160 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9161 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9165 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9166 & EAEAderx(1,1,lll,kkk,iii,1))
9170 C A2T kernel(i+1)T A1
9171 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9172 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
9173 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9174 C Following matrices are needed only for 6-th order cumulants
9175 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9176 & j.eq.i+4 .and. l.eq.i+3)) THEN
9177 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9178 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
9179 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9180 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9181 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
9182 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9183 & ADtEAderx(1,1,1,1,1,2))
9184 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9185 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
9186 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9187 & ADtEA1derx(1,1,1,1,1,2))
9189 C End 6-th order cumulants
9190 call transpose2(EUgder(1,1,j),auxmat(1,1))
9191 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9192 call transpose2(EUg(1,1,j),auxmat(1,1))
9193 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9194 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9198 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9199 & EAEAderx(1,1,lll,kkk,iii,2))
9204 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9205 C They are needed only when the fifth- or the sixth-order cumulants are
9207 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
9208 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9209 call transpose2(AEA(1,1,1),auxmat(1,1))
9210 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9211 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9212 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9213 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9214 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9215 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9216 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9217 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9218 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9219 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9220 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9221 call transpose2(AEA(1,1,2),auxmat(1,1))
9222 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
9223 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9224 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9225 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9226 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
9227 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9228 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
9229 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
9230 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9231 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9232 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9233 C Calculate the Cartesian derivatives of the vectors.
9237 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9238 call matvec2(auxmat(1,1),b1(1,i),
9239 & AEAb1derx(1,lll,kkk,iii,1,1))
9240 call matvec2(auxmat(1,1),Ub2(1,i),
9241 & AEAb2derx(1,lll,kkk,iii,1,1))
9242 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9243 & AEAb1derx(1,lll,kkk,iii,2,1))
9244 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9245 & AEAb2derx(1,lll,kkk,iii,2,1))
9246 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9247 call matvec2(auxmat(1,1),b1(1,l),
9248 & AEAb1derx(1,lll,kkk,iii,1,2))
9249 call matvec2(auxmat(1,1),Ub2(1,l),
9250 & AEAb2derx(1,lll,kkk,iii,1,2))
9251 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
9252 & AEAb1derx(1,lll,kkk,iii,2,2))
9253 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
9254 & AEAb2derx(1,lll,kkk,iii,2,2))
9263 C---------------------------------------------------------------------------
9264 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
9265 & KK,KKderg,AKA,AKAderg,AKAderx)
9269 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
9270 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
9271 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
9276 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9278 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
9281 cd if (lprn) write (2,*) 'In kernel'
9283 cd if (lprn) write (2,*) 'kkk=',kkk
9285 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
9286 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9288 cd write (2,*) 'lll=',lll
9289 cd write (2,*) 'iii=1'
9291 cd write (2,'(3(2f10.5),5x)')
9292 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9295 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
9296 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9298 cd write (2,*) 'lll=',lll
9299 cd write (2,*) 'iii=2'
9301 cd write (2,'(3(2f10.5),5x)')
9302 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9309 C---------------------------------------------------------------------------
9310 double precision function eello4(i,j,k,l,jj,kk)
9311 implicit real*8 (a-h,o-z)
9312 include 'DIMENSIONS'
9313 include 'COMMON.IOUNITS'
9314 include 'COMMON.CHAIN'
9315 include 'COMMON.DERIV'
9316 include 'COMMON.INTERACT'
9317 include 'COMMON.CONTACTS'
9318 include 'COMMON.TORSION'
9319 include 'COMMON.VAR'
9320 include 'COMMON.GEO'
9321 double precision pizda(2,2),ggg1(3),ggg2(3)
9322 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9326 cd print *,'eello4:',i,j,k,l,jj,kk
9327 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9328 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9329 cold eij=facont_hb(jj,i)
9330 cold ekl=facont_hb(kk,k)
9332 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9333 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9334 gcorr_loc(k-1)=gcorr_loc(k-1)
9335 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9337 gcorr_loc(l-1)=gcorr_loc(l-1)
9338 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9340 gcorr_loc(j-1)=gcorr_loc(j-1)
9341 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9346 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9347 & -EAEAderx(2,2,lll,kkk,iii,1)
9348 cd derx(lll,kkk,iii)=0.0d0
9352 cd gcorr_loc(l-1)=0.0d0
9353 cd gcorr_loc(j-1)=0.0d0
9354 cd gcorr_loc(k-1)=0.0d0
9356 cd write (iout,*)'Contacts have occurred for peptide groups',
9357 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9358 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9359 if (j.lt.nres-1) then
9366 if (l.lt.nres-1) then
9374 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9375 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9376 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9377 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9378 cgrad ghalf=0.5d0*ggg1(ll)
9379 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9380 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9381 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9382 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9383 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9384 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9385 cgrad ghalf=0.5d0*ggg2(ll)
9386 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9387 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9388 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9389 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9390 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9391 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9395 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9400 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9405 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9410 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9414 cd write (2,*) iii,gcorr_loc(iii)
9417 cd write (2,*) 'ekont',ekont
9418 cd write (iout,*) 'eello4',ekont*eel4
9421 C---------------------------------------------------------------------------
9422 double precision function eello5(i,j,k,l,jj,kk)
9423 implicit real*8 (a-h,o-z)
9424 include 'DIMENSIONS'
9425 include 'COMMON.IOUNITS'
9426 include 'COMMON.CHAIN'
9427 include 'COMMON.DERIV'
9428 include 'COMMON.INTERACT'
9429 include 'COMMON.CONTACTS'
9430 include 'COMMON.TORSION'
9431 include 'COMMON.VAR'
9432 include 'COMMON.GEO'
9433 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9434 double precision ggg1(3),ggg2(3)
9435 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9440 C /l\ / \ \ / \ / \ / C
9441 C / \ / \ \ / \ / \ / C
9442 C j| o |l1 | o | o| o | | o |o C
9443 C \ |/k\| |/ \| / |/ \| |/ \| C
9444 C \i/ \ / \ / / \ / \ C
9446 C (I) (II) (III) (IV) C
9448 C eello5_1 eello5_2 eello5_3 eello5_4 C
9450 C Antiparallel chains C
9453 C /j\ / \ \ / \ / \ / C
9454 C / \ / \ \ / \ / \ / C
9455 C j1| o |l | o | o| o | | o |o C
9456 C \ |/k\| |/ \| / |/ \| |/ \| C
9457 C \i/ \ / \ / / \ / \ C
9459 C (I) (II) (III) (IV) C
9461 C eello5_1 eello5_2 eello5_3 eello5_4 C
9463 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9465 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9466 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9471 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9473 itk=itype2loc(itype(k))
9474 itl=itype2loc(itype(l))
9475 itj=itype2loc(itype(j))
9480 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9481 cd & eel5_3_num,eel5_4_num)
9485 derx(lll,kkk,iii)=0.0d0
9489 cd eij=facont_hb(jj,i)
9490 cd ekl=facont_hb(kk,k)
9492 cd write (iout,*)'Contacts have occurred for peptide groups',
9493 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9495 C Contribution from the graph I.
9496 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9497 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9498 call transpose2(EUg(1,1,k),auxmat(1,1))
9499 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9500 vv(1)=pizda(1,1)-pizda(2,2)
9501 vv(2)=pizda(1,2)+pizda(2,1)
9502 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9503 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9504 C Explicit gradient in virtual-dihedral angles.
9505 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9506 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9507 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9508 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9509 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9510 vv(1)=pizda(1,1)-pizda(2,2)
9511 vv(2)=pizda(1,2)+pizda(2,1)
9512 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9513 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9514 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9515 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9516 vv(1)=pizda(1,1)-pizda(2,2)
9517 vv(2)=pizda(1,2)+pizda(2,1)
9519 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9520 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9521 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9523 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9524 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9525 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9527 C Cartesian gradient
9531 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
9533 vv(1)=pizda(1,1)-pizda(2,2)
9534 vv(2)=pizda(1,2)+pizda(2,1)
9535 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9536 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
9537 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9543 C Contribution from graph II
9544 call transpose2(EE(1,1,k),auxmat(1,1))
9545 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9546 vv(1)=pizda(1,1)+pizda(2,2)
9547 vv(2)=pizda(2,1)-pizda(1,2)
9548 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
9549 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9550 C Explicit gradient in virtual-dihedral angles.
9551 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9552 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9553 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9554 vv(1)=pizda(1,1)+pizda(2,2)
9555 vv(2)=pizda(2,1)-pizda(1,2)
9557 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9558 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9559 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9561 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9562 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9563 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9565 C Cartesian gradient
9569 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9571 vv(1)=pizda(1,1)+pizda(2,2)
9572 vv(2)=pizda(2,1)-pizda(1,2)
9573 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9574 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
9575 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9583 C Parallel orientation
9584 C Contribution from graph III
9585 call transpose2(EUg(1,1,l),auxmat(1,1))
9586 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9587 vv(1)=pizda(1,1)-pizda(2,2)
9588 vv(2)=pizda(1,2)+pizda(2,1)
9589 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
9590 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9591 C Explicit gradient in virtual-dihedral angles.
9592 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9593 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
9594 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9595 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9596 vv(1)=pizda(1,1)-pizda(2,2)
9597 vv(2)=pizda(1,2)+pizda(2,1)
9598 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9599 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
9600 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9601 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9602 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9603 vv(1)=pizda(1,1)-pizda(2,2)
9604 vv(2)=pizda(1,2)+pizda(2,1)
9605 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9606 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
9607 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9608 C Cartesian gradient
9612 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9614 vv(1)=pizda(1,1)-pizda(2,2)
9615 vv(2)=pizda(1,2)+pizda(2,1)
9616 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9617 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
9618 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9623 C Contribution from graph IV
9625 call transpose2(EE(1,1,l),auxmat(1,1))
9626 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9627 vv(1)=pizda(1,1)+pizda(2,2)
9628 vv(2)=pizda(2,1)-pizda(1,2)
9629 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
9630 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9631 C Explicit gradient in virtual-dihedral angles.
9632 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9633 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9634 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9635 vv(1)=pizda(1,1)+pizda(2,2)
9636 vv(2)=pizda(2,1)-pizda(1,2)
9637 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9638 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
9639 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9640 C Cartesian gradient
9644 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9646 vv(1)=pizda(1,1)+pizda(2,2)
9647 vv(2)=pizda(2,1)-pizda(1,2)
9648 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9649 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
9650 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9655 C Antiparallel orientation
9656 C Contribution from graph III
9658 call transpose2(EUg(1,1,j),auxmat(1,1))
9659 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9660 vv(1)=pizda(1,1)-pizda(2,2)
9661 vv(2)=pizda(1,2)+pizda(2,1)
9662 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9663 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9664 C Explicit gradient in virtual-dihedral angles.
9665 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9666 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9667 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9668 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9669 vv(1)=pizda(1,1)-pizda(2,2)
9670 vv(2)=pizda(1,2)+pizda(2,1)
9671 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9672 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9673 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9674 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9675 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9676 vv(1)=pizda(1,1)-pizda(2,2)
9677 vv(2)=pizda(1,2)+pizda(2,1)
9678 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9679 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9680 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9681 C Cartesian gradient
9685 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9687 vv(1)=pizda(1,1)-pizda(2,2)
9688 vv(2)=pizda(1,2)+pizda(2,1)
9689 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9690 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9691 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9696 C Contribution from graph IV
9698 call transpose2(EE(1,1,j),auxmat(1,1))
9699 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9700 vv(1)=pizda(1,1)+pizda(2,2)
9701 vv(2)=pizda(2,1)-pizda(1,2)
9702 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9703 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9704 C Explicit gradient in virtual-dihedral angles.
9705 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9706 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9707 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9708 vv(1)=pizda(1,1)+pizda(2,2)
9709 vv(2)=pizda(2,1)-pizda(1,2)
9710 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9711 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9712 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9713 C Cartesian gradient
9717 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9719 vv(1)=pizda(1,1)+pizda(2,2)
9720 vv(2)=pizda(2,1)-pizda(1,2)
9721 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9722 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9723 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9729 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9730 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9731 cd write (2,*) 'ijkl',i,j,k,l
9732 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9733 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9735 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9736 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9737 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9738 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9739 if (j.lt.nres-1) then
9746 if (l.lt.nres-1) then
9756 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9757 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9758 C summed up outside the subrouine as for the other subroutines
9759 C handling long-range interactions. The old code is commented out
9760 C with "cgrad" to keep track of changes.
9762 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9763 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9764 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9765 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9766 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9767 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9768 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9769 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9770 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9771 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9773 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9774 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9775 cgrad ghalf=0.5d0*ggg1(ll)
9777 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9778 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9779 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9780 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9781 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9782 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9783 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9784 cgrad ghalf=0.5d0*ggg2(ll)
9786 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
9787 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9788 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
9789 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9790 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9791 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9796 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9797 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9802 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9803 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9809 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9814 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9818 cd write (2,*) iii,g_corr5_loc(iii)
9821 cd write (2,*) 'ekont',ekont
9822 cd write (iout,*) 'eello5',ekont*eel5
9825 c--------------------------------------------------------------------------
9826 double precision function eello6(i,j,k,l,jj,kk)
9827 implicit real*8 (a-h,o-z)
9828 include 'DIMENSIONS'
9829 include 'COMMON.IOUNITS'
9830 include 'COMMON.CHAIN'
9831 include 'COMMON.DERIV'
9832 include 'COMMON.INTERACT'
9833 include 'COMMON.CONTACTS'
9834 include 'COMMON.TORSION'
9835 include 'COMMON.VAR'
9836 include 'COMMON.GEO'
9837 include 'COMMON.FFIELD'
9838 double precision ggg1(3),ggg2(3)
9839 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9844 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9852 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9853 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9857 derx(lll,kkk,iii)=0.0d0
9861 cd eij=facont_hb(jj,i)
9862 cd ekl=facont_hb(kk,k)
9868 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9869 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9870 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9871 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9872 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9873 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9875 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9876 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9877 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9878 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9879 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9880 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9884 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9886 C If turn contributions are considered, they will be handled separately.
9887 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9888 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9889 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9890 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9891 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9892 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9893 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9895 if (j.lt.nres-1) then
9902 if (l.lt.nres-1) then
9910 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9911 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9912 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9913 cgrad ghalf=0.5d0*ggg1(ll)
9915 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9916 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9917 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9918 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9919 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9920 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9921 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9922 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9923 cgrad ghalf=0.5d0*ggg2(ll)
9924 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9926 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9927 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9928 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9929 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9930 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9931 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9936 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9937 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9942 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9943 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9949 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9954 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9958 cd write (2,*) iii,g_corr6_loc(iii)
9961 cd write (2,*) 'ekont',ekont
9962 cd write (iout,*) 'eello6',ekont*eel6
9965 c--------------------------------------------------------------------------
9966 double precision function eello6_graph1(i,j,k,l,imat,swap)
9967 implicit real*8 (a-h,o-z)
9968 include 'DIMENSIONS'
9969 include 'COMMON.IOUNITS'
9970 include 'COMMON.CHAIN'
9971 include 'COMMON.DERIV'
9972 include 'COMMON.INTERACT'
9973 include 'COMMON.CONTACTS'
9974 include 'COMMON.TORSION'
9975 include 'COMMON.VAR'
9976 include 'COMMON.GEO'
9977 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9981 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9983 C Parallel Antiparallel C
9989 C \ j|/k\| / \ |/k\|l / C
9994 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9995 itk=itype2loc(itype(k))
9996 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9997 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9998 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9999 call transpose2(EUgC(1,1,k),auxmat(1,1))
10000 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10001 vv1(1)=pizda1(1,1)-pizda1(2,2)
10002 vv1(2)=pizda1(1,2)+pizda1(2,1)
10003 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10004 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
10005 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
10006 s5=scalar2(vv(1),Dtobr2(1,i))
10007 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
10008 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
10009 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
10010 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
10011 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
10012 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
10013 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
10014 & +scalar2(vv(1),Dtobr2der(1,i)))
10015 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
10016 vv1(1)=pizda1(1,1)-pizda1(2,2)
10017 vv1(2)=pizda1(1,2)+pizda1(2,1)
10018 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
10019 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
10021 g_corr6_loc(l-1)=g_corr6_loc(l-1)
10022 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
10023 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
10024 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
10025 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10027 g_corr6_loc(j-1)=g_corr6_loc(j-1)
10028 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
10029 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
10030 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
10031 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10033 call transpose2(EUgCder(1,1,k),auxmat(1,1))
10034 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10035 vv1(1)=pizda1(1,1)-pizda1(2,2)
10036 vv1(2)=pizda1(1,2)+pizda1(2,1)
10037 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
10038 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
10039 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
10040 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
10049 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
10050 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
10051 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
10052 call transpose2(EUgC(1,1,k),auxmat(1,1))
10053 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10055 vv1(1)=pizda1(1,1)-pizda1(2,2)
10056 vv1(2)=pizda1(1,2)+pizda1(2,1)
10057 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10058 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
10059 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
10060 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
10061 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
10062 s5=scalar2(vv(1),Dtobr2(1,i))
10063 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
10069 c----------------------------------------------------------------------------
10070 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
10071 implicit real*8 (a-h,o-z)
10072 include 'DIMENSIONS'
10073 include 'COMMON.IOUNITS'
10074 include 'COMMON.CHAIN'
10075 include 'COMMON.DERIV'
10076 include 'COMMON.INTERACT'
10077 include 'COMMON.CONTACTS'
10078 include 'COMMON.TORSION'
10079 include 'COMMON.VAR'
10080 include 'COMMON.GEO'
10082 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10083 & auxvec1(2),auxvec2(2),auxmat1(2,2)
10085 common /kutas/ lprn
10086 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10088 C Parallel Antiparallel C
10094 C \ j|/k\| \ |/k\|l C
10099 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10100 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
10101 C AL 7/4/01 s1 would occur in the sixth-order moment,
10102 C but not in a cluster cumulant
10104 s1=dip(1,jj,i)*dip(1,kk,k)
10106 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
10107 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10108 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
10109 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
10110 call transpose2(EUg(1,1,k),auxmat(1,1))
10111 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
10112 vv(1)=pizda(1,1)-pizda(2,2)
10113 vv(2)=pizda(1,2)+pizda(2,1)
10114 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10115 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10117 eello6_graph2=-(s1+s2+s3+s4)
10119 eello6_graph2=-(s2+s3+s4)
10121 c eello6_graph2=-s3
10122 C Derivatives in gamma(i-1)
10125 s1=dipderg(1,jj,i)*dip(1,kk,k)
10127 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10128 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
10129 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10130 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10132 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10134 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10136 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
10138 C Derivatives in gamma(k-1)
10140 s1=dip(1,jj,i)*dipderg(1,kk,k)
10142 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
10143 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10144 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
10145 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10146 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10147 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
10148 vv(1)=pizda(1,1)-pizda(2,2)
10149 vv(2)=pizda(1,2)+pizda(2,1)
10150 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10152 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10154 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10156 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
10157 C Derivatives in gamma(j-1) or gamma(l-1)
10160 s1=dipderg(3,jj,i)*dip(1,kk,k)
10162 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
10163 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10164 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
10165 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
10166 vv(1)=pizda(1,1)-pizda(2,2)
10167 vv(2)=pizda(1,2)+pizda(2,1)
10168 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10171 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10173 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10176 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10177 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10179 C Derivatives in gamma(l-1) or gamma(j-1)
10182 s1=dip(1,jj,i)*dipderg(3,kk,k)
10184 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10185 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10186 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10187 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10188 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10189 vv(1)=pizda(1,1)-pizda(2,2)
10190 vv(2)=pizda(1,2)+pizda(2,1)
10191 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10194 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10196 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10199 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10200 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10202 C Cartesian derivatives.
10204 write (2,*) 'In eello6_graph2'
10206 write (2,*) 'iii=',iii
10208 write (2,*) 'kkk=',kkk
10210 write (2,'(3(2f10.5),5x)')
10211 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10221 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10223 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10226 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
10228 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10229 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
10231 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10232 call transpose2(EUg(1,1,k),auxmat(1,1))
10233 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
10235 vv(1)=pizda(1,1)-pizda(2,2)
10236 vv(2)=pizda(1,2)+pizda(2,1)
10237 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10238 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10240 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10242 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10245 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10247 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10254 c----------------------------------------------------------------------------
10255 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
10256 implicit real*8 (a-h,o-z)
10257 include 'DIMENSIONS'
10258 include 'COMMON.IOUNITS'
10259 include 'COMMON.CHAIN'
10260 include 'COMMON.DERIV'
10261 include 'COMMON.INTERACT'
10262 include 'COMMON.CONTACTS'
10263 include 'COMMON.TORSION'
10264 include 'COMMON.VAR'
10265 include 'COMMON.GEO'
10266 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
10268 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10270 C Parallel Antiparallel C
10275 C /| o |o o| o |\ C
10276 C j|/k\| / |/k\|l / C
10281 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10283 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10284 C energy moment and not to the cluster cumulant.
10285 iti=itortyp(itype(i))
10286 if (j.lt.nres-1) then
10287 itj1=itype2loc(itype(j+1))
10291 itk=itype2loc(itype(k))
10292 itk1=itype2loc(itype(k+1))
10293 if (l.lt.nres-1) then
10294 itl1=itype2loc(itype(l+1))
10299 s1=dip(4,jj,i)*dip(4,kk,k)
10301 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
10302 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10303 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
10304 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10305 call transpose2(EE(1,1,k),auxmat(1,1))
10306 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10307 vv(1)=pizda(1,1)+pizda(2,2)
10308 vv(2)=pizda(2,1)-pizda(1,2)
10309 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10310 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10311 cd & "sum",-(s2+s3+s4)
10313 eello6_graph3=-(s1+s2+s3+s4)
10315 eello6_graph3=-(s2+s3+s4)
10317 c eello6_graph3=-s4
10318 C Derivatives in gamma(k-1)
10319 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
10320 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10321 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10322 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10323 C Derivatives in gamma(l-1)
10324 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
10325 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10326 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10327 vv(1)=pizda(1,1)+pizda(2,2)
10328 vv(2)=pizda(2,1)-pizda(1,2)
10329 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10330 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10331 C Cartesian derivatives.
10337 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10339 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10342 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
10344 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10345 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
10347 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10348 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
10350 vv(1)=pizda(1,1)+pizda(2,2)
10351 vv(2)=pizda(2,1)-pizda(1,2)
10352 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10354 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10356 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10359 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10361 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10363 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10369 c----------------------------------------------------------------------------
10370 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10371 implicit real*8 (a-h,o-z)
10372 include 'DIMENSIONS'
10373 include 'COMMON.IOUNITS'
10374 include 'COMMON.CHAIN'
10375 include 'COMMON.DERIV'
10376 include 'COMMON.INTERACT'
10377 include 'COMMON.CONTACTS'
10378 include 'COMMON.TORSION'
10379 include 'COMMON.VAR'
10380 include 'COMMON.GEO'
10381 include 'COMMON.FFIELD'
10382 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10383 & auxvec1(2),auxmat1(2,2)
10385 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10387 C Parallel Antiparallel C
10392 C /| o |o o| o |\ C
10393 C \ j|/k\| \ |/k\|l C
10398 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10400 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10401 C energy moment and not to the cluster cumulant.
10402 cd write (2,*) 'eello_graph4: wturn6',wturn6
10403 iti=itype2loc(itype(i))
10404 itj=itype2loc(itype(j))
10405 if (j.lt.nres-1) then
10406 itj1=itype2loc(itype(j+1))
10410 itk=itype2loc(itype(k))
10411 if (k.lt.nres-1) then
10412 itk1=itype2loc(itype(k+1))
10416 itl=itype2loc(itype(l))
10417 if (l.lt.nres-1) then
10418 itl1=itype2loc(itype(l+1))
10422 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10423 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10424 cd & ' itl',itl,' itl1',itl1
10426 if (imat.eq.1) then
10427 s1=dip(3,jj,i)*dip(3,kk,k)
10429 s1=dip(2,jj,j)*dip(2,kk,l)
10432 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10433 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10435 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
10436 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10438 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
10439 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10441 call transpose2(EUg(1,1,k),auxmat(1,1))
10442 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10443 vv(1)=pizda(1,1)-pizda(2,2)
10444 vv(2)=pizda(2,1)+pizda(1,2)
10445 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10446 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10448 eello6_graph4=-(s1+s2+s3+s4)
10450 eello6_graph4=-(s2+s3+s4)
10452 C Derivatives in gamma(i-1)
10455 if (imat.eq.1) then
10456 s1=dipderg(2,jj,i)*dip(3,kk,k)
10458 s1=dipderg(4,jj,j)*dip(2,kk,l)
10461 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10463 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
10464 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10466 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
10467 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10469 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10470 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10471 cd write (2,*) 'turn6 derivatives'
10473 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10475 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10479 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10481 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10485 C Derivatives in gamma(k-1)
10487 if (imat.eq.1) then
10488 s1=dip(3,jj,i)*dipderg(2,kk,k)
10490 s1=dip(2,jj,j)*dipderg(4,kk,l)
10493 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10494 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10496 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
10497 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10499 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
10500 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10502 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10503 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10504 vv(1)=pizda(1,1)-pizda(2,2)
10505 vv(2)=pizda(2,1)+pizda(1,2)
10506 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10507 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10509 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10511 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10515 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10517 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10520 C Derivatives in gamma(j-1) or gamma(l-1)
10521 if (l.eq.j+1 .and. l.gt.1) then
10522 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10523 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10524 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10525 vv(1)=pizda(1,1)-pizda(2,2)
10526 vv(2)=pizda(2,1)+pizda(1,2)
10527 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10528 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10529 else if (j.gt.1) then
10530 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10531 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10532 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10533 vv(1)=pizda(1,1)-pizda(2,2)
10534 vv(2)=pizda(2,1)+pizda(1,2)
10535 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10536 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10537 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10539 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10542 C Cartesian derivatives.
10548 if (imat.eq.1) then
10549 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10551 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10554 if (imat.eq.1) then
10555 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10557 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10561 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
10563 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10565 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10566 & b1(1,j+1),auxvec(1))
10567 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
10569 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10570 & b1(1,l+1),auxvec(1))
10571 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
10573 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10575 vv(1)=pizda(1,1)-pizda(2,2)
10576 vv(2)=pizda(2,1)+pizda(1,2)
10577 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10579 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10581 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10584 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10587 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10590 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10592 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10594 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10598 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10600 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10603 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10605 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10613 c----------------------------------------------------------------------------
10614 double precision function eello_turn6(i,jj,kk)
10615 implicit real*8 (a-h,o-z)
10616 include 'DIMENSIONS'
10617 include 'COMMON.IOUNITS'
10618 include 'COMMON.CHAIN'
10619 include 'COMMON.DERIV'
10620 include 'COMMON.INTERACT'
10621 include 'COMMON.CONTACTS'
10622 include 'COMMON.TORSION'
10623 include 'COMMON.VAR'
10624 include 'COMMON.GEO'
10625 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
10626 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
10628 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
10629 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
10630 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10631 C the respective energy moment and not to the cluster cumulant.
10640 iti=itype2loc(itype(i))
10641 itk=itype2loc(itype(k))
10642 itk1=itype2loc(itype(k+1))
10643 itl=itype2loc(itype(l))
10644 itj=itype2loc(itype(j))
10645 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10646 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
10647 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10652 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10654 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10658 derx_turn(lll,kkk,iii)=0.0d0
10665 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10667 cd write (2,*) 'eello6_5',eello6_5
10669 call transpose2(AEA(1,1,1),auxmat(1,1))
10670 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10671 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10672 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10674 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10675 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10676 s2 = scalar2(b1(1,k),vtemp1(1))
10678 call transpose2(AEA(1,1,2),atemp(1,1))
10679 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10680 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10681 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10683 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10684 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10685 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10687 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10688 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10689 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10690 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10691 ss13 = scalar2(b1(1,k),vtemp4(1))
10692 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10694 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10700 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10701 C Derivatives in gamma(i+2)
10705 call transpose2(AEA(1,1,1),auxmatd(1,1))
10706 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10707 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10708 call transpose2(AEAderg(1,1,2),atempd(1,1))
10709 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10710 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10712 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10713 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10714 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10720 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10721 C Derivatives in gamma(i+3)
10723 call transpose2(AEA(1,1,1),auxmatd(1,1))
10724 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10725 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10726 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10728 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10729 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10730 s2d = scalar2(b1(1,k),vtemp1d(1))
10732 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10733 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10735 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10737 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10738 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10739 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10747 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10748 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10750 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10751 & -0.5d0*ekont*(s2d+s12d)
10753 C Derivatives in gamma(i+4)
10754 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10755 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10756 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10758 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10759 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10760 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10768 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10770 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10772 C Derivatives in gamma(i+5)
10774 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10775 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10776 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10778 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10779 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10780 s2d = scalar2(b1(1,k),vtemp1d(1))
10782 call transpose2(AEA(1,1,2),atempd(1,1))
10783 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10784 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10786 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10787 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10789 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10790 ss13d = scalar2(b1(1,k),vtemp4d(1))
10791 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10799 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10800 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10802 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10803 & -0.5d0*ekont*(s2d+s12d)
10805 C Cartesian derivatives
10810 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10811 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10812 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10814 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10815 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10817 s2d = scalar2(b1(1,k),vtemp1d(1))
10819 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10820 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10821 s8d = -(atempd(1,1)+atempd(2,2))*
10822 & scalar2(cc(1,1,itl),vtemp2(1))
10824 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10826 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10827 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10834 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10835 & - 0.5d0*(s1d+s2d)
10837 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10841 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10842 & - 0.5d0*(s8d+s12d)
10844 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10853 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10854 & achuj_tempd(1,1))
10855 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10856 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10857 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10858 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10859 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10861 ss13d = scalar2(b1(1,k),vtemp4d(1))
10862 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10863 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10867 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10868 cd & 16*eel_turn6_num
10870 if (j.lt.nres-1) then
10877 if (l.lt.nres-1) then
10885 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10886 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10887 cgrad ghalf=0.5d0*ggg1(ll)
10889 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10890 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10891 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10892 & +ekont*derx_turn(ll,2,1)
10893 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10894 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10895 & +ekont*derx_turn(ll,4,1)
10896 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10897 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10898 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10899 cgrad ghalf=0.5d0*ggg2(ll)
10901 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10902 & +ekont*derx_turn(ll,2,2)
10903 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10904 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10905 & +ekont*derx_turn(ll,4,2)
10906 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10907 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10908 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10913 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10918 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10924 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10929 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10933 cd write (2,*) iii,g_corr6_loc(iii)
10935 eello_turn6=ekont*eel_turn6
10936 cd write (2,*) 'ekont',ekont
10937 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10941 C-----------------------------------------------------------------------------
10942 double precision function scalar(u,v)
10943 !DIR$ INLINEALWAYS scalar
10945 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10948 double precision u(3),v(3)
10949 cd double precision sc
10957 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10960 crc-------------------------------------------------
10961 SUBROUTINE MATVEC2(A1,V1,V2)
10962 !DIR$ INLINEALWAYS MATVEC2
10964 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10966 implicit real*8 (a-h,o-z)
10967 include 'DIMENSIONS'
10968 DIMENSION A1(2,2),V1(2),V2(2)
10972 c 3 VI=VI+A1(I,K)*V1(K)
10976 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10977 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10982 C---------------------------------------
10983 SUBROUTINE MATMAT2(A1,A2,A3)
10985 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10987 implicit real*8 (a-h,o-z)
10988 include 'DIMENSIONS'
10989 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10990 c DIMENSION AI3(2,2)
10994 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
11000 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
11001 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
11002 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
11003 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
11011 c-------------------------------------------------------------------------
11012 double precision function scalar2(u,v)
11013 !DIR$ INLINEALWAYS scalar2
11015 double precision u(2),v(2)
11016 double precision sc
11018 scalar2=u(1)*v(1)+u(2)*v(2)
11022 C-----------------------------------------------------------------------------
11024 subroutine transpose2(a,at)
11025 !DIR$ INLINEALWAYS transpose2
11027 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
11030 double precision a(2,2),at(2,2)
11037 c--------------------------------------------------------------------------
11038 subroutine transpose(n,a,at)
11041 double precision a(n,n),at(n,n)
11049 C---------------------------------------------------------------------------
11050 subroutine prodmat3(a1,a2,kk,transp,prod)
11051 !DIR$ INLINEALWAYS prodmat3
11053 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
11057 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
11059 crc double precision auxmat(2,2),prod_(2,2)
11062 crc call transpose2(kk(1,1),auxmat(1,1))
11063 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
11064 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11066 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
11067 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
11068 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
11069 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
11070 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
11071 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
11072 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
11073 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
11076 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
11077 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11079 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
11080 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
11081 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
11082 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
11083 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
11084 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
11085 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
11086 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
11089 c call transpose2(a2(1,1),a2t(1,1))
11092 crc print *,((prod_(i,j),i=1,2),j=1,2)
11093 crc print *,((prod(i,j),i=1,2),j=1,2)
11097 CCC----------------------------------------------
11098 subroutine Eliptransfer(eliptran)
11099 implicit real*8 (a-h,o-z)
11100 include 'DIMENSIONS'
11101 include 'COMMON.GEO'
11102 include 'COMMON.VAR'
11103 include 'COMMON.LOCAL'
11104 include 'COMMON.CHAIN'
11105 include 'COMMON.DERIV'
11106 include 'COMMON.NAMES'
11107 include 'COMMON.INTERACT'
11108 include 'COMMON.IOUNITS'
11109 include 'COMMON.CALC'
11110 include 'COMMON.CONTROL'
11111 include 'COMMON.SPLITELE'
11112 include 'COMMON.SBRIDGE'
11113 C this is done by Adasko
11114 C print *,"wchodze"
11115 C structure of box:
11117 C--bordliptop-- buffore starts
11118 C--bufliptop--- here true lipid starts
11120 C--buflipbot--- lipid ends buffore starts
11121 C--bordlipbot--buffore ends
11123 do i=ilip_start,ilip_end
11125 if (itype(i).eq.ntyp1) cycle
11127 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
11128 if (positi.le.0.0) positi=positi+boxzsize
11130 C first for peptide groups
11131 c for each residue check if it is in lipid or lipid water border area
11132 if ((positi.gt.bordlipbot)
11133 &.and.(positi.lt.bordliptop)) then
11134 C the energy transfer exist
11135 if (positi.lt.buflipbot) then
11136 C what fraction I am in
11138 & ((positi-bordlipbot)/lipbufthick)
11139 C lipbufthick is thickenes of lipid buffore
11140 sslip=sscalelip(fracinbuf)
11141 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11142 eliptran=eliptran+sslip*pepliptran
11143 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11144 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11145 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11147 C print *,"doing sccale for lower part"
11148 C print *,i,sslip,fracinbuf,ssgradlip
11149 elseif (positi.gt.bufliptop) then
11150 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
11151 sslip=sscalelip(fracinbuf)
11152 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11153 eliptran=eliptran+sslip*pepliptran
11154 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11155 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11156 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11157 C print *, "doing sscalefor top part"
11158 C print *,i,sslip,fracinbuf,ssgradlip
11160 eliptran=eliptran+pepliptran
11161 C print *,"I am in true lipid"
11164 C eliptran=elpitran+0.0 ! I am in water
11167 C print *, "nic nie bylo w lipidzie?"
11168 C now multiply all by the peptide group transfer factor
11169 C eliptran=eliptran*pepliptran
11170 C now the same for side chains
11172 do i=ilip_start,ilip_end
11173 if (itype(i).eq.ntyp1) cycle
11174 positi=(mod(c(3,i+nres),boxzsize))
11175 if (positi.le.0) positi=positi+boxzsize
11176 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
11177 c for each residue check if it is in lipid or lipid water border area
11178 C respos=mod(c(3,i+nres),boxzsize)
11179 C print *,positi,bordlipbot,buflipbot
11180 if ((positi.gt.bordlipbot)
11181 & .and.(positi.lt.bordliptop)) then
11182 C the energy transfer exist
11183 if (positi.lt.buflipbot) then
11185 & ((positi-bordlipbot)/lipbufthick)
11186 C lipbufthick is thickenes of lipid buffore
11187 sslip=sscalelip(fracinbuf)
11188 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11189 eliptran=eliptran+sslip*liptranene(itype(i))
11190 gliptranx(3,i)=gliptranx(3,i)
11191 &+ssgradlip*liptranene(itype(i))
11192 gliptranc(3,i-1)= gliptranc(3,i-1)
11193 &+ssgradlip*liptranene(itype(i))
11194 C print *,"doing sccale for lower part"
11195 elseif (positi.gt.bufliptop) then
11197 &((bordliptop-positi)/lipbufthick)
11198 sslip=sscalelip(fracinbuf)
11199 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11200 eliptran=eliptran+sslip*liptranene(itype(i))
11201 gliptranx(3,i)=gliptranx(3,i)
11202 &+ssgradlip*liptranene(itype(i))
11203 gliptranc(3,i-1)= gliptranc(3,i-1)
11204 &+ssgradlip*liptranene(itype(i))
11205 C print *, "doing sscalefor top part",sslip,fracinbuf
11207 eliptran=eliptran+liptranene(itype(i))
11208 C print *,"I am in true lipid"
11210 endif ! if in lipid or buffor
11212 C eliptran=elpitran+0.0 ! I am in water
11216 C---------------------------------------------------------
11217 C AFM soubroutine for constant force
11218 subroutine AFMforce(Eafmforce)
11219 implicit real*8 (a-h,o-z)
11220 include 'DIMENSIONS'
11221 include 'COMMON.GEO'
11222 include 'COMMON.VAR'
11223 include 'COMMON.LOCAL'
11224 include 'COMMON.CHAIN'
11225 include 'COMMON.DERIV'
11226 include 'COMMON.NAMES'
11227 include 'COMMON.INTERACT'
11228 include 'COMMON.IOUNITS'
11229 include 'COMMON.CALC'
11230 include 'COMMON.CONTROL'
11231 include 'COMMON.SPLITELE'
11232 include 'COMMON.SBRIDGE'
11237 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11238 dist=dist+diffafm(i)**2
11241 Eafmforce=-forceAFMconst*(dist-distafminit)
11243 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
11244 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
11246 C print *,'AFM',Eafmforce
11249 C---------------------------------------------------------
11250 C AFM subroutine with pseudoconstant velocity
11251 subroutine AFMvel(Eafmforce)
11252 implicit real*8 (a-h,o-z)
11253 include 'DIMENSIONS'
11254 include 'COMMON.GEO'
11255 include 'COMMON.VAR'
11256 include 'COMMON.LOCAL'
11257 include 'COMMON.CHAIN'
11258 include 'COMMON.DERIV'
11259 include 'COMMON.NAMES'
11260 include 'COMMON.INTERACT'
11261 include 'COMMON.IOUNITS'
11262 include 'COMMON.CALC'
11263 include 'COMMON.CONTROL'
11264 include 'COMMON.SPLITELE'
11265 include 'COMMON.SBRIDGE'
11267 C Only for check grad COMMENT if not used for checkgrad
11269 C--------------------------------------------------------
11270 C print *,"wchodze"
11274 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11275 dist=dist+diffafm(i)**2
11278 Eafmforce=0.5d0*forceAFMconst
11279 & *(distafminit+totTafm*velAFMconst-dist)**2
11280 C Eafmforce=-forceAFMconst*(dist-distafminit)
11282 gradafm(i,afmend-1)=-forceAFMconst*
11283 &(distafminit+totTafm*velAFMconst-dist)
11285 gradafm(i,afmbeg-1)=forceAFMconst*
11286 &(distafminit+totTafm*velAFMconst-dist)
11289 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
11292 C-----------------------------------------------------------
11293 C first for shielding is setting of function of side-chains
11294 subroutine set_shield_fac
11295 implicit real*8 (a-h,o-z)
11296 include 'DIMENSIONS'
11297 include 'COMMON.CHAIN'
11298 include 'COMMON.DERIV'
11299 include 'COMMON.IOUNITS'
11300 include 'COMMON.SHIELD'
11301 include 'COMMON.INTERACT'
11302 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11303 double precision div77_81/0.974996043d0/,
11304 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11306 C the vector between center of side_chain and peptide group
11307 double precision pep_side(3),long,side_calf(3),
11308 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11309 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11310 C the line belowe needs to be changed for FGPROC>1
11312 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11314 Cif there two consequtive dummy atoms there is no peptide group between them
11315 C the line below has to be changed for FGPROC>1
11318 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11322 C first lets set vector conecting the ithe side-chain with kth side-chain
11323 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11324 C pep_side(j)=2.0d0
11325 C and vector conecting the side-chain with its proper calfa
11326 side_calf(j)=c(j,k+nres)-c(j,k)
11327 C side_calf(j)=2.0d0
11328 pept_group(j)=c(j,i)-c(j,i+1)
11329 C lets have their lenght
11330 dist_pep_side=pep_side(j)**2+dist_pep_side
11331 dist_side_calf=dist_side_calf+side_calf(j)**2
11332 dist_pept_group=dist_pept_group+pept_group(j)**2
11334 dist_pep_side=dsqrt(dist_pep_side)
11335 dist_pept_group=dsqrt(dist_pept_group)
11336 dist_side_calf=dsqrt(dist_side_calf)
11338 pep_side_norm(j)=pep_side(j)/dist_pep_side
11339 side_calf_norm(j)=dist_side_calf
11341 C now sscale fraction
11342 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
11343 C print *,buff_shield,"buff"
11345 if (sh_frac_dist.le.0.0) cycle
11346 C If we reach here it means that this side chain reaches the shielding sphere
11347 C Lets add him to the list for gradient
11348 ishield_list(i)=ishield_list(i)+1
11349 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
11350 C this list is essential otherwise problem would be O3
11351 shield_list(ishield_list(i),i)=k
11352 C Lets have the sscale value
11353 if (sh_frac_dist.gt.1.0) then
11354 scale_fac_dist=1.0d0
11356 sh_frac_dist_grad(j)=0.0d0
11359 scale_fac_dist=-sh_frac_dist*sh_frac_dist
11360 & *(2.0*sh_frac_dist-3.0d0)
11361 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
11362 & /dist_pep_side/buff_shield*0.5
11363 C remember for the final gradient multiply sh_frac_dist_grad(j)
11364 C for side_chain by factor -2 !
11366 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
11367 C print *,"jestem",scale_fac_dist,fac_help_scale,
11368 C & sh_frac_dist_grad(j)
11371 C if ((i.eq.3).and.(k.eq.2)) then
11372 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
11376 C this is what is now we have the distance scaling now volume...
11377 short=short_r_sidechain(itype(k))
11378 long=long_r_sidechain(itype(k))
11379 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
11382 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
11383 C costhet_fac=0.0d0
11385 costhet_grad(j)=costhet_fac*pep_side(j)
11387 C remember for the final gradient multiply costhet_grad(j)
11388 C for side_chain by factor -2 !
11389 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
11390 C pep_side0pept_group is vector multiplication
11391 pep_side0pept_group=0.0
11393 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
11395 cosalfa=(pep_side0pept_group/
11396 & (dist_pep_side*dist_side_calf))
11397 fac_alfa_sin=1.0-cosalfa**2
11398 fac_alfa_sin=dsqrt(fac_alfa_sin)
11399 rkprim=fac_alfa_sin*(long-short)+short
11401 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
11402 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
11405 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
11406 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11407 &*(long-short)/fac_alfa_sin*cosalfa/
11408 &((dist_pep_side*dist_side_calf))*
11409 &((side_calf(j))-cosalfa*
11410 &((pep_side(j)/dist_pep_side)*dist_side_calf))
11412 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11413 &*(long-short)/fac_alfa_sin*cosalfa
11414 &/((dist_pep_side*dist_side_calf))*
11416 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
11419 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
11422 C now the gradient...
11423 C grad_shield is gradient of Calfa for peptide groups
11424 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
11426 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
11427 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
11429 grad_shield(j,i)=grad_shield(j,i)
11430 C gradient po skalowaniu
11431 & +(sh_frac_dist_grad(j)
11432 C gradient po costhet
11433 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
11434 &-scale_fac_dist*(cosphi_grad_long(j))
11435 &/(1.0-cosphi) )*div77_81
11437 C grad_shield_side is Cbeta sidechain gradient
11438 grad_shield_side(j,ishield_list(i),i)=
11439 & (sh_frac_dist_grad(j)*-2.0d0
11440 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
11441 & +scale_fac_dist*(cosphi_grad_long(j))
11442 & *2.0d0/(1.0-cosphi))
11443 & *div77_81*VofOverlap
11445 grad_shield_loc(j,ishield_list(i),i)=
11446 & scale_fac_dist*cosphi_grad_loc(j)
11447 & *2.0d0/(1.0-cosphi)
11448 & *div77_81*VofOverlap
11450 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
11452 fac_shield(i)=VolumeTotal*div77_81+div4_81
11453 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
11457 C--------------------------------------------------------------------------
11458 double precision function tschebyshev(m,n,x,y)
11460 include "DIMENSIONS"
11462 double precision x(n),y,yy(0:maxvar),aux
11463 c Tschebyshev polynomial. Note that the first term is omitted
11464 c m=0: the constant term is included
11465 c m=1: the constant term is not included
11469 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
11478 C--------------------------------------------------------------------------
11479 double precision function gradtschebyshev(m,n,x,y)
11481 include "DIMENSIONS"
11483 double precision x(n+1),y,yy(0:maxvar),aux
11484 c Tschebyshev polynomial. Note that the first term is omitted
11485 c m=0: the constant term is included
11486 c m=1: the constant term is not included
11490 yy(i)=2*y*yy(i-1)-yy(i-2)
11494 aux=aux+x(i+1)*yy(i)*(i+1)
11495 C print *, x(i+1),yy(i),i
11497 gradtschebyshev=aux
11500 C------------------------------------------------------------------------
11501 C first for shielding is setting of function of side-chains
11502 subroutine set_shield_fac2
11503 implicit real*8 (a-h,o-z)
11504 include 'DIMENSIONS'
11505 include 'COMMON.CHAIN'
11506 include 'COMMON.DERIV'
11507 include 'COMMON.IOUNITS'
11508 include 'COMMON.SHIELD'
11509 include 'COMMON.INTERACT'
11510 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11511 double precision div77_81/0.974996043d0/,
11512 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11514 C the vector between center of side_chain and peptide group
11515 double precision pep_side(3),long,side_calf(3),
11516 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11517 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11518 C the line belowe needs to be changed for FGPROC>1
11520 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11522 Cif there two consequtive dummy atoms there is no peptide group between them
11523 C the line below has to be changed for FGPROC>1
11526 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11530 C first lets set vector conecting the ithe side-chain with kth side-chain
11531 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11532 C pep_side(j)=2.0d0
11533 C and vector conecting the side-chain with its proper calfa
11534 side_calf(j)=c(j,k+nres)-c(j,k)
11535 C side_calf(j)=2.0d0
11536 pept_group(j)=c(j,i)-c(j,i+1)
11537 C lets have their lenght
11538 dist_pep_side=pep_side(j)**2+dist_pep_side
11539 dist_side_calf=dist_side_calf+side_calf(j)**2
11540 dist_pept_group=dist_pept_group+pept_group(j)**2
11542 dist_pep_side=dsqrt(dist_pep_side)
11543 dist_pept_group=dsqrt(dist_pept_group)
11544 dist_side_calf=dsqrt(dist_side_calf)
11546 pep_side_norm(j)=pep_side(j)/dist_pep_side
11547 side_calf_norm(j)=dist_side_calf
11549 C now sscale fraction
11550 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
11551 C print *,buff_shield,"buff"
11553 if (sh_frac_dist.le.0.0) cycle
11554 C If we reach here it means that this side chain reaches the shielding sphere
11555 C Lets add him to the list for gradient
11556 ishield_list(i)=ishield_list(i)+1
11557 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
11558 C this list is essential otherwise problem would be O3
11559 shield_list(ishield_list(i),i)=k
11560 C Lets have the sscale value
11561 if (sh_frac_dist.gt.1.0) then
11562 scale_fac_dist=1.0d0
11564 sh_frac_dist_grad(j)=0.0d0
11567 scale_fac_dist=-sh_frac_dist*sh_frac_dist
11568 & *(2.0d0*sh_frac_dist-3.0d0)
11569 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
11570 & /dist_pep_side/buff_shield*0.5d0
11571 C remember for the final gradient multiply sh_frac_dist_grad(j)
11572 C for side_chain by factor -2 !
11574 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
11575 C sh_frac_dist_grad(j)=0.0d0
11576 C scale_fac_dist=1.0d0
11577 C print *,"jestem",scale_fac_dist,fac_help_scale,
11578 C & sh_frac_dist_grad(j)
11581 C this is what is now we have the distance scaling now volume...
11582 short=short_r_sidechain(itype(k))
11583 long=long_r_sidechain(itype(k))
11584 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
11585 sinthet=short/dist_pep_side*costhet
11589 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
11590 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
11591 C & -short/dist_pep_side**2/costhet)
11592 C costhet_fac=0.0d0
11594 costhet_grad(j)=costhet_fac*pep_side(j)
11596 C remember for the final gradient multiply costhet_grad(j)
11597 C for side_chain by factor -2 !
11598 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
11599 C pep_side0pept_group is vector multiplication
11600 pep_side0pept_group=0.0d0
11602 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
11604 cosalfa=(pep_side0pept_group/
11605 & (dist_pep_side*dist_side_calf))
11606 fac_alfa_sin=1.0d0-cosalfa**2
11607 fac_alfa_sin=dsqrt(fac_alfa_sin)
11608 rkprim=fac_alfa_sin*(long-short)+short
11612 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
11614 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
11615 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
11616 & dist_pep_side**2)
11619 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
11620 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
11621 &*(long-short)/fac_alfa_sin*cosalfa/
11622 &((dist_pep_side*dist_side_calf))*
11623 &((side_calf(j))-cosalfa*
11624 &((pep_side(j)/dist_pep_side)*dist_side_calf))
11625 C cosphi_grad_long(j)=0.0d0
11626 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
11627 &*(long-short)/fac_alfa_sin*cosalfa
11628 &/((dist_pep_side*dist_side_calf))*
11630 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
11631 C cosphi_grad_loc(j)=0.0d0
11633 C print *,sinphi,sinthet
11634 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
11637 C now the gradient...
11639 grad_shield(j,i)=grad_shield(j,i)
11640 C gradient po skalowaniu
11641 & +(sh_frac_dist_grad(j)*VofOverlap
11642 C gradient po costhet
11643 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
11644 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
11645 & sinphi/sinthet*costhet*costhet_grad(j)
11646 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
11648 C grad_shield_side is Cbeta sidechain gradient
11649 grad_shield_side(j,ishield_list(i),i)=
11650 & (sh_frac_dist_grad(j)*-2.0d0
11652 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
11653 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
11654 & sinphi/sinthet*costhet*costhet_grad(j)
11655 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
11658 grad_shield_loc(j,ishield_list(i),i)=
11659 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
11660 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
11661 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
11665 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
11667 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
11668 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)